1 #ifndef SYSTEM__h
2 #define SYSTEM__h
3 
4 
5 // 64 bit system detection
6 
7 #if (__SIZEOF_POINTER__ == 8) || defined (_LP64) || defined(__LP64__) || defined(_WIN64)
8   #define o__64
9 #endif
10 
11 
12 // Declare memcpy in a way compatible with C compilers intrinsic
13 // built in implementations.
14 
15 #if defined (o__64)
16   #if defined(_WIN64)
17     typedef unsigned long long size_t;
18   #else
19     typedef unsigned long      size_t;
20   #endif
21 #else
22   #if defined(__OpenBSD__)
23     typedef unsigned long      size_t;
24   #else
25     typedef unsigned int       size_t;
26   #endif
27 #endif
28 
29 #define _SIZE_T_DECLARED // For FreeBSD
30 #define _SIZE_T_DEFINED_ // For OpenBSD
31 
32 void *memcpy(void *dest, const void *source, size_t size);
33 #if defined _MSC_VER
34 #define alloca _alloca
35 #endif
36 void *alloca(size_t size);
37 
38 
39 // Declare fixed size versions of basic intger types
40 
41 #if defined (o__64) && !defined(_WIN64)
42   // LP64
43   typedef long               INT64;
44   typedef unsigned long      UINT64;
45 #else
46   // ILP32 or LLP64
47   typedef long long          INT64;
48   typedef unsigned long long UINT64;
49 #endif
50 
51 typedef int                  INT32;
52 typedef unsigned int         UINT32;
53 
54 typedef short int            INT16;
55 typedef unsigned short int   UINT16;
56 
57 typedef signed char          INT8;
58 typedef unsigned char        UINT8;
59 
60 
61 // The compiler uses 'import' and 'export' which translate to 'extern' and
62 // nothing respectively.
63 
64 #define import extern
65 #define export
66 
67 
68 
69 // Known constants
70 
71 #define NIL          ((void*)0)
72 #define __MAXEXT     16
73 #define POINTER__typ ((ADDRESS*)(1))  // not NIL and not a valid type
74 
75 
76 // Oberon types
77 
78 typedef INT8   BOOLEAN;
79 typedef INT8   SYSTEM_BYTE;
80 typedef UINT8  CHAR;
81 typedef float  REAL;
82 typedef double LONGREAL;
83 typedef void*  SYSTEM_PTR;
84 
85 
86 
87 // 'ADDRESS' is a synonym for an integer of pointer size
88 
89 #if defined (o__64)
90   #define ADDRESS INT64
91 #else
92   #define ADDRESS INT32
93 #endif
94 
95 
96 
97 // ----------------------------------------------------------------------
98 // ----------------------------------------------------------------------
99 
100 
101 
102 // OS Memory allocation interfaces are in PlatformXXX.Mod
103 
104 extern ADDRESS Platform_OSAllocate (ADDRESS size);
105 extern void    Platform_OSFree     (ADDRESS addr);
106 
107 
108 // Assertions and Halts
109 
110 extern void Modules_Halt(INT32 x);
111 extern void Modules_AssertFail(INT32 x);
112 
113 #define __HALT(x)         Modules_Halt((INT32)(x))
114 #define __ASSERT(cond, x) if (!(cond)) Modules_AssertFail((INT32)(x))
115 
116 
117 // Index checking
118 
__XF(UINT64 i,UINT64 ub)119 static inline INT64 __XF(UINT64 i, UINT64 ub) {if (i >= ub) {__HALT(-2);} return i;}
120 #define __X(i, ub) (((i)<(ub))?i:(__HALT(-2),0))
121 
122 
123 // Range checking, and checked SHORT and CHR functions
124 
__RF(UINT64 i,UINT64 ub)125 static inline INT64 __RF(UINT64 i, UINT64 ub) {if (i >= ub) {__HALT(-8);} return i;}
126 #define __R(i, ub)      (((i)<(ub))?i:(__HALT(-8),0))
127 #define __SHORT(x, ub)  ((int)((UINT64)(x)+(ub)<(ub)+(ub)?(x):(__HALT(-8),0)))
128 #define __SHORTF(x, ub) ((int)(__RF((x)+(ub),(ub)+(ub))-(ub)))
129 #define __CHR(x)        ((CHAR)__R(x, 256))
130 #define __CHRF(x)       ((CHAR)__RF(x, 256))
131 
132 
133 
134 // Signal handling in SYSTEM.c
135 
136 #ifndef _WIN32
137   extern void SystemSetHandler(int s, ADDRESS h);
138 #else
139   extern void SystemSetInterruptHandler(ADDRESS h);
140   extern void SystemSetQuitHandler     (ADDRESS h);
141 #endif
142 
143 
144 
145 // String comparison
146 
__str_cmp(CHAR * x,CHAR * y)147 static inline int __str_cmp(CHAR *x, CHAR *y){
148   INT64 i = 0;
149   CHAR ch1, ch2;
150   do {ch1 = x[i]; ch2 = y[i]; i++;
151     if (!ch1) return -(int)ch2;
152   } while (ch1==ch2);
153   return (int)ch1 - (int)ch2;
154 }
155 #define __STRCMP(a,b) __str_cmp((CHAR*)(a), (CHAR*)(b))
156 
157 
158 
159 // Inline string, record and array copy
160 
161 #define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d; LONGINT _i=0,_t=n-1; \
162                          while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;}
163 #define __DUPARR(v, t)  v=(void*)memcpy(v##__copy,v,sizeof(t))
164 #define __DUP(x, l, t)  x=(void*)memcpy(alloca(l*sizeof(t)),x,l*sizeof(t))
165 #define __DEL(x)
166 
167 
168 /* SYSTEM ops */
169 
170 #define __VAL(t, x)     (*(t*)&(x))
171 
172 #define __GET(a, x, t)  x=*(t*)(ADDRESS)(a)
173 #define __PUT(a, x, t)  *(t*)(ADDRESS)(a)=x
174 
175 #define __LSHL(x, n, s) ((INT##s)((UINT##s)(x)<<(n)))
176 #define __LSHR(x, n, s) ((INT##s)((UINT##s)(x)>>(n)))
177 #define __LSH(x, n, s)  ((n)>=0? __LSHL(x, n, s): __LSHR(x, -(n), s))
178 
179 #define __ROTL(x, n, s) ((INT##s)((UINT##s)(x)<<(n)|(UINT##s)(x)>>(s-(n))))
180 #define __ROTR(x, n, s) ((INT##s)((UINT##s)(x)>>(n)|(UINT##s)(x)<<(s-(n))))
181 #define __ROT(x, n, s)  ((n)>=0? __ROTL(x, n, s): __ROTR(x, -(n), s))
182 
183 #define __ASHL(x, n)    ((INT64)(x)<<(n))
184 #define __ASHR(x, n)    ((INT64)(x)>>(n))
185 #define __ASH(x, n)     ((n)>=0?__ASHL(x,n):__ASHR(x,-(n)))
SYSTEM_ASH(INT64 x,INT64 n)186 static inline INT64 SYSTEM_ASH(INT64 x, INT64 n) {return __ASH(x,n);}
187 #define __ASHF(x, n)    SYSTEM_ASH((INT64)(x), (INT64)(n))
188 
189 #define __MOVE(s, d, n) memcpy((char*)(ADDRESS)(d),(char*)(ADDRESS)(s),n)
190 
191 
192 extern INT64 SYSTEM_DIV(INT64 x, INT64 y);
193 #define __DIVF(x, y) SYSTEM_DIV(x, y)
194 #define __DIV(x, y) (((x)>0 && (y)>0) ? (x)/(y) : __DIVF(x, y))
195 
196 
197 extern INT64 SYSTEM_MOD(INT64 x, INT64 y);
198 #define __MODF(x, y) SYSTEM_MOD(x, y)
199 #define __MOD(x, y) (((x)>0 && (y)>0) ? (x)%(y) : __MODF(x, y))
200 
201 
202 extern INT64 SYSTEM_ENTIER (double x);
203 #define __ENTIER(x) SYSTEM_ENTIER(x)
204 
205 
206 #define __ABS(x) (((x)<0)?-(x):(x))
207 
SYSTEM_ABS64(INT64 i)208 static inline INT32 SYSTEM_ABS64(INT64 i) {return i >= 0 ? i : -i;}
SYSTEM_ABS32(INT32 i)209 static inline INT64 SYSTEM_ABS32(INT32 i) {return i >= 0 ? i : -i;}
210 #define __ABSF(x) ((sizeof(x) <= 4) ? SYSTEM_ABS32(x) : SYSTEM_ABS64(x))
211 
SYSTEM_ABSD(double i)212 static inline double SYSTEM_ABSD(double i) {return i >= 0.0 ? i : -i;}
213 #define __ABSFD(x) SYSTEM_ABSD(x)
214 
215 #define __CAP(ch)       ((CHAR)((ch)&0x5f))
216 #define __ODD(x)        ((x)&1)
217 
218 #define __IN(x, s, size)     (((unsigned int)(x))<size && ((((UINT##size)(s))>>(x))&1))
219 // todo tested versions of SETOF and SETRNG: check that x, l and h fit size
220 #define __SETOF(x, size)     ((UINT##size)1<<(x))
221 #define __SETRNG(l, h, size) ((~(UINT##size)0<<(l))&~(UINT##size)0>>(size-1-(h)))
222 
223 #define __MASK(x, m) ((x)&~(m))
224 #define __BIT(x, n)  (*(UINT64*)(x)>>(n)&1)
225 
226 
227 
228 // Runtime checks
229 
230 #define __RETCHK     __retchk: __HALT(-3); return 0;
231 #define __CASECHK    __HALT(-4)
232 #define __WITHCHK    __HALT(-7)
233 
234 
235 #define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(ADDRESS)typ##__typ)
236 #define  __TYPEOF(p)          (*(((ADDRESS**)(p))-1))
237 #define __ISP(p, typ, level)  __IS(__TYPEOF(p),typ,level)
238 
239 
240 #define __GUARDP(p, typ, level)    ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p)))
241 #define __GUARDR(r, typ, level)    (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r))))
242 #define __GUARDA(p, typ, level)    ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p)))
243 #define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p)
244 #define __GUARDEQP(p, typ)         if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*((typ*)p)
245 
246 
247 
248 // Module entry/registration/exit
249 
250 extern void       Heap_REGCMD();
251 extern SYSTEM_PTR Heap_REGMOD();
252 extern void       Heap_REGTYP();
253 extern void       Heap_INCREF();
254 
255 #define __DEFMOD              static void *m; if (m!=0) {return m;}
256 #define __REGCMD(name, cmd)   Heap_REGCMD(m, (CHAR*)name, cmd)
257 #define __REGMOD(name, enum)  if (m==0) {m = Heap_REGMOD((CHAR*)name,enum);}
258 #define __ENDMOD              return m
259 #define __MODULE_IMPORT(name) Heap_INCREF(name##__init())
260 
261 
262 
263 // Main module initialisation, registration and finalisation
264 
265 extern void Modules_Init(INT32 argc, ADDRESS argv);
266 extern void Heap_FINALL();
267 
268 #define __INIT(argc, argv)    static void *m; Modules_Init(argc, (ADDRESS)&argv);
269 #define __REGMAIN(name, enum) m = Heap_REGMOD((CHAR*)name,enum)
270 #define __FINI                Heap_FINALL(); return 0
271 
272 
273 // Memory allocation
274 
275 extern SYSTEM_PTR Heap_NEWBLK (ADDRESS size);
276 extern SYSTEM_PTR Heap_NEWREC (ADDRESS tag);
277 extern SYSTEM_PTR SYSTEM_NEWARR(ADDRESS*, ADDRESS, int, int, int, ...);
278 
279 #define __SYSNEW(p, len) p = Heap_NEWBLK((ADDRESS)(len))
280 #define __NEW(p, t)      p = Heap_NEWREC((ADDRESS)t##__typ)
281 #define __NEWARR         SYSTEM_NEWARR
282 
283 
284 
285 /* Type handling */
286 
287 extern void SYSTEM_INHERIT(ADDRESS *t, ADDRESS *t0);
288 extern void SYSTEM_ENUMP  (void *adr, ADDRESS n, void (*P)());
289 extern void SYSTEM_ENUMR  (void *adr, ADDRESS *typ, ADDRESS size, ADDRESS n, void (*P)());
290 
291 
292 #define __TDESC(t, m, n)                                                \
293   static struct t##__desc {                                             \
294     ADDRESS  tproc[m];         /* Proc for each ptr field            */ \
295     ADDRESS  tag;                                                       \
296     ADDRESS  next;             /* Module table type list points here */ \
297     ADDRESS  level;                                                     \
298     ADDRESS  module;                                                    \
299     char     name[24];                                                  \
300     ADDRESS  basep[__MAXEXT];  /* List of bases this extends         */ \
301     ADDRESS  reserved;                                                  \
302     ADDRESS  blksz;            /* xxx_typ points here                */ \
303     ADDRESS  ptr[n+1];         /* Offsets of ptrs up to -ve sentinel */ \
304   } t##__desc
305 
306 #define __BASEOFF   (__MAXEXT+1)                           // blksz as index to base.
307 #define __TPROC0OFF (__BASEOFF+24/sizeof(ADDRESS)+5)       // blksz as index to tproc IFF m=1.
308 #define __EOM 1
309 #define __TDFLDS(name, size)          {__EOM}, 1, 0, 0, 0, name, {0}, 0, size
310 #define __ENUMP(adr, n, P)            SYSTEM_ENUMP(adr, (ADDRESS)(n), P)
311 #define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (ADDRESS)(size), (ADDRESS)(n), P)
312 
313 #define __INITYP(t, t0, level) \
314   t##__typ               = (ADDRESS*)&t##__desc.blksz;                                                    \
315   memcpy(t##__desc.basep, t0##__typ - __BASEOFF, level*sizeof(ADDRESS));                                  \
316   t##__desc.basep[level] = (ADDRESS)t##__typ;                                                             \
317   t##__desc.module       = (ADDRESS)m;                                                                    \
318   if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15);                                                      \
319   t##__desc.blksz        = (t##__desc.blksz+5*sizeof(ADDRESS)-1)/(4*sizeof(ADDRESS))*(4*sizeof(ADDRESS)); \
320   Heap_REGTYP(m, (ADDRESS)&t##__desc.next);                                                               \
321   SYSTEM_INHERIT(t##__typ, t0##__typ)
322 
323 // Oberon-2 type bound procedures support
324 #define __INITBP(t, proc, num)            *(t##__typ-(__TPROC0OFF+num))=(ADDRESS)proc
325 #define __SEND(typ, num, funtyp, parlist) ((funtyp)((ADDRESS)*(typ-(__TPROC0OFF+num))))parlist
326 
327 
328 
329 
330 #endif
331