C/SYSTEM.h

   1 #ifndef SYSTEM__h
   2 #define SYSTEM__h
   3
   4 /*
   5
   6 the CPfront runtime system interface and macro library
   7 based on SYSTEM.h by Josef Templ
   8 bh 20.12.1999
   9
  10 */
  11
  12
  13 #pragma warning(disable:4101)   // disable "unreferenced variable" warning
  14
  15 #ifdef __GNUC__
  16 #  include <alloca.h>
  17 #endif
  18 #include <malloc.h>
  19 #include <string.h>
  20
  21 // extern char *memcpy();
  22
  23 #define export
  24 #define import extern
  25
  26 /* basic types */
  27 typedef unsigned char BOOLEAN;
  28 typedef unsigned char SHORTCHAR;
  29 typedef unsigned short CHAR;
  30 typedef signed char BYTE;
  31 typedef short SHORTINT;
  32 typedef int INTEGER;
  33 #if !defined(_WIN64) && ((__SIZEOF_POINTER__ == 8) || defined (_LP64) || defined(__LP64__))
  34   typedef long LONGINT; // LP64
  35   typedef unsigned long __U_LONGINT;
  36 #else
  37   typedef long long LONGINT; // ILP32 or LLP64
  38   typedef unsigned long long __U_LONGINT;
  39 #endif
  40 typedef float SHORTREAL;
  41 typedef double REAL;
  42 typedef unsigned int SET;
  43 typedef void ANYREC;
  44 typedef void *ANYPTR;
  45 typedef void *SYSTEM_PTR;
  46 typedef INTEGER SYSTEM_ADDRESS;
  47
  48 /* Unsigned variants are for use by shift and rotate macros */
  49 typedef unsigned char __U_SHORTCHAR;
  50 typedef unsigned short __U_CHAR;
  51 typedef unsigned char __U_BYTE;
  52 typedef unsigned short __U_SHORTINT;
  53 typedef unsigned int __U_INTEGER;
  54 typedef unsigned int __U_SET;
  55
  56 extern LONGINT SYSTEM_INF;
  57 extern INTEGER SYSTEM_INFS;
  58 extern INTEGER SYSTEM_argCount;
  59 extern void *SYSTEM_argVector;
  60
  61 /* constants */
  62 #define __MAXEXT        15
  63 #define NIL     0
  64 #define POINTER__typ    (INTEGER*)1     /* not NIL and not a valid type */
  65 #define __INF   (*(REAL*)&SYSTEM_INF)
  66 #define __INFS  (*(SHORTREAL*)&SYSTEM_INFS)
  67
  68 #if defined _WIN32 || defined __CYGWIN__
  69 #  ifdef __GNUC__
  70 #    define __EXTERN __attribute__((dllimport))
  71 #  else
  72 #    define __EXTERN __declspec(dllimport)
  73 #  endif
  74 #else
  75 #  if __GNUC__ >= 4 && !defined(__OS2__)
  76 #    define __EXTERN __attribute__((visibility("default")))
  77 #  else
  78 #    define __EXTERN
  79 #  endif
  80 #endif
  81 #define __CALLBACK __attribute__((__stdcall__))
  82
  83
  84 /* simple open array types */
  85
  86 typedef struct BOOLEAN_ARRAY {
  87         INTEGER gc[3], len[1];
  88         BOOLEAN data[1];
  89 } BOOLEAN_ARRAY;
  90 typedef struct CHAR_ARRAY {
  91         INTEGER gc[3], len[1];
  92         CHAR data[1];
  93 } CHAR_ARRAY;
  94 typedef struct SHORTCHAR_ARRAY {
  95         INTEGER gc[3], len[1];
  96         SHORTCHAR data[1];
  97 } SHORTCHAR_ARRAY;
  98 typedef struct BYTE_ARRAY {
  99         INTEGER gc[3], len[1];
 100         BYTE data[1];
 101 } BYTE_ARRAY;
 102 typedef struct SHORTINT_ARRAY {
 103         INTEGER gc[3], len[1];
 104         SHORTINT data[1];
 105 } SHORTINT_ARRAY;
 106 typedef struct INTEGER_ARRAY {
 107         INTEGER gc[3], len[1];
 108         INTEGER data[1];
 109 } INTEGER_ARRAY;
 110 typedef struct LONGINT_ARRAY {
 111         INTEGER gc[3], len[1];
 112         LONGINT data[1];
 113 } LONGINT_ARRAY;
 114 typedef struct REAL_ARRAY {
 115         INTEGER gc[3], len[1];
 116         REAL data[1];
 117 } REAL_ARRAY;
 118 typedef struct SHORTREAL_ARRAY {
 119         INTEGER gc[3], len[1];
 120         SHORTREAL data[1];
 121 } SHORTREAL_ARRAY;
 122 typedef struct SET_ARRAY {
 123         INTEGER gc[3], len[1];
 124         SET data[1];
 125 } SET_ARRAY;
 126
 127 /* meta info */
 128
 129 typedef struct SYSTEM_OBJDESC {
 130         INTEGER fprint, offs, id, struc;
 131 } SYSTEM_OBJDESC;
 132 typedef struct SYSTEM_DIRECTORY {
 133         INTEGER num;
 134         struct SYSTEM_OBJDESC obj[1];
 135 } SYSTEM_DIRECTORY;
 136 typedef struct SYSTEM_MODDESC {
 137         struct SYSTEM_MODDESC *next;
 138         SET opts;
 139         INTEGER refcnt;
 140         SHORTINT compTime[6], loadTime[6];
 141         void (*body) ();
 142         void (*term) ();
 143         INTEGER nofimps, nofptrs, size, dsize, rsize, code, data, refs, procBase, varBase;
 144         char *names;
 145         INTEGER *ptrs;
 146         struct SYSTEM_MODDESC **imports;
 147         struct SYSTEM_DIRECTORY *exp;
 148         char name[256];
 149 } SYSTEM_MODDESC;
 150 typedef struct SYSTEM_TYPEDESC {
 151         INTEGER size;
 152         struct SYSTEM_MODDESC *mod;
 153         INTEGER id;
 154         INTEGER base[16];
 155         struct SYSTEM_DIRECTORY *fields;
 156         INTEGER ptroffs[1];
 157 } SYSTEM_TYPEDESC;
 158
 159 /* dynamic link */
 160
 161 typedef struct SYSTEM_DLINK {
 162         struct SYSTEM_DLINK *next;
 163         char *name;
 164 } SYSTEM_DLINK;
 165 extern SYSTEM_DLINK *SYSTEM_dlink;
 166
 167
 168 /* runtime system routines */
 169 extern CHAR* SYSTEM_LSTR(char *x);
 170 extern INTEGER SYSTEM_DIV(INTEGER x, INTEGER y);
 171 extern INTEGER SYSTEM_MOD(INTEGER x, INTEGER y);
 172 extern INTEGER SYSTEM_MIN(INTEGER x, INTEGER y);
 173 extern INTEGER SYSTEM_MAX(INTEGER x, INTEGER y);
 174 extern INTEGER SYSTEM_ENTIER(REAL x);
 175 extern INTEGER SYSTEM_ASH(INTEGER x, INTEGER n);
 176 extern INTEGER SYSTEM_ABS(INTEGER x);
 177 extern INTEGER SYSTEM_XCHK(INTEGER i, INTEGER ub);
 178 extern void *SYSTEM_NEWARR(INTEGER type, INTEGER n);
 179 extern void *SYSTEM_NEWARR1(INTEGER type, INTEGER n0, INTEGER n);
 180 extern void *SYSTEM_NEWARR2(INTEGER type, INTEGER n1, INTEGER n0, INTEGER n);
 181 extern void *SYSTEM_NEWARR3(INTEGER type, INTEGER n2, INTEGER n1, INTEGER n0, INTEGER n);
 182 extern void *SYSTEM_NEWARR4(INTEGER type, INTEGER n3, INTEGER n2, INTEGER n1, INTEGER n0, INTEGER n);
 183 extern void SYSTEM_REGMOD(struct SYSTEM_MODDESC *mod);
 184 extern INTEGER SYSTEM_STRLEN(CHAR x[]); /* LEN(lx$) */
 185 extern INTEGER SYSTEM_STRLENS(SHORTCHAR x[]);   /* LEN(sx$) */
 186 extern INTEGER SYSTEM_STRCMPSS(SHORTCHAR x[], SHORTCHAR y[]);   /* sx = sy */
 187 extern INTEGER SYSTEM_STRCMPTS(CHAR x[], SHORTCHAR y[]);        /* SHORT(lx) = sy */
 188 extern INTEGER SYSTEM_STRCMPTT(CHAR x[], CHAR y[]);     /* SHORT(lx) = SHORT(ly) */
 189 extern INTEGER SYSTEM_STRCMPLL(CHAR x[], CHAR y[]);     /* lx = ly */
 190 extern INTEGER SYSTEM_STRCMPSL(SHORTCHAR x[], CHAR y[]);        /* LONG(sx) = ly */
 191 extern INTEGER SYSTEM_STRCMPTL(CHAR x[], CHAR y[]);     /* LONG(SHORT(lx)) = ly */
 192 extern void SYSTEM_STRCOPYSS(SHORTCHAR x[], SHORTCHAR y[], INTEGER n);  /* sy := sx */
 193 extern void SYSTEM_STRCOPYTS(CHAR x[], SHORTCHAR y[], INTEGER n);       /* sy := SHORT(lx) */
 194 extern void SYSTEM_STRCOPYLL(CHAR x[], CHAR y[], INTEGER n);    /* ly := lx */
 195 extern void SYSTEM_STRCOPYSL(SHORTCHAR x[], CHAR y[], INTEGER n);       /* ly := LONG(sx) */
 196 extern void SYSTEM_STRCOPYTL(CHAR x[], CHAR y[], INTEGER n);    /* ly := LONG(SHORT(lx)) */
 197 extern void SYSTEM_STRAPNDSS(SHORTCHAR x[], SHORTCHAR y[], INTEGER n);  /* sy := sy + sx */
 198 extern void SYSTEM_STRAPNDTS(CHAR x[], SHORTCHAR y[], INTEGER n);       /* sy := sy + SHORT(lx) */
 199 extern void SYSTEM_STRAPNDLL(CHAR x[], CHAR y[], INTEGER n);    /* ly := ly + lx */
 200 extern void SYSTEM_STRAPNDSL(SHORTCHAR x[], CHAR y[], INTEGER n);       /* ly := ly + LONG(sx) */
 201 extern void SYSTEM_STRAPNDTL(CHAR x[], CHAR y[], INTEGER n);    /* ly := ly + LONG(SHORT(lx)) */
 202 extern LONGINT SYSTEM_DIVL(LONGINT x, LONGINT y);
 203 extern LONGINT SYSTEM_MODL(LONGINT x, LONGINT y);
 204 extern LONGINT SYSTEM_MINL(LONGINT x, LONGINT y);
 205 extern LONGINT SYSTEM_MAXL(LONGINT x, LONGINT y);
 206 extern LONGINT SYSTEM_ASHL(LONGINT x, INTEGER n);
 207 extern LONGINT SYSTEM_ABSL(LONGINT x);
 208 extern SHORTREAL SYSTEM_INT2SR(INTEGER x);
 209 extern REAL SYSTEM_LONG2R(LONGINT x);
 210 extern LONGINT SYSTEM_ENTIERL(REAL x);
 211 extern INTEGER SYSTEM_SR2INT(SHORTREAL x);
 212 extern LONGINT SYSTEM_R2LONG(REAL x);
 213 extern SHORTREAL SYSTEM_ABSF(SHORTREAL x);
 214 extern SHORTREAL SYSTEM_MINF(SHORTREAL x, SHORTREAL y);
 215 extern SHORTREAL SYSTEM_MAXF(SHORTREAL x, SHORTREAL y);
 216 extern REAL SYSTEM_ABSD(REAL x);
 217 extern REAL SYSTEM_MIND(REAL x, REAL y);
 218 extern REAL SYSTEM_MAXD(REAL x, REAL y);
 219
 220 extern INTEGER Kernel_NewRec(INTEGER typ);
 221 extern INTEGER Kernel_NewArr(INTEGER eltyp, INTEGER nofelem, INTEGER nofdim);
 222 extern void Kernel_Trap(INTEGER n);
 223
 224
 225 #define __INIT(argc, argv)      SYSTEM_argCount = argc; SYSTEM_argVector = *(void**)&argv
 226 #define __BEGREG(mod)   if (mod.opts & 0x40000) return; mod.opts |= 0x40000;
 227 #define __ENDREG
 228 #define __REGMOD(mod)   SYSTEM_REGMOD(&mod);
 229 #define __BEGBODY(mod)  if (mod.opts & 0x10000) return; mod.opts |= 0x10000;
 230 #define __ENDBODY
 231 #define __BEGCLOSE
 232 #define __ENDCLOSE
 233 #define __ENTER(name)   SYSTEM_DLINK __dl = {SYSTEM_dlink, name}; SYSTEM_dlink = &__dl
 234 #define __EXIT                          SYSTEM_dlink = __dl.next
 235
 236 /* SYSTEM ops */
 237 #define __VAL(t, x)     (*(t*)&(x))
 238 #define __VALSR(x)      SYSTEM_INT2SR(x)
 239 #define __VALR(x)       SYSTEM_LONG2R(x)
 240 #define __VALI(x)       SYSTEM_SR2INT(x)
 241 #define __VALL(x)       SYSTEM_R2LONG(x)
 242 #define __GET(a, x, t)  x= *(t*)(a)
 243 #define __PUT(a, x, t)  *(t*)(a)=(t)x
 244 #define __LSHL(x, n, t) ((t)((__U_##t)(x)<<(n)))
 245 #define __LSHR(x, n, t) ((t)((__U_##t)(x)>>(n)))
 246 #define __LSH(x, n, t)  ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t))
 247 #define __ROTL(x, n, t) ((t)((__U_##t)(x)<<(n)|(__U_##t)(x)>>(8*sizeof(t)-(n))))
 248 #define __ROTR(x, n, t) ((t)((__U_##t)(x)>>(n)|(__U_##t)(x)<<(8*sizeof(t)-(n))))
 249 #define __ROT(x, n, t)  ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t))
 250 #define __BIT(x, n)     (*(unsigned*)(x)>>(n)&1)
 251 #define __MOVE(s, d, n) memcpy((char*)(d),(char*)(s),n)
 252
 253 /* std procs and operator mappings */
 254 // #define __SHORT(x, y)        ((int)((unsigned)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0)))
 255 // #define __SHORTF(x, y)       ((int)(__RF((x)+(y),(y)+(y))-(y)))
 256 // #define __CHR(x)     ((CHAR)__R(x, 256))
 257 // #define __CHRF(x)    ((CHAR)__RF(x, 256))
 258 #define __DIV(x, y)     ((x)>=0?(x)/(y):~(~(x)/(y)))
 259 #define __DIVF(x, y)    SYSTEM_DIV(x,y)
 260 #define __DIVFL(x, y)   SYSTEM_DIVL(x,y)
 261 #define __MOD(x, y)     ((x)>=0?(x)%(y):(y)+~(~(x)%(y)))
 262 #define __MODF(x, y)    SYSTEM_MOD(x,y)
 263 #define __MODFL(x, y)   SYSTEM_MODL(x,y)
 264 #define __MIN(x, y)     ((x)<(y)?(x):(y))
 265 #define __MINF(x, y)    SYSTEM_MIN(x,y)
 266 #define __MINFL(x, y)   SYSTEM_MINL(x,y)
 267 #define __MINFF(x, y)   SYSTEM_MINF(x,y)
 268 #define __MINFD(x, y)   SYSTEM_MIND(x,y)
 269 #define __MAX(x, y)     ((x)>(y)?(x):(y))
 270 #define __MAXF(x, y)    SYSTEM_MAX(x,y)
 271 #define __MAXFL(x, y)   SYSTEM_MAXL(x,y)
 272 #define __MAXFF(x, y)   SYSTEM_MAXF(x,y)
 273 #define __MAXFD(x, y)   SYSTEM_MAXD(x,y)
 274 #define __NEW(t)        (void*)Kernel_NewRec((INTEGER)t)
 275 #define __NEWARR(t, n)  (void*)SYSTEM_NEWARR(t, n)
 276 #define __NEWARR0(t, n) (void*)Kernel_NewArr(t, n, 0)
 277 #define __NEWARR1(t, n0, n)     (void*)SYSTEM_NEWARR1(t, n0, n)
 278 #define __NEWARR2(t, n1, n0, n) (void*)SYSTEM_NEWARR2(t, n1, n0, n)
 279 #define __NEWARR3(t, n2, n1, n0, n)     (void*)SYSTEM_NEWARR3(t, n2, n1, n0, n)
 280 #define __NEWARR4(t, n3, n2, n1, n0, n) (void*)SYSTEM_NEWARR4(t, n3, n2, n1, n0, n)
 281 #define __HALT(x)       Kernel_Trap(x)
 282 #define __ASSERT(cond, x)       if (!(cond)) __HALT(x)
 283 #define __ENTIER(x)     SYSTEM_ENTIER(x)
 284 #define __ENTIERL(x)    SYSTEM_ENTIERL(x)
 285 #define __ABS(x)        (((x)<0)?-(x):(x))
 286 #define __ABSF(x)       SYSTEM_ABS(x)
 287 #define __ABSFL(x)      SYSTEM_ABSL(x)
 288 #define __ABSFF(x)      SYSTEM_ABSF(x)
 289 #define __ABSFD(x)      SYSTEM_ABSD(x)
 290 #define __CAP(ch)       ((CHAR)((ch)&0x5f))
 291 #define __ODD(x)        ((x)&1)
 292 #define __IN(x, s)      (((s)>>(x))&1)
 293 #define __SETOF(x)      ((SET)1<<(x))
 294 #define __SETRNG(l, h)  ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h)))
 295 #define __MASK(x, m)    ((x)&~(m))
 296 #define __LSTR(x)       SYSTEM_LSTR(x)
 297
 298 #define __STRLEN(x)     SYSTEM_STRLEN(x)        /* LEN(lx$) */
 299 #define __STRLENS(x)    SYSTEM_STRLENS(x)       /* LEN(sx$) */
 300 #define __STRCMPSS(x, y)        SYSTEM_STRCMPSS(x, y)   /* sx = sy */
 301 #define __STRCMPTS(x, y)        SYSTEM_STRCMPTS(x, y)   /* SHORT(lx) = sy */
 302 #define __STRCMPTT(x, y)        SYSTEM_STRCMPTT(x, y)   /* SHORT(lx) = SHORT(ly) */
 303 #define __STRCMPLL(x, y)        SYSTEM_STRCMPLL(x, y)   /* lx = ly */
 304 #define __STRCMPSL(x, y)        SYSTEM_STRCMPSL(x, y)   /* LONG(sx) = ly */
 305 #define __STRCMPTL(x, y)        SYSTEM_STRCMPTL(x, y)   /* LONG(SHORT(lx)) = ly */
 306 #define __STRCOPYSS(x, y, n)    SYSTEM_STRCOPYSS(x, y, n)       /* sy := sx */
 307 #define __STRCOPYTS(x, y, n)    SYSTEM_STRCOPYTS(x, y, n)       /* sy := SHORT(lx) */
 308 #define __STRCOPYLL(x, y, n)    SYSTEM_STRCOPYLL(x, y, n)       /* ly := lx */
 309 #define __STRCOPYSL(x, y, n)    SYSTEM_STRCOPYSL(x, y, n)       /* ly := LONG(sx) */
 310 #define __STRCOPYTL(x, y, n)    SYSTEM_STRCOPYTL(x, y, n)       /* ly := LONG(SHORT(lx)) */
 311 #define __STRAPNDSS(x, y, n)    SYSTEM_STRAPNDSS(x, y, n)       /* sy := sy + sx */
 312 #define __STRAPNDTS(x, y, n)    SYSTEM_STRAPNDTS(x, y, n)       /* sy := sy + SHORT(lx) */
 313 #define __STRAPNDLL(x, y, n)    SYSTEM_STRAPNDLL(x, y, n)       /* ly := ly + lx */
 314 #define __STRAPNDSL(x, y, n)    SYSTEM_STRAPNDSL(x, y, n)       /* ly := ly + LONG(sx) */
 315 #define __STRAPNDTL(x, y, n)    SYSTEM_STRAPNDTL(x, y, n)       /* ly := ly + LONG(SHORT(lx)) */
 316
 317 #define __ASH(x, n, t)  ((n)>=0?__ASHL(x,n,t):__ASHR(x,-(n),t))
 318 #define __ASHL(x, n, t) ((t)(x)<<(n))
 319 #define __ASHR(x, n, t) ((t)(x)>>(n))
 320 #define __ASHF(x, n, t) SYSTEM_ASH(x, n)
 321 #define __ASHFL(x, n, t)        SYSTEM_ASHL(x, n)
 322 #define __DUP(x, l)     x=(void*)memcpy(alloca(l*sizeof(*x)),x,l*sizeof(*x))
 323 #define __DUPARR(v)     v=(void*)memcpy(v##__copy,v,sizeof(v##__copy))
 324 #define __DEL(x)        /* DUP with alloca frees storage automatically */
 325 #define __IS(tag, typ, level)   ((tag->base[level])==(INTEGER)typ)
 326 #define __TYPEOF(p)     (*(((SYSTEM_TYPEDESC**)(p))-1))
 327 #define __ISP(p, typ, level)    __IS(__TYPEOF(p),typ,level)
 328
 329 /* runtime checks */
 330 #define __X(i, ub)      (((unsigned)(i)<(unsigned)(ub))?i:(__HALT(-7),0))
 331 #define __XF(i, ub)      SYSTEM_XCHK((INTEGER)(i), (INTEGER)(ub))
 332 // #define __RETCHK     __retchk: __HALT(-3)
 333 #define __RETCHK        __HALT(-3)
 334 #define __CASECHK       __HALT(-2)
 335 #define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-4),p)))
 336 #define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-4),r))))
 337 #define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-4),p)))
 338 #define __WITHCHK       __HALT(-1)
 339
 340 /* Oberon-2 type bound procedures support */
 341 #define __SEND(typ, num, funtyp, parlist)       ((funtyp)(*((INTEGER*)typ-(num+1))))parlist
 342
 343 /* runtime system variables */
 344 extern SYSTEM_MODDESC *SYSTEM_modlist;
 345 extern LONGINT SYSTEM_argc;
 346 extern LONGINT SYSTEM_argv;
 347 extern void (*SYSTEM_Halt)();
 348 extern LONGINT SYSTEM_halt;
 349 extern LONGINT SYSTEM_assert;
 350 extern SYSTEM_PTR SYSTEM_modules;
 351 extern LONGINT SYSTEM_heapsize;
 352 extern LONGINT SYSTEM_allocated;
 353 extern LONGINT SYSTEM_lock;
 354 extern SHORTINT SYSTEM_gclock;
 355 extern BOOLEAN SYSTEM_interrupted;
 356
 357 #endif