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