| author | DeaDDooMER <deaddoomer@deadsoftware.ru> | |
| Sun, 9 Jun 2019 18:20:34 +0000 (21:20 +0300) | ||
| committer | DeaDDooMER <deaddoomer@deadsoftware.ru> | |
| Sun, 9 Jun 2019 18:20:34 +0000 (21:20 +0300) |
101 files changed:
diff --git a/C/SYSTEM.c b/C/SYSTEM.c
--- /dev/null
+++ b/C/SYSTEM.c
@@ -0,0 +1,413 @@
+#include "SYSTEM.h"\r
+\r
+SYSTEM_MODDESC *SYSTEM_modlist = NIL;\r
+SYSTEM_DLINK *SYSTEM_dlink = NIL;\r
+\r
+LONGINT SYSTEM_INF = 0x7FF0000000000000L;\r
+INTEGER SYSTEM_INFS = 0x7F800000;\r
+\r
+CHAR SYSTEM_strBuf[32][256];\r
+INTEGER SYSTEM_actual;\r
+\r
+INTEGER SYSTEM_argCount;\r
+void *SYSTEM_argVector;\r
+\r
+void SYSTEM_REGMOD(SYSTEM_MODDESC *mod)\r
+{\r
+ int i;\r
+ mod->next = SYSTEM_modlist;\r
+ SYSTEM_modlist = mod;\r
+ for (i = 0; i < mod->nofimps; i++) mod->imports[i]->refcnt++;\r
+}\r
+\r
+typedef struct {\r
+ INTEGER gc[3], len[1];\r
+} Array;\r
+\r
+void *SYSTEM_NEWARR(INTEGER type, INTEGER n)\r
+{\r
+ int ptr = Kernel_NewArr(type, n, 1);\r
+ ((Array*)ptr)->len[0] = n;\r
+ return (void*)ptr;\r
+}\r
+\r
+void *SYSTEM_NEWARR1(INTEGER type, INTEGER n0, INTEGER n)\r
+{\r
+ int ptr = Kernel_NewArr(type, n * n0, 1);\r
+ ((Array*)ptr)->len[0] = n0;\r
+ return (void*)ptr;\r
+}\r
+\r
+void *SYSTEM_NEWARR2(INTEGER type, INTEGER n1, INTEGER n0, INTEGER n)\r
+{\r
+ int ptr = Kernel_NewArr(type, n * n0 * n1, 2);\r
+ ((Array*)ptr)->len[0] = n1;\r
+ ((Array*)ptr)->len[1] = n0;\r
+ return (void*)ptr;\r
+}\r
+\r
+void *SYSTEM_NEWARR3(INTEGER type, INTEGER n2, INTEGER n1, INTEGER n0, INTEGER n)\r
+{\r
+ int ptr = Kernel_NewArr(type, n * n0 * n1 * n2, 3);\r
+ ((Array*)ptr)->len[0] = n2;\r
+ ((Array*)ptr)->len[1] = n1;\r
+ ((Array*)ptr)->len[2] = n0;\r
+ return (void*)ptr;\r
+}\r
+\r
+void *SYSTEM_NEWARR4(INTEGER type, INTEGER n3, INTEGER n2, INTEGER n1, INTEGER n0, INTEGER n)\r
+{\r
+ int ptr = Kernel_NewArr(type, n * n0 * n1 * n2 * n3, 4);\r
+ ((Array*)ptr)->len[0] = n3;\r
+ ((Array*)ptr)->len[1] = n2;\r
+ ((Array*)ptr)->len[2] = n1;\r
+ ((Array*)ptr)->len[3] = n0;\r
+ return (void*)ptr;\r
+}\r
+\r
+INTEGER SYSTEM_XCHK(INTEGER i, INTEGER ub)\r
+{\r
+ if ((unsigned)(i)>=(unsigned)(ub)) __HALT(-7);\r
+ return i;\r
+}\r
+\r
+\r
+CHAR* SYSTEM_LSTR(char *x)\r
+{\r
+ CHAR *str = SYSTEM_strBuf[SYSTEM_actual];\r
+ int i = 0;\r
+ SYSTEM_actual = (SYSTEM_actual + 1) & 0x1F;\r
+ do {\r
+ if (i == 256) __HALT(-8);\r
+ str[i] = x[i];\r
+ } while (x[i++] != 0);\r
+ return str;\r
+}\r
+\r
+INTEGER SYSTEM_ASH(INTEGER x, INTEGER n)\r
+{\r
+ if (n >= 0) return x << n;\r
+ else return x >> (-n);\r
+}\r
+\r
+LONGINT SYSTEM_ASHL(LONGINT x, INTEGER n)\r
+{\r
+ if (n >= 0) return x << n;\r
+ else return x >> (-n);\r
+}\r
+\r
+INTEGER SYSTEM_ABS(INTEGER x)\r
+{\r
+ if (x<0) x=-x;\r
+ return x;\r
+}\r
+\r
+LONGINT SYSTEM_ABSL(LONGINT x)\r
+{\r
+ if (x<0) x=-x;\r
+ return x;\r
+}\r
+\r
+SHORTREAL SYSTEM_ABSF(SHORTREAL x)\r
+{\r
+ if (x<0) x=-x;\r
+ return x;\r
+}\r
+\r
+REAL SYSTEM_ABSD(REAL x)\r
+{\r
+ if (x<0) x=-x;\r
+ return x;\r
+}\r
+\r
+INTEGER SYSTEM_ENTIER(REAL x)\r
+{\r
+ INTEGER i;\r
+ i = (INTEGER)x;\r
+ if (i > x) i--;\r
+ return i;\r
+}\r
+\r
+LONGINT SYSTEM_ENTIERL(REAL x)\r
+{\r
+ LONGINT i;\r
+ i = (LONGINT)x;\r
+ if (i > x) i--;\r
+ return i;\r
+}\r
+\r
+INTEGER SYSTEM_DIV(INTEGER x, INTEGER y)\r
+{\r
+ if (y > 0) {\r
+ if (x < 0) return ~(~x / y);\r
+ else return x / y;\r
+ } else if (y < 0) {\r
+ if (x > 0) return ~((x - 1) / -y);\r
+ else return -x / -y;\r
+ } else {\r
+ __HALT(-5);\r
+ }\r
+}\r
+\r
+LONGINT SYSTEM_DIVL(LONGINT x, LONGINT y)\r
+{\r
+ if (y > 0) {\r
+ if (x < 0) return ~(~x / y);\r
+ else return x / y;\r
+ } else if (y < 0) {\r
+ if (x > 0) return ~((x - 1) / -y);\r
+ else return -x / -y;\r
+ } else {\r
+ __HALT(-5);\r
+ }\r
+}\r
+\r
+INTEGER SYSTEM_MOD(INTEGER x, INTEGER y)\r
+{\r
+ if (y > 0) {\r
+ if (x < 0) return y + ~(~x % y);\r
+ else return x % y;\r
+ } else if (y < 0) {\r
+ if (x > 0) return y + 1 + ((x - 1) % -y);\r
+ else return -(-x % -y);\r
+ } else {\r
+ __HALT(-5);\r
+ }\r
+}\r
+\r
+LONGINT SYSTEM_MODL(LONGINT x, LONGINT y)\r
+{\r
+ if (y > 0) {\r
+ if (x < 0) return y + ~(~x % y);\r
+ else return x % y;\r
+ } else if (y < 0) {\r
+ if (x > 0) return y + 1 + ((x - 1) % -y);\r
+ else return -(-x % -y);\r
+ } else {\r
+ __HALT(-5);\r
+ }\r
+}\r
+\r
+INTEGER SYSTEM_MIN(INTEGER x, INTEGER y)\r
+{\r
+ if (x > y) x = y;\r
+ return x;\r
+}\r
+\r
+LONGINT SYSTEM_MINL(LONGINT x, LONGINT y)\r
+{\r
+ if (x > y) x = y;\r
+ return x;\r
+}\r
+\r
+SHORTREAL SYSTEM_MINF(SHORTREAL x, SHORTREAL y)\r
+{\r
+ if (x > y) x = y;\r
+ return x;\r
+}\r
+\r
+REAL SYSTEM_MIND(REAL x, REAL y)\r
+{\r
+ if (x > y) x = y;\r
+ return x;\r
+}\r
+\r
+INTEGER SYSTEM_MAX(INTEGER x, INTEGER y)\r
+{\r
+ if (x < y) x = y;\r
+ return x;\r
+}\r
+\r
+LONGINT SYSTEM_MAXL(LONGINT x, LONGINT y)\r
+{\r
+ if (x < y) x = y;\r
+ return x;\r
+}\r
+\r
+SHORTREAL SYSTEM_MAXF(SHORTREAL x, SHORTREAL y)\r
+{\r
+ if (x < y) x = y;\r
+ return x;\r
+}\r
+\r
+REAL SYSTEM_MAXD(REAL x, REAL y)\r
+{\r
+ if (x < y) x = y;\r
+ return x;\r
+}\r
+\r
+\r
+SHORTREAL SYSTEM_INT2SR(INTEGER x)\r
+{\r
+ return *(SHORTREAL*)&x;\r
+}\r
+\r
+REAL SYSTEM_LONG2R(LONGINT x)\r
+{\r
+ return *(REAL*)&x;\r
+}\r
+\r
+INTEGER SYSTEM_SR2INT(SHORTREAL x)\r
+{\r
+ return *(INTEGER*)&x;\r
+}\r
+\r
+LONGINT SYSTEM_R2LONG(REAL x)\r
+{\r
+ return *(LONGINT*)&x;\r
+}\r
+\r
+\r
+\r
+\r
+INTEGER SYSTEM_STRLEN(CHAR x[]) /* LEN(lx$) */\r
+{\r
+ int i = 0;\r
+ while (x[i] != 0) i++;\r
+ return i;\r
+}\r
+\r
+INTEGER SYSTEM_STRLENS(SHORTCHAR x[]) /* LEN(sx$) */\r
+{\r
+ int i = 0;\r
+ while (x[i] != 0) i++;\r
+ return i;\r
+}\r
+\r
+INTEGER SYSTEM_STRCMPSS(SHORTCHAR x[], SHORTCHAR y[]) /* sx = sy */\r
+{\r
+ int i = 0;\r
+ while (x[i] == y[i] && y[i] != 0) i++;\r
+ return x[i] - y[i];\r
+}\r
+\r
+INTEGER SYSTEM_STRCMPTS(CHAR x[], SHORTCHAR y[]) /* SHORT(lx) = sy */\r
+{\r
+ int i = 0;\r
+ while ((x[i] & 0xff) == y[i] && y[i] != 0) i++;\r
+ return (x[i] & 0xff) - y[i];\r
+}\r
+\r
+INTEGER SYSTEM_STRCMPTT(CHAR x[], CHAR y[]) /* SHORT(lx) = SHORT(ly) */\r
+{\r
+ int i = 0;\r
+ while ((x[i] & 0xff) == (y[i] & 0xff) && (y[i] & 0xff) != 0) i++;\r
+ return (x[i] & 0xff) - (y[i] & 0xff);\r
+}\r
+\r
+INTEGER SYSTEM_STRCMPLL(CHAR x[], CHAR y[]) /* lx = ly */\r
+{\r
+ int i = 0;\r
+ while (x[i] == y[i] && y[i] != 0) i++;\r
+ return x[i] - y[i];\r
+}\r
+\r
+INTEGER SYSTEM_STRCMPSL(SHORTCHAR x[], CHAR y[]) /* LONG(sx) = ly */\r
+{\r
+ int i = 0;\r
+ while (x[i] == y[i] && y[i] != 0) i++;\r
+ return x[i] - y[i];\r
+}\r
+\r
+INTEGER SYSTEM_STRCMPTL(CHAR x[], CHAR y[]) /* LONG(SHORT(lx)) = ly */\r
+{\r
+ int i = 0;\r
+ while ((x[i] & 0xff) == y[i] && y[i] != 0) i++;\r
+ return (x[i] & 0xff) - y[i];\r
+}\r
+\r
+void SYSTEM_STRCOPYSS(SHORTCHAR x[], SHORTCHAR y[], INTEGER n) /* sy := sx */\r
+{\r
+ int i = 0;\r
+ do {\r
+ if (n-- == 0) __HALT(-8);\r
+ y[i] = x[i];\r
+ } while (x[i++] != 0);\r
+}\r
+\r
+void SYSTEM_STRCOPYTS(CHAR x[], SHORTCHAR y[], INTEGER n) /* sy := SHORT(lx) */\r
+{\r
+ int i = 0;\r
+ do {\r
+ if (n-- == 0) __HALT(-8);\r
+ y[i] = (SHORTCHAR)x[i];\r
+ } while ((x[i++] & 0xff) != 0);\r
+}\r
+\r
+void SYSTEM_STRCOPYLL(CHAR x[], CHAR y[], INTEGER n) /* ly := lx */\r
+{\r
+ int i = 0;\r
+ do {\r
+ if (n-- == 0) __HALT(-8);\r
+ y[i] = x[i];\r
+ } while (x[i++] != 0);\r
+}\r
+\r
+void SYSTEM_STRCOPYSL(SHORTCHAR x[], CHAR y[], INTEGER n) /* ly := LONG(sx) */\r
+{\r
+ int i = 0;\r
+ do {\r
+ if (n-- == 0) __HALT(-8);\r
+ y[i] = x[i];\r
+ } while (x[i++] != 0);\r
+}\r
+\r
+void SYSTEM_STRCOPYTL(CHAR x[], CHAR y[], INTEGER n) /* ly := LONG(SHORT(lx)) */\r
+{\r
+ int i = 0;\r
+ do {\r
+ if (n-- == 0) __HALT(-8);\r
+ y[i] = (x[i] & 0xff);\r
+ } while ((x[i++] & 0xff) != 0);\r
+}\r
+\r
+void SYSTEM_STRAPNDSS(SHORTCHAR x[], SHORTCHAR y[], INTEGER n) /* sy := sy + sx */\r
+{\r
+ int i = 0, j = 0;\r
+ while (y[j] != 0) j++;\r
+ do {\r
+ if (n-- == 0) __HALT(-8);\r
+ y[j++] = x[i];\r
+ } while (x[i++] != 0);\r
+}\r
+\r
+void SYSTEM_STRAPNDTS(CHAR x[], SHORTCHAR y[], INTEGER n) /* sy := sy + SHORT(lx) */\r
+{\r
+ int i = 0, j = 0;\r
+ while (y[j] != 0) j++;\r
+ do {\r
+ if (n-- == 0) __HALT(-8);\r
+ y[j++] = (SHORTCHAR)x[i];\r
+ } while ((x[i++] & 0xff) != 0);\r
+}\r
+\r
+void SYSTEM_STRAPNDLL(CHAR x[], CHAR y[], INTEGER n) /* ly := ly + lx */\r
+{\r
+ int i = 0, j = 0;\r
+ while (y[j] != 0) j++;\r
+ do {\r
+ if (n-- == 0) __HALT(-8);\r
+ y[j++] = x[i];\r
+ } while (x[i++] != 0);\r
+}\r
+\r
+void SYSTEM_STRAPNDSL(SHORTCHAR x[], CHAR y[], INTEGER n) /* ly := ly + LONG(sx) */\r
+{\r
+ int i = 0, j = 0;\r
+ while (y[j] != 0) j++;\r
+ do {\r
+ if (n-- == 0) __HALT(-8);\r
+ y[j++] = x[i];\r
+ } while (x[i++] != 0);\r
+}\r
+\r
+void SYSTEM_STRAPNDTL(CHAR x[], CHAR y[], INTEGER n) /* ly := ly + LONG(SHORT(lx)) */\r
+{\r
+ int i = 0, j = 0;\r
+ while (y[j] != 0) j++;\r
+ do {\r
+ if (n-- == 0) __HALT(-8);\r
+ y[j++] = (x[i] & 0xff);\r
+ } while ((x[i++] & 0xff) != 0);\r
+}\r
+\r
diff --git a/C/SYSTEM.h b/C/SYSTEM.h
--- /dev/null
+++ b/C/SYSTEM.h
@@ -0,0 +1,356 @@
+#ifndef SYSTEM__h\r
+#define SYSTEM__h\r
+\r
+/*\r
+\r
+the CPfront runtime system interface and macro library\r
+based on SYSTEM.h by Josef Templ\r
+bh 20.12.1999\r
+\r
+*/\r
+\r
+\r
+#pragma warning(disable:4101) // disable "unreferenced variable" warning\r
+\r
+#ifdef __GNUC__\r
+# include <alloca.h>\r
+#endif\r
+#include <malloc.h>\r
+#include <string.h>\r
+\r
+// extern char *memcpy();\r
+\r
+#define export\r
+#define import extern\r
+\r
+/* basic types */\r
+typedef unsigned char BOOLEAN;\r
+typedef unsigned char SHORTCHAR;\r
+typedef unsigned short CHAR;\r
+typedef signed char BYTE;\r
+typedef short SHORTINT;\r
+typedef int INTEGER;\r
+#if !defined(_WIN64) && ((__SIZEOF_POINTER__ == 8) || defined (_LP64) || defined(__LP64__))\r
+ typedef long LONGINT; // LP64\r
+ typedef unsigned long __U_LONGINT;\r
+#else\r
+ typedef long long LONGINT; // ILP32 or LLP64\r
+ typedef unsigned long long __U_LONGINT;\r
+#endif\r
+typedef float SHORTREAL;\r
+typedef double REAL;\r
+typedef unsigned int SET;\r
+typedef void ANYREC;\r
+typedef void *ANYPTR;\r
+typedef void *SYSTEM_PTR;\r
+\r
+/* Unsigned variants are for use by shift and rotate macros */\r
+typedef unsigned char __U_SHORTCHAR;\r
+typedef unsigned short __U_CHAR;\r
+typedef unsigned char __U_BYTE;\r
+typedef unsigned short __U_SHORTINT;\r
+typedef unsigned int __U_INTEGER;\r
+typedef unsigned int __U_SET;\r
+\r
+extern LONGINT SYSTEM_INF;\r
+extern INTEGER SYSTEM_INFS;\r
+extern INTEGER SYSTEM_argCount;\r
+extern void *SYSTEM_argVector;\r
+\r
+/* constants */\r
+#define __MAXEXT 15\r
+#define NIL 0\r
+#define POINTER__typ (INTEGER*)1 /* not NIL and not a valid type */\r
+#define __INF (*(REAL*)&SYSTEM_INF)\r
+#define __INFS (*(SHORTREAL*)&SYSTEM_INFS)\r
+\r
+#if defined _WIN32 || defined __CYGWIN__\r
+# ifdef __GNUC__\r
+# define __EXTERN __attribute__((dllimport))\r
+# else\r
+# define __EXTERN __declspec(dllimport)\r
+# endif\r
+#else\r
+# if __GNUC__ >= 4 && !defined(__OS2__)\r
+# define __EXTERN __attribute__((visibility("default")))\r
+# else\r
+# define __EXTERN\r
+# endif\r
+#endif\r
+#define __CALLBACK __attribute__((__stdcall__))\r
+\r
+\r
+/* simple open array types */\r
+\r
+typedef struct BOOLEAN_ARRAY {\r
+ INTEGER gc[3], len[1];\r
+ BOOLEAN data[1];\r
+} BOOLEAN_ARRAY;\r
+typedef struct CHAR_ARRAY {\r
+ INTEGER gc[3], len[1];\r
+ CHAR data[1];\r
+} CHAR_ARRAY;\r
+typedef struct SHORTCHAR_ARRAY {\r
+ INTEGER gc[3], len[1];\r
+ SHORTCHAR data[1];\r
+} SHORTCHAR_ARRAY;\r
+typedef struct BYTE_ARRAY {\r
+ INTEGER gc[3], len[1];\r
+ BYTE data[1];\r
+} BYTE_ARRAY;\r
+typedef struct SHORTINT_ARRAY {\r
+ INTEGER gc[3], len[1];\r
+ SHORTINT data[1];\r
+} SHORTINT_ARRAY;\r
+typedef struct INTEGER_ARRAY {\r
+ INTEGER gc[3], len[1];\r
+ INTEGER data[1];\r
+} INTEGER_ARRAY;\r
+typedef struct LONGINT_ARRAY {\r
+ INTEGER gc[3], len[1];\r
+ LONGINT data[1];\r
+} LONGINT_ARRAY;\r
+typedef struct REAL_ARRAY {\r
+ INTEGER gc[3], len[1];\r
+ REAL data[1];\r
+} REAL_ARRAY;\r
+typedef struct SHORTREAL_ARRAY {\r
+ INTEGER gc[3], len[1];\r
+ SHORTREAL data[1];\r
+} SHORTREAL_ARRAY;\r
+typedef struct SET_ARRAY {\r
+ INTEGER gc[3], len[1];\r
+ SET data[1];\r
+} SET_ARRAY;\r
+\r
+/* meta info */\r
+\r
+typedef struct SYSTEM_OBJDESC {\r
+ INTEGER fprint, offs, id, struc;\r
+} SYSTEM_OBJDESC;\r
+typedef struct SYSTEM_DIRECTORY {\r
+ INTEGER num;\r
+ struct SYSTEM_OBJDESC obj[1];\r
+} SYSTEM_DIRECTORY;\r
+typedef struct SYSTEM_MODDESC {\r
+ struct SYSTEM_MODDESC *next;\r
+ SET opts;\r
+ INTEGER refcnt;\r
+ SHORTINT compTime[6], loadTime[6];\r
+ void (*body) ();\r
+ void (*term) ();\r
+ INTEGER nofimps, nofptrs, size, dsize, rsize, code, data, refs, procBase, varBase;\r
+ char *names;\r
+ INTEGER *ptrs;\r
+ struct SYSTEM_MODDESC **imports;\r
+ struct SYSTEM_DIRECTORY *exp;\r
+ char name[256];\r
+} SYSTEM_MODDESC;\r
+typedef struct SYSTEM_TYPEDESC {\r
+ INTEGER size;\r
+ struct SYSTEM_MODDESC *mod;\r
+ INTEGER id;\r
+ INTEGER base[16];\r
+ struct SYSTEM_DIRECTORY *fields;\r
+ INTEGER ptroffs[1];\r
+} SYSTEM_TYPEDESC;\r
+\r
+/* dynamic link */\r
+\r
+typedef struct SYSTEM_DLINK {\r
+ struct SYSTEM_DLINK *next;\r
+ char *name;\r
+} SYSTEM_DLINK;\r
+extern SYSTEM_DLINK *SYSTEM_dlink;\r
+\r
+\r
+/* runtime system routines */\r
+extern CHAR* SYSTEM_LSTR(char *x);\r
+extern INTEGER SYSTEM_DIV(INTEGER x, INTEGER y);\r
+extern INTEGER SYSTEM_MOD(INTEGER x, INTEGER y);\r
+extern INTEGER SYSTEM_MIN(INTEGER x, INTEGER y);\r
+extern INTEGER SYSTEM_MAX(INTEGER x, INTEGER y);\r
+extern INTEGER SYSTEM_ENTIER(REAL x);\r
+extern INTEGER SYSTEM_ASH(INTEGER x, INTEGER n);\r
+extern INTEGER SYSTEM_ABS(INTEGER x);\r
+extern INTEGER SYSTEM_XCHK(INTEGER i, INTEGER ub);\r
+extern void *SYSTEM_NEWARR(INTEGER type, INTEGER n);\r
+extern void *SYSTEM_NEWARR1(INTEGER type, INTEGER n0, INTEGER n);\r
+extern void *SYSTEM_NEWARR2(INTEGER type, INTEGER n1, INTEGER n0, INTEGER n);\r
+extern void *SYSTEM_NEWARR3(INTEGER type, INTEGER n2, INTEGER n1, INTEGER n0, INTEGER n);\r
+extern void *SYSTEM_NEWARR4(INTEGER type, INTEGER n3, INTEGER n2, INTEGER n1, INTEGER n0, INTEGER n);\r
+extern void SYSTEM_REGMOD(struct SYSTEM_MODDESC *mod);\r
+extern INTEGER SYSTEM_STRLEN(CHAR x[]); /* LEN(lx$) */\r
+extern INTEGER SYSTEM_STRLENS(SHORTCHAR x[]); /* LEN(sx$) */\r
+extern INTEGER SYSTEM_STRCMPSS(SHORTCHAR x[], SHORTCHAR y[]); /* sx = sy */\r
+extern INTEGER SYSTEM_STRCMPTS(CHAR x[], SHORTCHAR y[]); /* SHORT(lx) = sy */\r
+extern INTEGER SYSTEM_STRCMPTT(CHAR x[], CHAR y[]); /* SHORT(lx) = SHORT(ly) */\r
+extern INTEGER SYSTEM_STRCMPLL(CHAR x[], CHAR y[]); /* lx = ly */\r
+extern INTEGER SYSTEM_STRCMPSL(SHORTCHAR x[], CHAR y[]); /* LONG(sx) = ly */\r
+extern INTEGER SYSTEM_STRCMPTL(CHAR x[], CHAR y[]); /* LONG(SHORT(lx)) = ly */\r
+extern void SYSTEM_STRCOPYSS(SHORTCHAR x[], SHORTCHAR y[], INTEGER n); /* sy := sx */\r
+extern void SYSTEM_STRCOPYTS(CHAR x[], SHORTCHAR y[], INTEGER n); /* sy := SHORT(lx) */\r
+extern void SYSTEM_STRCOPYLL(CHAR x[], CHAR y[], INTEGER n); /* ly := lx */\r
+extern void SYSTEM_STRCOPYSL(SHORTCHAR x[], CHAR y[], INTEGER n); /* ly := LONG(sx) */\r
+extern void SYSTEM_STRCOPYTL(CHAR x[], CHAR y[], INTEGER n); /* ly := LONG(SHORT(lx)) */\r
+extern void SYSTEM_STRAPNDSS(SHORTCHAR x[], SHORTCHAR y[], INTEGER n); /* sy := sy + sx */\r
+extern void SYSTEM_STRAPNDTS(CHAR x[], SHORTCHAR y[], INTEGER n); /* sy := sy + SHORT(lx) */\r
+extern void SYSTEM_STRAPNDLL(CHAR x[], CHAR y[], INTEGER n); /* ly := ly + lx */\r
+extern void SYSTEM_STRAPNDSL(SHORTCHAR x[], CHAR y[], INTEGER n); /* ly := ly + LONG(sx) */\r
+extern void SYSTEM_STRAPNDTL(CHAR x[], CHAR y[], INTEGER n); /* ly := ly + LONG(SHORT(lx)) */\r
+extern LONGINT SYSTEM_DIVL(LONGINT x, LONGINT y);\r
+extern LONGINT SYSTEM_MODL(LONGINT x, LONGINT y);\r
+extern LONGINT SYSTEM_MINL(LONGINT x, LONGINT y);\r
+extern LONGINT SYSTEM_MAXL(LONGINT x, LONGINT y);\r
+extern LONGINT SYSTEM_ASHL(LONGINT x, INTEGER n);\r
+extern LONGINT SYSTEM_ABSL(LONGINT x);\r
+extern SHORTREAL SYSTEM_INT2SR(INTEGER x);\r
+extern REAL SYSTEM_LONG2R(LONGINT x);\r
+extern LONGINT SYSTEM_ENTIERL(REAL x);\r
+extern INTEGER SYSTEM_SR2INT(SHORTREAL x);\r
+extern LONGINT SYSTEM_R2LONG(REAL x);\r
+extern SHORTREAL SYSTEM_ABSF(SHORTREAL x);\r
+extern SHORTREAL SYSTEM_MINF(SHORTREAL x, SHORTREAL y);\r
+extern SHORTREAL SYSTEM_MAXF(SHORTREAL x, SHORTREAL y);\r
+extern REAL SYSTEM_ABSD(REAL x);\r
+extern REAL SYSTEM_MIND(REAL x, REAL y);\r
+extern REAL SYSTEM_MAXD(REAL x, REAL y);\r
+\r
+extern INTEGER Kernel_NewRec(INTEGER typ);\r
+extern INTEGER Kernel_NewArr(INTEGER eltyp, INTEGER nofelem, INTEGER nofdim);\r
+extern void Kernel_Trap(INTEGER n);\r
+\r
+\r
+#define __INIT(argc, argv) SYSTEM_argCount = argc; SYSTEM_argVector = *(void**)&argv\r
+#define __BEGREG(mod) if (mod.opts & 0x40000) return; mod.opts |= 0x40000;\r
+#define __ENDREG \r
+#define __REGMOD(mod) SYSTEM_REGMOD(&mod);\r
+#define __BEGBODY(mod) if (mod.opts & 0x10000) return; mod.opts |= 0x10000;\r
+#define __ENDBODY \r
+#define __BEGCLOSE \r
+#define __ENDCLOSE \r
+#define __ENTER(name) SYSTEM_DLINK __dl = {SYSTEM_dlink, name}; SYSTEM_dlink = &__dl\r
+#define __EXIT SYSTEM_dlink = __dl.next\r
+\r
+/* SYSTEM ops */\r
+#define __VAL(t, x) (*(t*)&(x))\r
+#define __VALSR(x) SYSTEM_INT2SR(x)\r
+#define __VALR(x) SYSTEM_LONG2R(x)\r
+#define __VALI(x) SYSTEM_SR2INT(x)\r
+#define __VALL(x) SYSTEM_R2LONG(x)\r
+#define __GET(a, x, t) x= *(t*)(a)\r
+#define __PUT(a, x, t) *(t*)(a)=(t)x\r
+#define __LSHL(x, n, t) ((t)((__U_##t)(x)<<(n)))\r
+#define __LSHR(x, n, t) ((t)((__U_##t)(x)>>(n)))\r
+#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t))\r
+#define __ROTL(x, n, t) ((t)((__U_##t)(x)<<(n)|(__U_##t)(x)>>(8*sizeof(t)-(n))))\r
+#define __ROTR(x, n, t) ((t)((__U_##t)(x)>>(n)|(__U_##t)(x)<<(8*sizeof(t)-(n))))\r
+#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t))\r
+#define __BIT(x, n) (*(unsigned*)(x)>>(n)&1)\r
+#define __MOVE(s, d, n) memcpy((char*)(d),(char*)(s),n)\r
+\r
+/* std procs and operator mappings */\r
+// #define __SHORT(x, y) ((int)((unsigned)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0)))\r
+// #define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y)))\r
+// #define __CHR(x) ((CHAR)__R(x, 256))\r
+// #define __CHRF(x) ((CHAR)__RF(x, 256))\r
+#define __DIV(x, y) ((x)>=0?(x)/(y):~(~(x)/(y)))\r
+#define __DIVF(x, y) SYSTEM_DIV(x,y)\r
+#define __DIVFL(x, y) SYSTEM_DIVL(x,y)\r
+#define __MOD(x, y) ((x)>=0?(x)%(y):(y)+~(~(x)%(y)))\r
+#define __MODF(x, y) SYSTEM_MOD(x,y)\r
+#define __MODFL(x, y) SYSTEM_MODL(x,y)\r
+#define __MIN(x, y) ((x)<(y)?(x):(y))\r
+#define __MINF(x, y) SYSTEM_MIN(x,y)\r
+#define __MINFL(x, y) SYSTEM_MINL(x,y)\r
+#define __MINFF(x, y) SYSTEM_MINF(x,y)\r
+#define __MINFD(x, y) SYSTEM_MIND(x,y)\r
+#define __MAX(x, y) ((x)>(y)?(x):(y))\r
+#define __MAXF(x, y) SYSTEM_MAX(x,y)\r
+#define __MAXFL(x, y) SYSTEM_MAXL(x,y)\r
+#define __MAXFF(x, y) SYSTEM_MAXF(x,y)\r
+#define __MAXFD(x, y) SYSTEM_MAXD(x,y)\r
+#define __NEW(t) (void*)Kernel_NewRec((INTEGER)t)\r
+#define __NEWARR(t, n) (void*)SYSTEM_NEWARR(t, n)\r
+#define __NEWARR0(t, n) (void*)Kernel_NewArr(t, n, 0)\r
+#define __NEWARR1(t, n0, n) (void*)SYSTEM_NEWARR1(t, n0, n)\r
+#define __NEWARR2(t, n1, n0, n) (void*)SYSTEM_NEWARR2(t, n1, n0, n)\r
+#define __NEWARR3(t, n2, n1, n0, n) (void*)SYSTEM_NEWARR3(t, n2, n1, n0, n)\r
+#define __NEWARR4(t, n3, n2, n1, n0, n) (void*)SYSTEM_NEWARR4(t, n3, n2, n1, n0, n)\r
+#define __HALT(x) Kernel_Trap(x)\r
+#define __ASSERT(cond, x) if (!(cond)) __HALT(x)\r
+#define __ENTIER(x) SYSTEM_ENTIER(x)\r
+#define __ENTIERL(x) SYSTEM_ENTIERL(x)\r
+#define __ABS(x) (((x)<0)?-(x):(x))\r
+#define __ABSF(x) SYSTEM_ABS(x)\r
+#define __ABSFL(x) SYSTEM_ABSL(x)\r
+#define __ABSFF(x) SYSTEM_ABSF(x)\r
+#define __ABSFD(x) SYSTEM_ABSD(x)\r
+#define __CAP(ch) ((CHAR)((ch)&0x5f))\r
+#define __ODD(x) ((x)&1)\r
+#define __IN(x, s) (((s)>>(x))&1)\r
+#define __SETOF(x) ((SET)1<<(x))\r
+#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h)))\r
+#define __MASK(x, m) ((x)&~(m))\r
+#define __LSTR(x) SYSTEM_LSTR(x)\r
+\r
+#define __STRLEN(x) SYSTEM_STRLEN(x) /* LEN(lx$) */\r
+#define __STRLENS(x) SYSTEM_STRLENS(x) /* LEN(sx$) */\r
+#define __STRCMPSS(x, y) SYSTEM_STRCMPSS(x, y) /* sx = sy */\r
+#define __STRCMPTS(x, y) SYSTEM_STRCMPTS(x, y) /* SHORT(lx) = sy */\r
+#define __STRCMPTT(x, y) SYSTEM_STRCMPTT(x, y) /* SHORT(lx) = SHORT(ly) */\r
+#define __STRCMPLL(x, y) SYSTEM_STRCMPLL(x, y) /* lx = ly */\r
+#define __STRCMPSL(x, y) SYSTEM_STRCMPSL(x, y) /* LONG(sx) = ly */\r
+#define __STRCMPTL(x, y) SYSTEM_STRCMPTL(x, y) /* LONG(SHORT(lx)) = ly */\r
+#define __STRCOPYSS(x, y, n) SYSTEM_STRCOPYSS(x, y, n) /* sy := sx */\r
+#define __STRCOPYTS(x, y, n) SYSTEM_STRCOPYTS(x, y, n) /* sy := SHORT(lx) */\r
+#define __STRCOPYLL(x, y, n) SYSTEM_STRCOPYLL(x, y, n) /* ly := lx */\r
+#define __STRCOPYSL(x, y, n) SYSTEM_STRCOPYSL(x, y, n) /* ly := LONG(sx) */\r
+#define __STRCOPYTL(x, y, n) SYSTEM_STRCOPYTL(x, y, n) /* ly := LONG(SHORT(lx)) */\r
+#define __STRAPNDSS(x, y, n) SYSTEM_STRAPNDSS(x, y, n) /* sy := sy + sx */\r
+#define __STRAPNDTS(x, y, n) SYSTEM_STRAPNDTS(x, y, n) /* sy := sy + SHORT(lx) */\r
+#define __STRAPNDLL(x, y, n) SYSTEM_STRAPNDLL(x, y, n) /* ly := ly + lx */\r
+#define __STRAPNDSL(x, y, n) SYSTEM_STRAPNDSL(x, y, n) /* ly := ly + LONG(sx) */\r
+#define __STRAPNDTL(x, y, n) SYSTEM_STRAPNDTL(x, y, n) /* ly := ly + LONG(SHORT(lx)) */\r
+\r
+#define __ASH(x, n, t) ((n)>=0?__ASHL(x,n,t):__ASHR(x,-(n),t))\r
+#define __ASHL(x, n, t) ((t)(x)<<(n))\r
+#define __ASHR(x, n, t) ((t)(x)>>(n))\r
+#define __ASHF(x, n, t) SYSTEM_ASH(x, n)\r
+#define __ASHFL(x, n, t) SYSTEM_ASHL(x, n)\r
+#define __DUP(x, l) x=(void*)memcpy(alloca(l*sizeof(*x)),x,l*sizeof(*x))\r
+#define __DUPARR(v) v=(void*)memcpy(v##__copy,v,sizeof(v##__copy))\r
+#define __DEL(x) /* DUP with alloca frees storage automatically */\r
+#define __IS(tag, typ, level) ((tag->base[level])==(INTEGER)typ)\r
+#define __TYPEOF(p) (*(((SYSTEM_TYPEDESC**)(p))-1))\r
+#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level)\r
+\r
+/* runtime checks */\r
+#define __X(i, ub) (((unsigned)(i)<(unsigned)(ub))?i:(__HALT(-7),0))\r
+#define __XF(i, ub) SYSTEM_XCHK((INTEGER)(i), (INTEGER)(ub))\r
+// #define __RETCHK __retchk: __HALT(-3)\r
+#define __RETCHK __HALT(-3)\r
+#define __CASECHK __HALT(-2)\r
+#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-4),p)))\r
+#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-4),r))))\r
+#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-4),p)))\r
+#define __WITHCHK __HALT(-1)\r
+\r
+/* Oberon-2 type bound procedures support */\r
+#define __SEND(typ, num, funtyp, parlist) ((funtyp)(*((INTEGER*)typ-(num+1))))parlist\r
+\r
+/* runtime system variables */\r
+extern SYSTEM_MODDESC *SYSTEM_modlist;\r
+extern LONGINT SYSTEM_argc;\r
+extern LONGINT SYSTEM_argv;\r
+extern void (*SYSTEM_Halt)();\r
+extern LONGINT SYSTEM_halt;\r
+extern LONGINT SYSTEM_assert;\r
+extern SYSTEM_PTR SYSTEM_modules;\r
+extern LONGINT SYSTEM_heapsize;\r
+extern LONGINT SYSTEM_allocated;\r
+extern LONGINT SYSTEM_lock;\r
+extern SHORTINT SYSTEM_gclock;\r
+extern BOOLEAN SYSTEM_interrupted;\r
+\r
+#endif\r
diff --git a/C/_windows.h b/C/_windows.h
--- /dev/null
+++ b/C/_windows.h
@@ -0,0 +1,18 @@
+// windows.h wrapper\r
+// Includes windows.h while avoiding conflicts with Component Pascal types.\r
+\r
+#define BOOLEAN _BOOLEAN\r
+#define BYTE _BYTE\r
+#define CHAR _CHAR\r
+\r
+#undef _WIN32_WINNT\r
+// 0x0501 is for Windows XP (no service pack)\r
+#define _WIN32_WINNT 0x0501\r
+#include <windows.h>\r
+\r
+#undef BOOLEAN\r
+#undef BYTE\r
+#undef CHAR\r
+\r
+typedef void *PtrVoid;\r
+typedef CHAR *PtrWSTR;\r
diff --git a/CHANGELOG b/CHANGELOG
--- /dev/null
+++ b/CHANGELOG
@@ -0,0 +1,5 @@
+v0.1:
+* implemented true command line versions of DevCompiler, Dev2Linker and CPfront
+* implemented new generic Host for POSIX-compatible systems
+* implemented Kernel for CPfront
+* implemented generic Int and 486-specific Long modules
diff --git a/LICENSE b/LICENSE
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,674 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The GNU General Public License is a free, copyleft license for
+software and other kinds of works.
+
+ The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works. By contrast,
+the GNU General Public License is intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users. We, the Free Software Foundation, use the
+GNU General Public License for most of our software; it applies also to
+any other work released this way by its authors. You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+ To protect your rights, we need to prevent others from denying you
+these rights or asking you to surrender the rights. Therefore, you have
+certain responsibilities if you distribute copies of the software, or if
+you modify it: responsibilities to respect the freedom of others.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must pass on to the recipients the same
+freedoms that you received. You must make sure that they, too, receive
+or can get the source code. And you must show them these terms so they
+know their rights.
+
+ Developers that use the GNU GPL protect your rights with two steps:
+(1) assert copyright on the software, and (2) offer you this License
+giving you legal permission to copy, distribute and/or modify it.
+
+ For the developers' and authors' protection, the GPL clearly explains
+that there is no warranty for this free software. For both users' and
+authors' sake, the GPL requires that modified versions be marked as
+changed, so that their problems will not be attributed erroneously to
+authors of previous versions.
+
+ Some devices are designed to deny users access to install or run
+modified versions of the software inside them, although the manufacturer
+can do so. This is fundamentally incompatible with the aim of
+protecting users' freedom to change the software. The systematic
+pattern of such abuse occurs in the area of products for individuals to
+use, which is precisely where it is most unacceptable. Therefore, we
+have designed this version of the GPL to prohibit the practice for those
+products. If such problems arise substantially in other domains, we
+stand ready to extend this provision to those domains in future versions
+of the GPL, as needed to protect the freedom of users.
+
+ Finally, every program is threatened constantly by software patents.
+States should not allow patents to restrict development and use of
+software on general-purpose computers, but in those that do, we wish to
+avoid the special danger that patents applied to a free program could
+make it effectively proprietary. To prevent this, the GPL assures that
+patents cannot be used to render the program non-free.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ TERMS AND CONDITIONS
+
+ 0. Definitions.
+
+ "This License" refers to version 3 of the GNU General Public License.
+
+ "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+ "The Program" refers to any copyrightable work licensed under this
+License. Each licensee is addressed as "you". "Licensees" and
+"recipients" may be individuals or organizations.
+
+ To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy. The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+ A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+ To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy. Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+ To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies. Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+ An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License. If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+ 1. Source Code.
+
+ The "source code" for a work means the preferred form of the work
+for making modifications to it. "Object code" means any non-source
+form of a work.
+
+ A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+ The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form. A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+ The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities. However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work. For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+ The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+ The Corresponding Source for a work in source code form is that
+same work.
+
+ 2. Basic Permissions.
+
+ All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met. This License explicitly affirms your unlimited
+permission to run the unmodified Program. The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work. This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+ You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force. You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright. Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+ Conveying under any other circumstances is permitted solely under
+the conditions stated below. Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+ No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+ When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+ 4. Conveying Verbatim Copies.
+
+ You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+ You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+ 5. Conveying Modified Source Versions.
+
+ You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+ a) The work must carry prominent notices stating that you modified
+ it, and giving a relevant date.
+
+ b) The work must carry prominent notices stating that it is
+ released under this License and any conditions added under section
+ 7. This requirement modifies the requirement in section 4 to
+ "keep intact all notices".
+
+ c) You must license the entire work, as a whole, under this
+ License to anyone who comes into possession of a copy. This
+ License will therefore apply, along with any applicable section 7
+ additional terms, to the whole of the work, and all its parts,
+ regardless of how they are packaged. This License gives no
+ permission to license the work in any other way, but it does not
+ invalidate such permission if you have separately received it.
+
+ d) If the work has interactive user interfaces, each must display
+ Appropriate Legal Notices; however, if the Program has interactive
+ interfaces that do not display Appropriate Legal Notices, your
+ work need not make them do so.
+
+ A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit. Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+ 6. Conveying Non-Source Forms.
+
+ You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+ a) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by the
+ Corresponding Source fixed on a durable physical medium
+ customarily used for software interchange.
+
+ b) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by a
+ written offer, valid for at least three years and valid for as
+ long as you offer spare parts or customer support for that product
+ model, to give anyone who possesses the object code either (1) a
+ copy of the Corresponding Source for all the software in the
+ product that is covered by this License, on a durable physical
+ medium customarily used for software interchange, for a price no
+ more than your reasonable cost of physically performing this
+ conveying of source, or (2) access to copy the
+ Corresponding Source from a network server at no charge.
+
+ c) Convey individual copies of the object code with a copy of the
+ written offer to provide the Corresponding Source. This
+ alternative is allowed only occasionally and noncommercially, and
+ only if you received the object code with such an offer, in accord
+ with subsection 6b.
+
+ d) Convey the object code by offering access from a designated
+ place (gratis or for a charge), and offer equivalent access to the
+ Corresponding Source in the same way through the same place at no
+ further charge. You need not require recipients to copy the
+ Corresponding Source along with the object code. If the place to
+ copy the object code is a network server, the Corresponding Source
+ may be on a different server (operated by you or a third party)
+ that supports equivalent copying facilities, provided you maintain
+ clear directions next to the object code saying where to find the
+ Corresponding Source. Regardless of what server hosts the
+ Corresponding Source, you remain obligated to ensure that it is
+ available for as long as needed to satisfy these requirements.
+
+ e) Convey the object code using peer-to-peer transmission, provided
+ you inform other peers where the object code and Corresponding
+ Source of the work are being offered to the general public at no
+ charge under subsection 6d.
+
+ A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+ A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling. In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage. For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product. A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+ "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source. The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+ If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information. But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+ The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed. Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+ Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+ 7. Additional Terms.
+
+ "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law. If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+ When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it. (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.) You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+ Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+ a) Disclaiming warranty or limiting liability differently from the
+ terms of sections 15 and 16 of this License; or
+
+ b) Requiring preservation of specified reasonable legal notices or
+ author attributions in that material or in the Appropriate Legal
+ Notices displayed by works containing it; or
+
+ c) Prohibiting misrepresentation of the origin of that material, or
+ requiring that modified versions of such material be marked in
+ reasonable ways as different from the original version; or
+
+ d) Limiting the use for publicity purposes of names of licensors or
+ authors of the material; or
+
+ e) Declining to grant rights under trademark law for use of some
+ trade names, trademarks, or service marks; or
+
+ f) Requiring indemnification of licensors and authors of that
+ material by anyone who conveys the material (or modified versions of
+ it) with contractual assumptions of liability to the recipient, for
+ any liability that these contractual assumptions directly impose on
+ those licensors and authors.
+
+ All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10. If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term. If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+ If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+ Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+ 8. Termination.
+
+ You may not propagate or modify a covered work except as expressly
+provided under this License. Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+ However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+ Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+ Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License. If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+ 9. Acceptance Not Required for Having Copies.
+
+ You are not required to accept this License in order to receive or
+run a copy of the Program. Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance. However,
+nothing other than this License grants you permission to propagate or
+modify any covered work. These actions infringe copyright if you do
+not accept this License. Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+ 10. Automatic Licensing of Downstream Recipients.
+
+ Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License. You are not responsible
+for enforcing compliance by third parties with this License.
+
+ An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations. If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+ You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License. For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+ 11. Patents.
+
+ A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based. The
+work thus licensed is called the contributor's "contributor version".
+
+ A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version. For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+ Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+ In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement). To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+ If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients. "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+ If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+ A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License. You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+ Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+ 12. No Surrender of Others' Freedom.
+
+ If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all. For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+ 13. Use with the GNU Affero General Public License.
+
+ Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU Affero General Public License into a single
+combined work, and to convey the resulting work. The terms of this
+License will continue to apply to the part which is the covered work,
+but the special requirements of the GNU Affero General Public License,
+section 13, concerning interaction through a network will apply to the
+combination as such.
+
+ 14. Revised Versions of this License.
+
+ The Free Software Foundation may publish revised and/or new versions of
+the GNU General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Program specifies that a certain numbered version of the GNU General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation. If the Program does not specify a version number of the
+GNU General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+ If the Program specifies that a proxy can decide which future
+versions of the GNU General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+ Later license versions may give you additional or different
+permissions. However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+ 15. Disclaimer of Warranty.
+
+ THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
+IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. Limitation of Liability.
+
+ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+ 17. Interpretation of Sections 15 and 16.
+
+ If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper mail.
+
+ If the program does terminal interaction, make it output a short
+notice like this when it starts in an interactive mode:
+
+ <program> Copyright (C) <year> <name of author>
+ This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, your program's commands
+might be different; for a GUI interface, you would use an "about box".
+
+ You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU GPL, see
+<https://www.gnu.org/licenses/>.
+
+ The GNU General Public License does not permit incorporating your program
+into proprietary programs. If your program is a subroutine library, you
+may consider it more useful to permit linking proprietary applications with
+the library. If this is what you want to do, use the GNU Lesser General
+Public License instead of this License. But first, please read
+<https://www.gnu.org/licenses/why-not-lgpl.html>.
diff --git a/README b/README
--- /dev/null
+++ b/README
@@ -0,0 +1,33 @@
+CPC
+---------
+
+A command line Component Pascal Compiler
+
+Building
+---------
+
+Requirements:
+* x86 CPU
+* GNU/Linux
+* GNU GCC
+* installed multilib
+
+1. Run make-stage0.sh to bootstrap using BlackBox Cross Platform
+(https://github.com/bbcb/bbcp) or run make-stage0c.sh to bootstrap from
+prebuilded C source code produced by CPfront
+2. Run make-stage1.sh
+3. Run make-stage2.sh
+4. Grab your binaries from stage2/i486
+
+Directory crux is a good example how of package for linux distro.
+
+Bugs
+_________
+
+Contact to me if you found some bugs. :)
+
+Licensing
+---------
+
+Any code and patches under GPLv3+ (see LICENSE file). Contact to me (DEADDOOMER) if you want
+to use some code in your BSD-licensed BlackBox/CPfront fork or project.
diff --git a/crux/cpc-32/.32bit b/crux/cpc-32/.32bit
diff --git a/crux/cpc-32/Pkgfile b/crux/cpc-32/Pkgfile
--- /dev/null
+++ b/crux/cpc-32/Pkgfile
@@ -0,0 +1,30 @@
+# Description: A command line Copmponent Pascal Compiler
+# URL: https://deadsoftware.ru
+# Maintainer: DeaDDooMER, deaddoomer@deadsoftware.ru
+
+name=cpc-32
+version=0.1
+release=1
+source=(https://deadsoftware.ru/projects/cpc/release/cpc-v${version}.src.tar.gz)
+
+build() {
+ cd bootstrap-src
+
+ ./make-stage0c.sh
+ ./make-stage1.sh
+ ./make-stage2.sh
+
+ install -d $PKG/usr/bin
+ install -D -m755 stage2/i486/{cpc486,cpl486,cpfront} $PKG/usr/bin/
+ ln -s cpc486 $PKG/usr/bin/cpc
+ ln -s cpl486 $PKG/usr/bin/cpl
+
+ install -d $PKG/usr/share/man/man1
+ install -D -m644 man/cp{c,l}.1 $PKG/usr/share/man/man1
+ ln -s cpc.1.gz $PKG/usr/share/man/man1/cpc486.1.gz
+ ln -s cpc.1.gz $PKG/usr/share/man/man1/cpfront.1.gz
+ ln -s cpl.1.gz $PKG/usr/share/man/man1/cpl486.1.gz
+
+ install -d $PKG/usr/share/cpfront/C
+ install -D -m644 C/SYSTEM.{c,h} $PKG/usr/share/cpfront/C
+}
diff --git a/make-bootstrap.sh b/make-bootstrap.sh
--- /dev/null
+++ b/make-bootstrap.sh
@@ -0,0 +1,190 @@
+#! /bin/sh
+
+set -e
+
+THIS="$(dirname "$(readlink -f "$0")")"
+OUT="$THIS/bootstrap/i486"
+
+cpc() {
+ "$THIS/stage2/i486/cpfront" -outcode CodeC -outsym SymC "$@"
+}
+
+importlist() {
+ echo
+ while [ "$1" != "" ]; do
+ echo -n "\t\t$1"
+ shift
+ if [ "$1" != "" ]; then
+ echo ","
+ fi
+ done
+}
+
+mainmodule() {
+local name="$1"
+shift
+cat <<!
+MODULE ${name};
+
+ IMPORT $(importlist "$@");
+
+END ${name}.
+!
+}
+
+linkall() {
+ local name="$1";
+ mainmodule "$@" > "$name.cp"
+ shift
+
+ cpc -main "$name.cp"
+
+ local list=""
+ for mod in "$@" "$name"; do
+ list="$list CodeC/$mod.c"
+ done
+}
+
+###^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^###
+### Prepare bbdsw sources for LINUX/i486 ###
+###______________________________________###
+
+rm -rf "$OUT"
+mkdir -p "$OUT"
+cp -r -- \
+ "$THIS/src/generic/"* \
+ "$THIS/src/posix/"* \
+ "$THIS/src/cpfront/posix/"* \
+ "$THIS/src/cpfront/linux/"* \
+ "$OUT"
+cd "$OUT"
+
+###^^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile POSIX bindings ###
+###________________________###
+
+cpc C99/Mod/types.cp \
+ C99/Mod/sys_types.cp \
+ C99/Mod/stdlib.cp C99/Mod/stdio.cp C99/Mod/unistd.cp \
+ C99/Mod/dirent.cp C99/Mod/locale.cp C99/Mod/time.cp \
+ C99/Mod/sys_stat.cp C99/Mod/fcntl.cp C99/Mod/errno.cp \
+ C99/Mod/iconv.cp C99/Mod/wctype.cp C99/Mod/sys_mman.cp \
+ C99/Mod/dlfcn.cp C99/Mod/signal.cp C99/Mod/setjmp.cp \
+ C99/Mod/libgen.cp \
+ C99/Mod/macro.cp
+
+###^^^^^^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile BlackBox Framework ###
+###____________________________###
+
+cpc System/Mod/Math.cp System/Mod/SMath.cp System/Mod/Kernel.cp \
+ System/Mod/Console.odc System/Mod/Files.odc System/Mod/Dates.odc \
+ System/Mod/Log.odc System/Mod/Strings.odc System/Mod/Services.odc \
+ System/Mod/Int.odc System/Mod/Integers.odc
+
+###^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile Linux Host subsystem ###
+###______________________________###
+
+cpc Host/Mod/Lang.cp Host/Mod/Dates.cp Host/Mod/Console.cp Host/Mod/Files.cp
+
+###^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile Dev subsystem ###
+###_______________________###
+
+cpc Dev/Mod/CPM.cp Dev/Mod/CPT.odc Dev/Mod/CPS.odc Dev/Mod/CPB.odc \
+ Dev/Mod/CPP.odc Dev/Mod/CPE.odc Dev/Mod/CPH.odc Dev/Mod/CPL486.odc \
+ Dev/Mod/CPC486.odc Dev/Mod/CPV486.odc
+
+###^^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile Dev2 subsystem ###
+###________________________###
+
+cpc Dev2/Mod/LnkBase.odc Dev2/Mod/LnkChmod.odc Dev2/Mod/LnkLoad.odc \
+ Dev2/Mod/LnkWriteElf.odc Dev2/Mod/LnkWriteElfStatic.odc \
+ Dev2/Mod/LnkWritePe.odc
+
+###^^^^^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile CPfront subsystem ###
+###___________________________###
+
+cpc CPfront/Mod/CPG.odc CPfront/Mod/CPC.odc CPfront/Mod/CPV.odc
+
+###^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile bbdsw-specific modules ###
+###________________________________###
+
+cpc Dsw/Mod/Documents.cp Dsw/Mod/Log.odc Dsw/Mod/Compiler486Main.cp \
+ Dsw/Mod/CompilerCPfrontMain.cp Dsw/Mod/Linker486Main.cp
+
+###^^^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile other utilities ###
+###_________________________###
+
+cpc Dsw/Mod/ListMain.cp Dsw/Mod/EchoMain.cp Dsw/Mod/LoopMain.cp
+
+###^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^###
+### Link Standalone Component Pascl Compiler & Dev2 Linker ###
+###________________________________________________________###
+
+linkall cpfront \
+ C99types C99macro \
+ Kernel Console Files Dates Math Strings Services Log \
+ HostLang HostConsole HostFiles HostDates DswLog \
+ DevCPM DevCPT DevCPS DevCPB DevCPP DevCPE DevCPH \
+ CPfrontCPG CPfrontCPC CPfrontCPV\
+ DswDocuments DswCompilerCPfrontMain
+
+linkall cpc486 \
+ C99types C99macro \
+ Kernel Console Files Dates Math Strings Services Log \
+ HostLang HostConsole HostFiles HostDates DswLog \
+ DevCPM DevCPT DevCPS DevCPB DevCPP DevCPE DevCPH \
+ DevCPL486 DevCPC486 DevCPV486 \
+ DswDocuments DswCompiler486Main
+
+linkall cpl486 \
+ C99types C99macro \
+ Kernel Console Files Math Strings Services Log \
+ HostLang HostConsole HostFiles DswLog \
+ Dev2LnkBase Dev2LnkChmod Dev2LnkLoad Dev2LnkWriteElf \
+ Dev2LnkWriteElfStatic Dev2LnkWritePe \
+ DswLinker486Main
+
+#linkall cplist \
+# C99types C99macro \
+# Kernel Console Files Math Strings Services Log \
+# HostLang HostConsole HostFiles DswLog \
+# DswListMain
+
+#linkall cpecho \
+# C99types C99macro \
+# Kernel Console Files Math Strings Services Log \
+# HostLang HostConsole HostFiles DswLog \
+# DswEchoMain
+
+#linkall cploop \
+# C99types C99macro \
+# Kernel Console Files Math Strings Services Log \
+# HostLang HostConsole HostFiles DswLog \
+# DswLoopMain
+
+rm -rf "$THIS/bootstrap-src"
+mkdir -p "$THIS/bootstrap-src"
+cp -r -t "$THIS/bootstrap-src" -- \
+ "$THIS/CHANGELOG" \
+ "$THIS/LICENSE" \
+ "$THIS/README" \
+ "$THIS/man" \
+ "$THIS/crux" \
+ "$THIS/make-bootstrap.sh" \
+ "$THIS/make-stage0.sh" \
+ "$THIS/make-stage0c.sh" \
+ "$THIS/make-stage1.sh" \
+ "$THIS/make-stage2.sh" \
+ "$THIS/src" \
+ "$THIS/C" \
+ CodeC
+
+cd "$THIS"
+tar czf cpc-v0.1.src.tar.gz bootstrap-src
diff --git a/make-stage0.sh b/make-stage0.sh
--- /dev/null
+++ b/make-stage0.sh
@@ -0,0 +1,113 @@
+#! /bin/sh
+
+set -e
+
+THIS="$(dirname "$(readlink -f "$0")")"
+OUT="$THIS/stage0/i486"
+
+###^^^^^^^^^^^^^^^^^^###
+### Check BBCP files ###
+###__________________###
+
+mkdir -p "$THIS/stage0"
+if ! [ -e "$THIS/stage0/bbcp" ]; then
+ echo "Please, clone bbcp repo:"
+ echo "-> git clone --depth=1 -b crux https://git.deadsoftware.ru/bbcp.git '$(realpath --relative-to="$PWD" "$THIS/stage0/bbcp")'"
+ echo "Than retry building using make-stage0.sh"
+ exit 1
+fi
+cd "$THIS/stage0/bbcp/BlackBox"
+
+###^^^^^^^^^^^^^^^^^^^###
+### Build BBCP itself ###
+###___________________###
+
+./switch-target Linux Interp
+./build
+
+###^^^^^^^^^^^^^^^^^^^^^^^^^^^^###
+### Copy minimal bbdsw sources ###
+###____________________________###
+
+rm -rf "$OUT"
+mkdir -p "$OUT"
+cp -r -- \
+ "$THIS/src/generic/"* \
+ "$THIS/src/posix/"* \
+ "$THIS/src/i486/generic/"* \
+ "$THIS/src/i486/posix/"* \
+ "$THIS/src/i486/linux/"* \
+ "$OUT"
+
+###^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile Stage0 Compiler & Linker ###
+###__________________________________###
+
+./blackbox <<!
+
+Kernel.LoadMod('DevCompiler')
+Kernel.LoadMod('ConsCompiler')
+Kernel.LoadMod('Dev2Linker1')
+Kernel.LoadMod('Dev2LnkChmod')
+
+HostFiles.SetRootDir('$OUT')
+
+ConsCompiler.Compile('C99/Mod', 'types.cp')
+ConsCompiler.Compile('C99/Mod', 'sys_types.cp')
+ConsCompiler.Compile('C99/Mod', 'stdlib.cp')
+ConsCompiler.Compile('C99/Mod', 'stdio.cp')
+ConsCompiler.Compile('C99/Mod', 'unistd.cp')
+ConsCompiler.Compile('C99/Mod', 'dirent.cp')
+ConsCompiler.Compile('C99/Mod', 'locale.cp')
+ConsCompiler.Compile('C99/Mod', 'time.cp')
+ConsCompiler.Compile('C99/Mod', 'sys_stat.cp')
+ConsCompiler.Compile('C99/Mod', 'fcntl.cp')
+ConsCompiler.Compile('C99/Mod', 'errno.cp')
+ConsCompiler.Compile('C99/Mod', 'iconv.cp')
+ConsCompiler.Compile('C99/Mod', 'wctype.cp')
+ConsCompiler.Compile('C99/Mod', 'sys_mman.cp')
+ConsCompiler.Compile('C99/Mod', 'dlfcn.cp')
+ConsCompiler.Compile('C99/Mod', 'signal.cp')
+ConsCompiler.Compile('C99/Mod', 'setjmp.cp')
+ConsCompiler.Compile('C99/Mod', 'libgen.cp')
+ConsCompiler.Compile('C99/Mod', 'macro.cp')
+
+ConsCompiler.Compile('System/Mod', 'Kernel.cp')
+DevCompiler.CompileThis Console Dates Files Int Long Math SMath Strings Log Services
+
+ConsCompiler.Compile('Host/Mod', 'Lang.cp')
+ConsCompiler.Compile('Host/Mod', 'Dates.cp')
+ConsCompiler.Compile('Host/Mod', 'Console.cp')
+ConsCompiler.Compile('Host/Mod', 'Files.cp')
+
+DevCompiler.CompileThis \
+ DswLog DswDebug \
+ Dev2LnkBase Dev2LnkChmod Dev2LnkLoad Dev2LnkWriteElf Dev2LnkWriteElfStatic Dev2LnkWritePe
+ConsCompiler.Compile('Dsw/Mod','Linker486Main.cp')
+Dev2Linker1.LinkElf Linux cpl486 := Kernel$+ \
+ C99types C99macro \
+ Kernel \
+ Console Files Math Strings Services Log Int Long \
+ HostLang HostConsole HostFiles DswLog DswDebug \
+ Dev2LnkBase Dev2LnkChmod Dev2LnkLoad Dev2LnkWriteElf \
+ Dev2LnkWriteElfStatic Dev2LnkWritePe \
+ DswLinker486Main
+
+ConsCompiler.Compile('Dev/Mod','CPM.cp')
+DevCompiler.CompileThis DevCPT DevCPS DevCPB DevCPP DevCPE DevCPH DevCPL486 DevCPC486 DevCPV486
+ConsCompiler.Compile('Dsw/Mod','Documents.cp')
+ConsCompiler.Compile('Dsw/Mod','Compiler486Main.cp')
+Dev2Linker1.LinkElf Linux cpc486 := Kernel$+ \
+ C99types C99macro \
+ Kernel \
+ Console Files Math Strings Services Log Int Long \
+ HostLang HostConsole HostFiles HostDates DswLog DswDebug \
+ DevCPM DevCPT DevCPS DevCPB DevCPP DevCPE DevCPH DevCPL486 DevCPC486 DevCPV486 \
+ DswDocuments DswCompiler486Main
+
+Kernel.Quit(0)
+
+!
+
+cd "$OUT"
+chmod a+x cpc486 cpl486
diff --git a/make-stage0c.sh b/make-stage0c.sh
--- /dev/null
+++ b/make-stage0c.sh
@@ -0,0 +1,70 @@
+#! /bin/sh
+
+set -e
+
+THIS="$(dirname "$(readlink -f "$0")")"
+OUT="$THIS/stage0/i486"
+
+linkall() {
+ local name="$1";
+ shift
+
+ local list=""
+ for mod in "$@" "$name"; do
+ list="$list $THIS/CodeC/$mod.c"
+ done
+
+ gcc -m32 -g -O0 -lm -ldl -o "$OUT/$name" \
+ -Wno-int-conversion \
+ -Wno-int-to-pointer-cast \
+ -Wno-incompatible-pointer-types \
+ -Wno-implicit-function-declaration \
+ -I "$THIS/C" "$THIS/C/SYSTEM.c" $list
+}
+
+rm -rf "$OUT"
+mkdir -p "$OUT"
+
+linkall cpc486 \
+ C99types C99macro \
+ Kernel Console Files Dates Math Strings Services Log \
+ HostLang HostConsole HostFiles HostDates DswLog \
+ DevCPM DevCPT DevCPS DevCPB DevCPP DevCPE DevCPH \
+ DevCPL486 DevCPC486 DevCPV486 \
+ DswDocuments DswCompiler486Main
+
+linkall cpfront \
+ C99types C99macro \
+ Kernel Console Files Dates Math Strings Services Log \
+ HostLang HostConsole HostFiles HostDates DswLog \
+ DevCPM DevCPT DevCPS DevCPB DevCPP DevCPE DevCPH \
+ CPfrontCPG CPfrontCPC CPfrontCPV\
+ DswDocuments DswCompilerCPfrontMain
+
+linkall cpl486 \
+ C99types C99macro \
+ Kernel Console Files Math Strings Services Log \
+ HostLang HostConsole HostFiles DswLog \
+ Dev2LnkBase Dev2LnkChmod Dev2LnkLoad Dev2LnkWriteElf \
+ Dev2LnkWriteElfStatic Dev2LnkWritePe \
+ DswLinker486Main
+
+#linkall cplist \
+# C99types C99macro \
+# Kernel Console Files Math Strings Services Log \
+# HostLang HostConsole HostFiles DswLog \
+# DswListMain
+
+#linkall cpecho \
+# C99types C99macro \
+# Kernel Console Files Math Strings Services Log \
+# HostLang HostConsole HostFiles DswLog \
+# DswEchoMain
+
+#linkall cploop \
+# C99types C99macro \
+# Kernel Console Files Math Strings Services Log \
+# HostLang HostConsole HostFiles DswLog \
+# DswLoopMain
+
+chmod a+x "$OUT/cpfront" "$OUT/cpc486" "$OUT/cpl486"
diff --git a/make-stage1.sh b/make-stage1.sh
--- /dev/null
+++ b/make-stage1.sh
@@ -0,0 +1,123 @@
+#! /bin/sh
+
+set -e
+
+THIS="$(dirname "$(readlink -f "$0")")"
+OUT="$THIS/stage1/i486"
+
+cpc() {
+ "$THIS/stage0/i486/cpc486" -legacy "$@"
+}
+
+cpl() {
+ "$THIS/stage0/i486/cpl486" "$@"
+}
+
+###^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^###
+### Prepare bbdsw sources for LINUX/i486 ###
+###______________________________________###
+
+rm -rf "$OUT"
+mkdir -p "$OUT"
+cp -r -- \
+ "$THIS/src/generic/"* \
+ "$THIS/src/posix/"* \
+ "$THIS/src/i486/generic/"* \
+ "$THIS/src/i486/posix/"* \
+ "$THIS/src/i486/linux/"* \
+ "$OUT"
+cd "$OUT"
+
+###^^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile POSIX bindings ###
+###________________________###
+
+cpc C99/Mod/types.cp \
+ C99/Mod/sys_types.cp \
+ C99/Mod/stdlib.cp C99/Mod/stdio.cp C99/Mod/unistd.cp \
+ C99/Mod/dirent.cp C99/Mod/locale.cp C99/Mod/time.cp \
+ C99/Mod/sys_stat.cp C99/Mod/fcntl.cp C99/Mod/errno.cp \
+ C99/Mod/iconv.cp C99/Mod/wctype.cp C99/Mod/sys_mman.cp \
+ C99/Mod/dlfcn.cp C99/Mod/signal.cp C99/Mod/setjmp.cp \
+ C99/Mod/libgen.cp \
+ C99/Mod/macro.cp
+
+###^^^^^^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile BlackBox Framework ###
+###____________________________###
+
+
+cpc System/Mod/Int.odc System/Mod/Long.odc \
+ System/Mod/Math.odc System/Mod/SMath.odc System/Mod/Kernel.cp \
+ System/Mod/Console.odc System/Mod/Files.odc System/Mod/Dates.odc \
+ System/Mod/Log.odc System/Mod/Strings.odc System/Mod/Services.odc \
+ System/Mod/Integers.odc
+mv Code Sym System
+
+###^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile Linux Host subsystem ###
+###______________________________###
+
+cpc Host/Mod/Lang.cp Host/Mod/Dates.cp Host/Mod/Console.cp Host/Mod/Files.cp
+
+###^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile Dev subsystem ###
+###_______________________###
+
+cpc Dev/Mod/CPM.cp Dev/Mod/CPT.odc Dev/Mod/CPS.odc Dev/Mod/CPB.odc \
+ Dev/Mod/CPP.odc Dev/Mod/CPE.odc Dev/Mod/CPH.odc Dev/Mod/CPL486.odc \
+ Dev/Mod/CPC486.odc Dev/Mod/CPV486.odc
+
+###^^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile Dev2 subsystem ###
+###________________________###
+
+cpc Dev2/Mod/LnkBase.odc Dev2/Mod/LnkChmod.odc Dev2/Mod/LnkLoad.odc \
+ Dev2/Mod/LnkWriteElf.odc Dev2/Mod/LnkWriteElfStatic.odc \
+ Dev2/Mod/LnkWritePe.odc
+
+###^^^^^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile CPfront subsystem ###
+###___________________________###
+
+cpc CPfront/Mod/CPG.odc CPfront/Mod/CPC.odc CPfront/Mod/CPV.odc
+
+###^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile bbdsw-specific modules ###
+###________________________________###
+
+cpc Dsw/Mod/Documents.cp Dsw/Mod/Log.odc Dsw/Mod/Debug.odc Dsw/Mod/Compiler486Main.cp \
+ Dsw/Mod/CompilerCPfrontMain.cp Dsw/Mod/Linker486Main.cp
+
+###^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^###
+### Link Standalone Component Pascl Compiler & Dev2 Linker ###
+###________________________________________________________###
+
+cpl -os linux -kernel Kernel -main Kernel -legacycodedir . -o cpc486 \
+ Long \
+ C99types C99macro \
+ Kernel Console Files Dates Math Strings Services Log \
+ HostLang HostConsole HostFiles HostDates DswLog DswDebug \
+ DevCPM DevCPT DevCPS DevCPB DevCPP DevCPE DevCPH \
+ DevCPL486 DevCPC486 DevCPV486 \
+ DswDocuments DswCompiler486Main
+
+cpl -os linux -kernel Kernel -main Kernel -legacycodedir . -o cpfront \
+ Long \
+ C99types C99macro \
+ Kernel Console Files Dates Math Strings Services Log \
+ HostLang HostConsole HostFiles HostDates DswLog DswDebug \
+ DevCPM DevCPT DevCPS DevCPB DevCPP DevCPE DevCPH \
+ CPfrontCPG CPfrontCPC CPfrontCPV\
+ DswDocuments DswCompilerCPfrontMain
+
+cpl -os linux -kernel Kernel -main Kernel -legacycodedir . -o cpl486 \
+ Long \
+ C99types C99macro \
+ Kernel Console Files Math Strings Services Log \
+ HostLang HostConsole HostFiles DswLog DswDebug \
+ Dev2LnkBase Dev2LnkChmod Dev2LnkLoad Dev2LnkWriteElf \
+ Dev2LnkWriteElfStatic Dev2LnkWritePe \
+ DswLinker486Main
+
+#chmod a+x "$OUT/cpfront" "$OUT/cpc486" "$OUT/cpl486"
diff --git a/make-stage2.sh b/make-stage2.sh
--- /dev/null
+++ b/make-stage2.sh
@@ -0,0 +1,123 @@
+#! /bin/sh
+
+set -e
+
+THIS="$(dirname "$(readlink -f "$0")")"
+OUT="$THIS/stage2/i486"
+
+cpc() {
+ "$THIS/stage1/i486/cpc486" -legacy "$@"
+}
+
+cpl() {
+ "$THIS/stage1/i486/cpl486" "$@"
+}
+
+###^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^###
+### Prepare bbdsw sources for LINUX/i486 ###
+###______________________________________###
+
+rm -rf "$OUT"
+mkdir -p "$OUT"
+cp -r -- \
+ "$THIS/src/generic/"* \
+ "$THIS/src/posix/"* \
+ "$THIS/src/i486/generic/"* \
+ "$THIS/src/i486/posix/"* \
+ "$THIS/src/i486/linux/"* \
+ "$OUT"
+cd "$OUT"
+
+###^^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile POSIX bindings ###
+###________________________###
+
+cpc C99/Mod/types.cp \
+ C99/Mod/sys_types.cp \
+ C99/Mod/stdlib.cp C99/Mod/stdio.cp C99/Mod/unistd.cp \
+ C99/Mod/dirent.cp C99/Mod/locale.cp C99/Mod/time.cp \
+ C99/Mod/sys_stat.cp C99/Mod/fcntl.cp C99/Mod/errno.cp \
+ C99/Mod/iconv.cp C99/Mod/wctype.cp C99/Mod/sys_mman.cp \
+ C99/Mod/dlfcn.cp C99/Mod/signal.cp C99/Mod/setjmp.cp \
+ C99/Mod/libgen.cp \
+ C99/Mod/macro.cp
+
+###^^^^^^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile BlackBox Framework ###
+###____________________________###
+
+
+cpc System/Mod/Int.odc System/Mod/Long.odc \
+ System/Mod/Math.odc System/Mod/SMath.odc System/Mod/Kernel.cp \
+ System/Mod/Console.odc System/Mod/Files.odc System/Mod/Dates.odc \
+ System/Mod/Log.odc System/Mod/Strings.odc System/Mod/Services.odc \
+ System/Mod/Integers.odc
+mv Code Sym System
+
+###^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile Linux Host subsystem ###
+###______________________________###
+
+cpc Host/Mod/Lang.cp Host/Mod/Dates.cp Host/Mod/Console.cp Host/Mod/Files.cp
+
+###^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile Dev subsystem ###
+###_______________________###
+
+cpc Dev/Mod/CPM.cp Dev/Mod/CPT.odc Dev/Mod/CPS.odc Dev/Mod/CPB.odc \
+ Dev/Mod/CPP.odc Dev/Mod/CPE.odc Dev/Mod/CPH.odc Dev/Mod/CPL486.odc \
+ Dev/Mod/CPC486.odc Dev/Mod/CPV486.odc
+
+###^^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile Dev2 subsystem ###
+###________________________###
+
+cpc Dev2/Mod/LnkBase.odc Dev2/Mod/LnkChmod.odc Dev2/Mod/LnkLoad.odc \
+ Dev2/Mod/LnkWriteElf.odc Dev2/Mod/LnkWriteElfStatic.odc \
+ Dev2/Mod/LnkWritePe.odc
+
+###^^^^^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile CPfront subsystem ###
+###___________________________###
+
+cpc CPfront/Mod/CPG.odc CPfront/Mod/CPC.odc CPfront/Mod/CPV.odc
+
+###^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^###
+### Compile bbdsw-specific modules ###
+###________________________________###
+
+cpc Dsw/Mod/Documents.cp Dsw/Mod/Log.odc Dsw/Mod/Debug.odc Dsw/Mod/Compiler486Main.cp \
+ Dsw/Mod/CompilerCPfrontMain.cp Dsw/Mod/Linker486Main.cp
+
+###^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^###
+### Link Standalone Component Pascl Compiler & Dev2 Linker ###
+###________________________________________________________###
+
+cpl -os linux -kernel Kernel -main Kernel -legacycodedir . -o cpc486 \
+ Long \
+ C99types C99macro \
+ Kernel Console Files Dates Math Strings Services Log \
+ HostLang HostConsole HostFiles HostDates DswLog DswDebug \
+ DevCPM DevCPT DevCPS DevCPB DevCPP DevCPE DevCPH \
+ DevCPL486 DevCPC486 DevCPV486 \
+ DswDocuments DswCompiler486Main
+
+cpl -os linux -kernel Kernel -main Kernel -legacycodedir . -o cpfront \
+ Long \
+ C99types C99macro \
+ Kernel Console Files Dates Math Strings Services Log \
+ HostLang HostConsole HostFiles HostDates DswLog DswDebug \
+ DevCPM DevCPT DevCPS DevCPB DevCPP DevCPE DevCPH \
+ CPfrontCPG CPfrontCPC CPfrontCPV\
+ DswDocuments DswCompilerCPfrontMain
+
+cpl -os linux -kernel Kernel -main Kernel -legacycodedir . -o cpl486 \
+ Long \
+ C99types C99macro \
+ Kernel Console Files Math Strings Services Log \
+ HostLang HostConsole HostFiles DswLog DswDebug \
+ Dev2LnkBase Dev2LnkChmod Dev2LnkLoad Dev2LnkWriteElf \
+ Dev2LnkWriteElfStatic Dev2LnkWritePe \
+ DswLinker486Main
+
+#chmod a+x "$OUT/cpfront" "$OUT/cpc486" "$OUT/cpl486"
diff --git a/man/cpc.1 b/man/cpc.1
--- /dev/null
+++ b/man/cpc.1
@@ -0,0 +1,76 @@
+.Dd June 7, 2019
+.Dt CPC 1
+.Os \" Current OS
+.Sh NAME
+.Nm cpc
+.Nd Component Pascal Compiler
+.Sh SYNOPSIS
+.Nm
+.Op Ar options
+.Op Ar sourcefiles
+.Sh DESCRIPTION
+.Nm
+compiles modules and produce code files and symbols.
+.Pp
+Its arguments are as follows:
+.Bl -tag -width Ds
+.It Fl legacy
+Enable legacy mode, i.e. code files and symbol files are created in
+BlackBox-like subsystems.
+.It Fl outsym Ar dir
+Specify output directory for symbol files or subsystems in legacy mode. Default
+is current directory.
+.It Fl outcode Ar dir
+Specify output directory for code files or subsystems in legacy mode. Default
+is current directory.
+.It Fl symdir Ar dir
+Add search path for symbol files. Current output directory always have highter
+priority.
+.It Fl legacysymdir Ar dir
+Add search path for subsystems with symbol files. Current output directory
+always have highter priority.
+.It Fl includedir Ar dir
+Specify directory with additional .h0 and .c0 files. Used by option -include0.
+.It Fl [no-]allchecks
+Switch on/off additional runtime range checks. This generates slightly larger
+code files and increases the runtime. In most situations the difference is
+small.
+.It Fl [no-]srcpos
+Switch on/off emitting the source code position. This generates slightly more
+compact code files but removes the link to the terminated procedure's source
+code position in the trap viewer.
+.It Fl [no-]structref
+Switch on/off emitting symbolic information for structured global variables.
+.It Fl [no-]ref
+Switch on/off emitting symbolic information for all global variables.
+.It Fl [no-]obj
+Switch on/off code file generation.
+.It Fl [no-]assert
+Switch on/off runtime checking of ASSERT statements. Use this option only for
+very time critical code.
+.It Fl [no-]checks
+Switch on/off array index checks and pointer initialization. Use this option at
+your own risk.
+.It Fl [no-]hints
+Switch on/off emitting of (COM related) warnings or hints even if there are no
+errors.
+.It Fl [no-]trap
+Switch on/off trapping on first error. Useful for debugging compiler itself.
+.It Fl [no-]oberon
+Switch on/off syntax extensions for compatibility with Oberon.
+.It Fl [no-]com-aware
+Switch on/off Direct-To-COM compiler extesions.
+.It Fl [no-]main
+Switch on/off main program generation. Useful for CPfront backend.
+.In Fl [no-]include0
+Switch on/off including additional header to module. Useful for CPfront backend.
+.In Fl [no-]long-calls
+Switch on/off use calls from module Long, that emulate LONGINT.
+.It Fl v[erbose]
+Print more information to stdout.
+.El \" End Options List
+.Sh EXIT STATUS
+.Ex -std
+.Sh SEE ALSO
+.Xr cpl 1
+.El
diff --git a/man/cpl.1 b/man/cpl.1
--- /dev/null
+++ b/man/cpl.1
@@ -0,0 +1,54 @@
+.Dd June 7, 2019
+.Dt CPL 1
+.Os \" Current OS
+.Sh NAME
+.Nm cpl
+.Nd Component Pascal Linker
+.Sh SYNOPSIS
+.Nm
+.Op Ar options
+.Op Fl main Ar module
+.Op Fl os Ar sys
+.Op Fl o Ar out
+.Op Cm modules
+.Sh DESCRIPTION
+.Nm
+combines modules and make executable files.
+.Pp
+Modules initialized in user specified order.
+.Pp
+Its arguments are as follows:
+.Bl -tag -width Ds
+.It Fl os Ar sys
+Make excutable file for one of following systems: linux, freebsd, openbsd,
+win32.
+.It Fl interp Ar path
+Specify ELF interpreter.
+(Default are system dependent)
+.It Fl o Ar out
+Specify output program name.
+.It Fl static
+Do not link shared libraries.
+.It Fl dll
+Link as shared object.
+.It Fl sinit
+Use static initialization scheme. By default initialization order managed by
+Kernel, but with this option modules initialized directly without using Kernel.
+.It Fl m Ar module , Fl main Ar module
+Use specified module body as program entry point. In most cases it is Kernel.
+.It Fl k Ar module , Fl kernel Ar module
+Use specified module body as runtime kernel. This module must contain
+procedures NewRec and NewArr that used for dynamic memory allocation.
+By default used module Kernel.
+.It Fl codedir Ar path
+Add search path for code files.
+.It Fl legacycodedir Ar path
+Add search path for subsystems with code files.
+.It Fl trap
+Trap on first error. Useful for debugging linker itself.
+.El \" End Options List
+.Sh EXIT STATUS
+.Ex -std
+.Sh SEE ALSO
+.Xr cpc 1
+.El
diff --git a/src/cpfront/linux/C99/Mod/dirent.cp b/src/cpfront/linux/C99/Mod/dirent.cp
--- /dev/null
@@ -0,0 +1,64 @@
+MODULE C99dirent ['dirent.h'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types, C99sys_types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ TYPE
+ PDIR* = POINTER TO DIR;
+ DIR ['DIR'] = LIMITED RECORD [untagged] END;
+
+ TYPE
+ Pstruct_dirent* = POINTER TO struct_dirent;
+ struct_dirent* ['struct dirent'] = RECORD [noalign] (* 268 *)
+ d_ino*: ino_t; (* 0+4 *)
+ d_name*: ARRAY [untagged] 256 OF SHORTCHAR; (* 11+256 *)
+ END;
+
+ TYPE
+ ino_t* = C99sys_types.ino_t;
+
+ PROCEDURE [ccall] alphasort* (IN a, b: Pstruct_dirent): int;
+ PROCEDURE [ccall] closedir* (dirp: PDIR): int;
+ PROCEDURE [ccall] dirfd* (dirp: PDIR): int;
+ PROCEDURE [ccall] fdopendir* (fd: int): PDIR;
+ PROCEDURE [ccall] opendir* (IN name: ARRAY [untagged] OF SHORTCHAR): PDIR;
+ PROCEDURE [ccall] readdir* (dirp: PDIR): Pstruct_dirent;
+ PROCEDURE [ccall] readdir_r* (dirp: PDIR; entry: Pstruct_dirent; VAR result: Pstruct_dirent): int;
+ PROCEDURE [ccall] rewinddir* (dirp: PDIR);
+ PROCEDURE [ccall] scandir* (IN dirp: ARRAY [untagged] OF SHORTCHAR; filter: PROCEDURE [ccall] (IN d: struct_dirent): int; compar: PROCEDURE [ccall] (IN a, b: Pstruct_dirent): int): int;
+ PROCEDURE [ccall] seekdir* (dirp: PDIR; loc: long);
+ PROCEDURE [ccall] telldir* (dirp: PDIR): long;
+
+END C99dirent.
diff --git a/src/cpfront/linux/C99/Mod/dlfcn.cp b/src/cpfront/linux/C99/Mod/dlfcn.cp
--- /dev/null
@@ -0,0 +1,49 @@
+MODULE C99dlfcn ['dlfcn.h'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ CONST
+ RTLD_LAZY* = 1;
+ RTLD_NOW* = 2;
+ RTLD_GLOBAL* = 256;
+ RTLD_LOCAL* = 0;
+
+ PROCEDURE [ccall] dlclose* (handle: C99types.Pvoid): int;
+ PROCEDURE [ccall] dlerror* (): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] dlopen* (IN [nil] filename: ARRAY [untagged] OF SHORTCHAR; flags: int): C99types.Pvoid;
+ PROCEDURE [ccall] dlsym* (handle: C99types.Pvoid; IN symbol: ARRAY [untagged] OF SHORTCHAR): C99types.Pvoid;
+
+END C99dlfcn.
diff --git a/src/cpfront/linux/C99/Mod/errno.cp b/src/cpfront/linux/C99/Mod/errno.cp
--- /dev/null
@@ -0,0 +1,123 @@
+MODULE C99errno ['errno.h'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ CONST
+ E2BIG* = 7;
+ EACCES* = 13;
+ EADDRINUSE* = 98;
+ EADDRNOTAVAIL* = 99;
+ EAFNOSUPPORT* = 97;
+ EAGAIN* = 11;
+ EALREADY* = 114;
+ EBADF* = 9;
+ EBADMSG* = 74;
+ EBUSY* = 16;
+ ECANCELED* = 125;
+ ECHILD* = 10;
+ ECONNABORTED* = 103;
+ ECONNREFUSED* = 111;
+ ECONNRESET* = 104;
+ EDEADLK* = 35;
+ EDESTADDRREQ* = 89;
+ EDOM* = 33;
+ EDQUOT* = 122;
+ EEXIST* = 17;
+ EFAULT* = 14;
+ EFBIG* = 27;
+ EHOSTUNREACH* = 113;
+ EIDRM* = 43;
+ EILSEQ* = 84;
+ EINPROGRESS* = 115;
+ EINTR* = 4;
+ EINVAL* = 22;
+ EIO* = 5;
+ EISCONN* = 106;
+ EISDIR* = 21;
+ ELOOP* = 40;
+ EMFILE* = 24;
+ EMLINK* = 31;
+ EMSGSIZE* = 90;
+ EMULTIHOP* = 72;
+ ENAMETOOLONG* = 36;
+ ENETDOWN* = 100;
+ ENETRESET* = 102;
+ ENETUNREACH* = 101;
+ ENFILE* = 23;
+ ENOBUFS* = 105;
+ ENODATA* = 61;
+ ENODEV* = 19;
+ ENOENT* = 2;
+ ENOEXEC* = 8;
+ ENOLCK* = 37;
+ ENOLINK* = 67;
+ ENOMEM* = 12;
+ ENOMSG* = 42;
+ ENOPROTOOPT* = 92;
+ ENOSPC* = 28;
+ ENOSR* = 63;
+ ENOSTR* = 60;
+ ENOSYS* = 38;
+ ENOTCONN* = 107;
+ ENOTDIR* = 20;
+ ENOTEMPTY* = 39;
+ ENOTRECOVERABLE* = 131;
+ ENOTSOCK* = 88;
+ ENOTSUP* = 95;
+ ENOTTY* = 25;
+ ENXIO* = 6;
+ EOPNOTSUPP* = 95;
+ EOVERFLOW* = 75;
+ EOWNERDEAD* = 130;
+ EPERM* = 1;
+ EPIPE* = 32;
+ EPROTO* = 71;
+ EPROTONOSUPPORT* = 93;
+ EPROTOTYPE* = 91;
+ ERANGE* = 34;
+ EROFS* = 30;
+ ESPIPE* = 29;
+ ESRCH* = 3;
+ ESTALE* = 116;
+ ETIME* = 62;
+ ETIMEDOUT* = 110;
+ ETXTBSY* = 26;
+ EWOULDBLOCK* = 11;
+ EXDEV* = 18;
+
+ PROCEDURE [ccall] __errno_location* (): POINTER TO ARRAY [untagged] 1 OF int;
+
+END C99errno.
diff --git a/src/cpfront/linux/C99/Mod/fcntl.cp b/src/cpfront/linux/C99/Mod/fcntl.cp
--- /dev/null
@@ -0,0 +1,119 @@
+MODULE C99fcntl ['fcntl.h'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types, C99sys_types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ CONST
+ F_DUPFD* = 0;
+ F_DUPFD_CLOEXEC* = 1030;
+ F_GETFD* = 1;
+ F_SETFD* = 2;
+ F_GETFL* = 3;
+ F_SETFL* = 4;
+ F_GETLK* = 5;
+ F_SETLK* = 6;
+ F_SETLKW* = 7;
+ F_GETOWN* = 9;
+ F_SETOWN* = 8;
+
+ CONST
+ FD_CLOEXEC* = 1;
+
+ CONST
+ F_RDLCK* = 0;
+ F_UNLCK* = 2;
+ F_WRLCK* = 1;
+
+ CONST
+ SEEK_SET* = 0;
+ SEEK_CUR* = 1;
+ SEEK_END* = 2;
+
+ CONST
+ O_CLOEXEC* = 524288;
+ O_CREAT* = 64;
+ O_DIRECTORY* = 65536;
+ O_EXCL* = 128;
+ O_NOCTTY* = 256;
+ O_NOFOLLOW* = 131072;
+ O_TRUNC* = 512;
+ O_APPEND* = 1024;
+ O_DSYNC* = 4096;
+ O_NONBLOCK* = 2048;
+ O_RSYNC* = 1052672;
+ O_SYNC* = 1052672;
+ O_ACCMODE* = 3;
+ O_RDONLY* = 0;
+ O_RDWR* = 2;
+ O_WRONLY* = 1;
+
+ CONST
+ AT_FDCWD* = -100;
+ AT_EACCESS* = 512;
+ AT_SYMLINK_NOFOLLOW* = 256;
+ AT_SYMLINK_FOLLOW* = 1024;
+ AT_REMOVEDIR* = 512;
+
+ CONST
+ POSIX_FADV_DONTNEED* = 4;
+ POSIX_FADV_NOREUSE* = 5;
+ POSIX_FADV_NORMAL* = 0;
+ POSIX_FADV_RANDOM* = 1;
+ POSIX_FADV_SEQUENTIAL* = 2;
+ POSIX_FADV_WILLNEED* = 3;
+
+ TYPE
+ Pstruct_flock* = POINTER TO struct_flock;
+ struct_flock* ['struct flock'] = RECORD [noalign] (* 16 *)
+ l_type*: short; (* 0+2 *)
+ l_whence*: short; (* 2+2 *)
+ l_start*: off_t; (* 4+4 *)
+ l_len*: off_t; (* 8+4 *)
+ l_pid*: pid_t; (* 12+4 *)
+ END;
+
+ TYPE
+ mode_t* = C99sys_types.mode_t;
+ off_t* = C99sys_types.off_t;
+ pid_t* = C99sys_types.pid_t;
+
+ PROCEDURE [ccall] creat* (IN pathname: ARRAY [untagged] OF SHORTCHAR; mode: mode_t): int;
+ PROCEDURE [ccall] fcntl* (fildes, cmd, arg: int): int;
+ PROCEDURE [ccall] open* (IN pathname: ARRAY [untagged] OF SHORTCHAR; flags: int; mode: mode_t): int;
+ PROCEDURE [ccall] openat* (fddir: int; IN pathname: ARRAY [untagged] OF SHORTCHAR; flags: int; mode: mode_t): int;
+ PROCEDURE [ccall] posix_fadvise* (fd: int; offset, len: off_t; advice: int): int;
+ PROCEDURE [ccall] posix_fallocate* (fd: int; offset, len: off_t): int;
+
+END C99fcntl.
diff --git a/src/cpfront/linux/C99/Mod/iconv.cp b/src/cpfront/linux/C99/Mod/iconv.cp
--- /dev/null
@@ -0,0 +1,48 @@
+MODULE C99iconv ['iconv.h'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types, C99sys_types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ TYPE
+ iconv_t* = INTEGER;
+
+ TYPE
+ size_t* = C99sys_types.size_t;
+
+ PROCEDURE [ccall] iconv* (cd: iconv_t; VAR [nil] inbuf: C99types.Pvoid; VAR inbytesleft: size_t; VAR [nil] outbuf: C99types.Pvoid; VAR outbytesleft: size_t): size_t;
+ PROCEDURE [ccall] iconv_open* (IN tocode, fromcode: ARRAY [untagged] OF SHORTCHAR): iconv_t;
+ PROCEDURE [ccall] iconv_close* (cd: iconv_t): int;
+
+END C99iconv.
diff --git a/src/cpfront/linux/C99/Mod/libgen.cp b/src/cpfront/linux/C99/Mod/libgen.cp
--- /dev/null
@@ -0,0 +1,41 @@
+MODULE C99libgen ['libgen.h'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ PROCEDURE [ccall] basename* (path: POINTER TO ARRAY [untagged] OF SHORTCHAR): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] dirname* (path: POINTER TO ARRAY [untagged] OF SHORTCHAR): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+
+END C99libgen.
diff --git a/src/cpfront/linux/C99/Mod/locale.cp b/src/cpfront/linux/C99/Mod/locale.cp
--- /dev/null
@@ -0,0 +1,75 @@
+MODULE C99locale ['locale.h'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ TYPE
+ Pstruct_lconv* = POINTER TO struct_lconv;
+ struct_lconv ['struct lconv'] = LIMITED RECORD [untagged] END;
+
+ CONST
+ LC_ALL* = 6;
+ LC_COLLATE* = 3;
+ LC_CTYPE* = 0;
+ LC_MESSAGES* = 5;
+ LC_MONETARY* = 4;
+ LC_NUMERIC* = 1;
+ LC_TIME* = 2;
+
+ CONST
+ LC_COLLATE_MASK* = 8;
+ LC_CTYPE_MASK* = 1;
+ LC_MESSAGES_MASK* = 32;
+ LC_MONETARY_MASK* = 16;
+ LC_NUMERIC_MASK* = 2;
+ LC_TIME_MASK* = 4;
+
+ CONST
+ LC_ALL_MASK* = 8127;
+
+ CONST
+ LC_GLOBAL_LOCALE* = -1;
+
+ TYPE
+ locale_t* = INTEGER;
+
+ PROCEDURE [ccall] duplocale* (locobj: locale_t): locale_t;
+ PROCEDURE [ccall] freelocale* (locobj: locale_t);
+ PROCEDURE [ccall] localeconv* (): Pstruct_lconv;
+ PROCEDURE [ccall] newlocale* (category_mask: int; IN locale: ARRAY [untagged] OF SHORTCHAR; base: locale_t): locale_t;
+ PROCEDURE [ccall] setlocale* (category: int; IN [nil] locale: ARRAY [untagged] OF SHORTCHAR): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] uselocale* (newloc: locale_t): locale_t;
+
+END C99locale.
diff --git a/src/cpfront/linux/C99/Mod/macro.cp b/src/cpfront/linux/C99/Mod/macro.cp
--- /dev/null
@@ -0,0 +1,15 @@
+MODULE C99macro;
+
+ IMPORT SYSTEM, C99errno, C99sys_stat;
+
+ PROCEDURE errno* (): C99errno.int;
+ BEGIN
+ RETURN C99errno.__errno_location()[0]
+ END errno;
+
+ PROCEDURE stat* (IN path: ARRAY [untagged] OF SHORTCHAR; VAR buf: C99sys_stat.struct_stat): C99sys_stat.int;
+ BEGIN
+ RETURN C99sys_stat.stat(path, buf)
+ END stat;
+
+END C99macro.
diff --git a/src/cpfront/linux/C99/Mod/setjmp.cp b/src/cpfront/linux/C99/Mod/setjmp.cp
--- /dev/null
@@ -0,0 +1,49 @@
+MODULE C99setjmp ['setjmp.h'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ TYPE
+ jmp_buf* = ARRAY [untagged] 156 OF BYTE;
+ sigjmp_buf* = ARRAY [untagged] 156 OF BYTE;
+
+ PROCEDURE [ccall] _longjmp* (IN env: jmp_buf; val: int);
+ PROCEDURE [ccall] longjmp* (IN env: jmp_buf; val: int);
+ PROCEDURE [ccall] siglongjmp* (IN env: sigjmp_buf; val: int);
+ PROCEDURE [ccall] _setjmp* (VAR env: jmp_buf): int;
+ PROCEDURE [ccall] setjmp* (VAR env: jmp_buf): int;
+ PROCEDURE [ccall] sigsetjmp* (VAR env: sigjmp_buf; savesigs: int): int;
+
+END C99setjmp.
diff --git a/src/cpfront/linux/C99/Mod/signal.cp b/src/cpfront/linux/C99/Mod/signal.cp
--- /dev/null
@@ -0,0 +1,297 @@
+MODULE C99signal ['signal.h'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types, C99sys_types, C99time;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ CONST
+ SIG_DFL* = 0;
+ SIG_ERR* = -1;
+ SIG_IGN* = 1;
+
+ TYPE
+ pthread_t* = C99sys_types.pthread_t;
+ pthread_attr_t* = C99sys_types.pthread_attr_t;
+ size_t* = C99sys_types.size_t;
+ uid_t* = C99sys_types.uid_t;
+ pid_t* = C99sys_types.pid_t;
+
+ TYPE
+ struct_timespec* = C99time.struct_timespec;
+
+ TYPE
+ sig_atomic_t* = INTEGER;
+ sigset_t* = RECORD [noalign] _: ARRAY [untagged] 128 OF BYTE END;
+
+ TYPE
+ Pstruct_sigevent* = POINTER TO struct_sigevent;
+ struct_sigevent* ['struct sigevent'] = RECORD [noalign] (* 64 *)
+ sigev_value*: union_sigval; (* 0+4 *)
+ sigev_signo*: int; (* 4+4 *)
+ sigev_notify*: int; (* 8+4 *)
+ sigev_notify_function*: PROCEDURE [ccall] (x: union_sigval); (* 12+4 *)
+ END;
+
+ CONST
+ SIGEV_NONE* = 1;
+ SIGEV_SIGNAL* = 0;
+ SIGEV_THREAD* = 2;
+
+ TYPE
+ Punion_sigval* = POINTER TO union_sigval;
+ union_sigval* ['union sigval'] = RECORD [union] (* 4 *)
+ sival_int*: int; (* 0+4 *)
+ sival_ptr*: C99types.Pvoid; (* 0+4 *)
+ END;
+
+ CONST
+ SIGRTMIN* = 34;
+ SIGRTMAX* = 64;
+ RTSIG_MAX* = 32;
+
+ CONST
+ SIGABRT* = 6;
+ SIGALRM* = 14;
+ SIGBUS* = 7;
+ SIGCHLD* = 17;
+ SIGCONT* = 18;
+ SIGFPE* = 8;
+ SIGHUP* = 1;
+ SIGILL* = 4;
+ SIGINT* = 2;
+ SIGKILL* = 9;
+ SIGPIPE* = 13;
+ SIGQUIT* = 3;
+ SIGSEGV* = 11;
+ SIGSTOP* = 19;
+ SIGTERM* = 15;
+ SIGTSTP* = 20;
+ SIGTTIN* = 21;
+ SIGTTOU* = 22;
+ SIGUSR1* = 10;
+ SIGUSR2* = 12;
+ SIGPOLL* = 29;
+ SIGPROF* = 27;
+ SIGSYS* = 31;
+ SIGTRAP* = 5;
+ SIGURG* = 23;
+ SIGVTALRM* = 26;
+ SIGXCPU* = 24;
+ SIGXFSZ* = 25;
+
+ TYPE
+ P_struct_sigaction* = POINTER TO _struct_sigaction;
+ _struct_sigaction* ['struct sigaction'] = RECORD [noalign] (* 140 *)
+ sa_handler*: PROCEDURE [ccall] (sig: int); (* 0+4 *)
+ sa_sigaction*: PROCEDURE [ccall] (sig: int; IN siginfo: siginfo_t; context: C99types.Pvoid); (* 0+4 *)
+ sa_mask*: sigset_t; (* 4+128 *)
+ sa_flags*: int; (* 132+4 *)
+ END;
+
+ TYPE
+ Pstruct_sigaction* = POINTER TO struct_sigaction;
+ struct_sigaction* ['struct sigaction'] = RECORD [noalign] (* 140 *)
+ handler*: RECORD [union] (* 4 *)
+ sa_handler*: PROCEDURE [ccall] (sig: int); (* 0+4 *)
+ sa_sigaction*: PROCEDURE [ccall] (sig: int; IN siginfo: siginfo_t; context: C99types.Pvoid); (* 0+4 *)
+ END; (* 0+4 *)
+ sa_mask*: sigset_t; (* 4+128 *)
+ sa_flags*: int; (* 132+4 *)
+ END;
+
+ CONST
+ SIG_BLOCK* = 0;
+ SIG_UNBLOCK* = 1;
+ SIG_SETMASK* = 2;
+
+ CONST
+ SA_NOCLDSTOP* = 1;
+ SA_ONSTACK* = 134217728;
+ SA_RESETHAND* = -2147483648;
+ SA_RESTART* = 268435456;
+ SA_SIGINFO* = 4;
+ SA_NOCLDWAIT* = 2;
+ SA_NODEFER* = 1073741824;
+ SS_ONSTACK* = 1;
+ SS_DISABLE* = 2;
+ MINSIGSTKSZ* = 2048;
+ SIGSTKSZ* = 8192;
+
+ TYPE
+ mcontext_t* = RECORD [noalign] _: ARRAY [untagged] 88 OF BYTE END;
+
+ TYPE
+ Pucontext_t* = POINTER TO ucontext_t;
+ ucontext_t* ['ucontext_t'] = RECORD [noalign] (* 348 *)
+ uc_link*: Pucontext_t; (* 4+4 *)
+ uc_stack*: stack_t; (* 8+12 *)
+ uc_mcontext*: mcontext_t; (* 20+88 *)
+ uc_sigmask*: sigset_t; (* 108+128 *)
+ END;
+
+ TYPE
+ Pstack_t* = POINTER TO stack_t;
+ stack_t* ['stack_t'] = RECORD [noalign] (* 12 *)
+ ss_sp*: C99types.Pvoid; (* 0+4 *)
+ ss_flags*: int; (* 4+4 *)
+ ss_size*: size_t; (* 8+4 *)
+ END;
+
+ TYPE
+ P_siginfo_t* = POINTER TO _siginfo_t;
+ _siginfo_t* ['siginfo_t'] = RECORD [noalign] (* 128 *)
+ si_signo*: int; (* 0+4 *)
+ si_errno*: int; (* 4+4 *)
+ si_code*: int; (* 8+4 *)
+ si_pid*: pid_t; (* 12+4 *)
+ si_addr*: C99types.Pvoid; (* 12+4 *)
+ si_band*: long; (* 12+4 *)
+ si_uid*: uid_t; (* 16+4 *)
+ si_status*: int; (* 20+4 *)
+ si_value*: union_sigval; (* 20+4 *)
+ END;
+
+ TYPE
+ Psiginfo_t* = POINTER TO siginfo_t;
+ siginfo_t* ['siginfo_t'] = RECORD [noalign] (* 128 *)
+ si_signo*: int; (* 0+4 *)
+ si_errno*: int; (* 4+4 *)
+ si_code*: int; (* 8+4 *)
+ info*: RECORD [union] (* 24 *)
+ sigill*: RECORD [noalign] (* 16 *)
+ si_addr*: C99types.Pvoid; (* 12+4 *)
+ END; (* 0+16 *)
+ sigfpe*: RECORD [noalign] (* 16 *)
+ si_addr*: C99types.Pvoid; (* 12+4 *)
+ END; (* 0+16 *)
+ sigsegv*: RECORD [noalign] (* 16 *)
+ si_addr*: C99types.Pvoid; (* 12+4 *)
+ END; (* 0+16 *)
+ sigbus*: RECORD [noalign] (* 16 *)
+ si_addr*: C99types.Pvoid; (* 12+4 *)
+ END; (* 0+16 *)
+ sigchld*: RECORD [noalign] (* 24 *)
+ si_pid*: pid_t; (* 12+4 *)
+ si_uid*: uid_t; (* 16+4 *)
+ si_status*: int; (* 20+4 *)
+ END; (* 0+24 *)
+ sigpoll*: RECORD [noalign] (* 16 *)
+ si_band*: long; (* 12+4 *)
+ END; (* 0+16 *)
+ other*: RECORD [noalign] (* 24 *)
+ si_value*: union_sigval; (* 20+4 *)
+ END; (* 0+24 *)
+ END; (* 12+24 *)
+ END;
+
+ CONST
+ ILL_ILLOPC* = 1;
+ ILL_ILLOPN* = 2;
+ ILL_ILLADR* = 3;
+ ILL_ILLTRP* = 4;
+ ILL_PRVOPC* = 5;
+ ILL_PRVREG* = 6;
+ ILL_COPROC* = 7;
+ ILL_BADSTK* = 8;
+
+ CONST
+ FPE_INTDIV* = 1;
+ FPE_INTOVF* = 2;
+ FPE_FLTDIV* = 3;
+ FPE_FLTOVF* = 4;
+ FPE_FLTUND* = 5;
+ FPE_FLTRES* = 6;
+ FPE_FLTINV* = 7;
+ FPE_FLTSUB* = 8;
+
+ CONST
+ SEGV_MAPERR* = 1;
+ SEGV_ACCERR* = 2;
+
+ CONST
+ BUS_ADRALN* = 1;
+ BUS_ADRERR* = 2;
+ BUS_OBJERR* = 3;
+
+ CONST
+ CLD_EXITED* = 1;
+ CLD_KILLED* = 2;
+ CLD_DUMPED* = 3;
+ CLD_TRAPPED* = 4;
+ CLD_STOPPED* = 5;
+ CLD_CONTINUED* = 6;
+
+ CONST
+ POLL_IN* = 1;
+ POLL_OUT* = 2;
+ POLL_MSG* = 3;
+ POLL_ERR* = 4;
+ POLL_PRI* = 5;
+ POLL_HUP* = 6;
+
+ CONST
+ SI_USER* = 0;
+ SI_QUEUE* = -1;
+ SI_TIMER* = -2;
+ SI_ASYNCIO* = -4;
+ SI_MESGQ* = -3;
+
+ PROCEDURE [ccall] kill* (pid: pid_t; sig: int): int;
+ PROCEDURE [ccall] killpg* (pgrp, sig: int): int;
+ PROCEDURE [ccall] psiginfo* (IN pinfo: siginfo_t; IN [nil] s: ARRAY [untagged] OF SHORTCHAR);
+ PROCEDURE [ccall] psignal* (sig: int; IN [nil] s: ARRAY [untagged] OF SHORTCHAR);
+ PROCEDURE [ccall] pthread_kill* (thread: pthread_t; sig: int): int;
+ PROCEDURE [ccall] pthread_sigmask* (how: int; IN [nil] set: sigset_t; VAR [nil] oldset: sigset_t): int;
+ PROCEDURE [ccall] raise* (sig: int): int;
+ PROCEDURE [ccall] sigaction* (sig: int; IN [nil] act: struct_sigaction; VAR [nil] oact: struct_sigaction): int;
+ PROCEDURE [ccall] sigaddset* (VAR set: sigset_t; signum: int): int;
+ PROCEDURE [ccall] sigaltstack* (IN [nil] ss: stack_t; VAR [nil] oss: stack_t): int;
+ PROCEDURE [ccall] sigdelset* (VAR set: sigset_t; signum: int): int;
+ PROCEDURE [ccall] sigemptyset* (VAR set: sigset_t): int;
+ PROCEDURE [ccall] sigfillset* (VAR set: sigset_t): int;
+ PROCEDURE [ccall] sighold* (sig: int): int;
+ PROCEDURE [ccall] sigignore* (sig: int): int;
+ PROCEDURE [ccall] siginterrupt* (sig, flag: int): int;
+ PROCEDURE [ccall] sigismember* (IN set: sigset_t; signum: int): int;
+ PROCEDURE [ccall] sigpause* (sig: int): int;
+ PROCEDURE [ccall] sigpending* (VAR set: sigset_t): int;
+ PROCEDURE [ccall] sigprocmask* (how: int; IN [nil] set: sigset_t; VAR [nil] oset: sigset_t): int;
+ PROCEDURE [ccall] sigqueue* (pid: pid_t; sig: int; IN value: union_sigval): int;
+ PROCEDURE [ccall] sigrelse* (sig: int): int;
+ PROCEDURE [ccall] sigsuspend* (IN sigmask: sigset_t): int;
+ PROCEDURE [ccall] sigtimedwait* (IN set: sigset_t; VAR [nil] info: siginfo_t; IN timeout: struct_timespec): int;
+ PROCEDURE [ccall] sigwait* (IN set: sigset_t; VAR sig: int): int;
+ PROCEDURE [ccall] sigwaitinfo* (IN set: sigset_t; VAR [nil] info: siginfo_t): int;
+
+END C99signal.
diff --git a/src/cpfront/linux/C99/Mod/stdio.cp b/src/cpfront/linux/C99/Mod/stdio.cp
--- /dev/null
@@ -0,0 +1,91 @@
+MODULE C99stdio ['stdio.h'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types, C99sys_types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ TYPE
+ PFILE* = POINTER TO FILE;
+ FILE ['FILE'] = LIMITED RECORD [untagged] END;
+
+ TYPE
+ fpos_t* = RECORD [noalign] _: ARRAY [untagged] 12 OF BYTE END;
+
+ TYPE
+ off_t* = C99sys_types.off_t;
+ ssize_t* = C99sys_types.ssize_t;
+
+ TYPE
+ size_t* = INTEGER;
+
+ TYPE
+ va_list* = INTEGER;
+
+ CONST
+ BUFSIZ* = 8192;
+ L_ctermid* = 9;
+ L_tmpnam* = 20;
+
+ CONST
+ _IOFBF* = 0;
+ _IOLBF* = 1;
+ _IONBF* = 2;
+
+ CONST
+ SEEK_CUR* = 1;
+ SEEK_END* = 2;
+ SEEK_SET* = 0;
+
+ CONST
+ FILENAME_MAX* = 4096;
+ FOPEN_MAX* = 16;
+ TMP_MAX* = 238328;
+
+ CONST
+ EOF* = -1;
+
+ PROCEDURE [ccall] fclose* (stream: PFILE): int;
+ PROCEDURE [ccall] ferror* (stream: PFILE): int;
+ PROCEDURE [ccall] fflush* (stream: PFILE): int;
+ PROCEDURE [ccall] fopen* (IN pathname, mode: ARRAY [untagged] OF SHORTCHAR): PFILE;
+ PROCEDURE [ccall] fread* (ptr: C99types.Pvoid; size, n: size_t; stream: PFILE): size_t;
+ PROCEDURE [ccall] fseek* (stream: PFILE; offset: long; whence: int): int;
+ PROCEDURE [ccall] ftell* (stream: PFILE): long;
+ PROCEDURE [ccall] fwrite* (ptr: C99types.Pvoid; size, n: size_t; stream: PFILE): size_t;
+ PROCEDURE [ccall] feof* (stream: PFILE): int;
+ PROCEDURE [ccall] remove* (IN pathname: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] rename* (IN old, new: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] tmpfile* (): PFILE;
+
+END C99stdio.
diff --git a/src/cpfront/linux/C99/Mod/stdlib.cp b/src/cpfront/linux/C99/Mod/stdlib.cp
--- /dev/null
@@ -0,0 +1,66 @@
+MODULE C99stdlib ['stdlib.h'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ CONST
+ EXIT_FAILURE* = 1;
+ EXIT_SUCCESS* = 0;
+ RAND_MAX* = 2147483647;
+
+ CONST
+ MB_CUR_MAX* = 1;
+
+ TYPE
+ div_t* = RECORD [noalign] _: ARRAY [untagged] 8 OF BYTE END;
+ ldiv_t* = RECORD [noalign] _: ARRAY [untagged] 8 OF BYTE END;
+ lldiv_t* = RECORD [noalign] _: ARRAY [untagged] 16 OF BYTE END;
+
+ TYPE
+ size_t* = INTEGER;
+ wchar_t* = INTEGER;
+
+ PROCEDURE [ccall] _Exit* (status: int);
+ PROCEDURE [ccall] abort* ;
+ PROCEDURE [ccall] atexit* (function: PROCEDURE [ccall]): int;
+ PROCEDURE [ccall] exit* (status: int);
+ PROCEDURE [ccall] free* (ptr: C99types.Pvoid);
+ PROCEDURE [ccall] getenv* (IN name: ARRAY [untagged] OF SHORTCHAR): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] malloc* (size: size_t): C99types.Pvoid;
+ PROCEDURE [ccall] system* (IN command: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] mkstemp* (VAR template: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] realpath* (IN path: ARRAY [untagged] OF SHORTCHAR; VAR [nil] resolved_path: ARRAY [untagged] OF SHORTCHAR): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+
+END C99stdlib.
diff --git a/src/cpfront/linux/C99/Mod/sys_mman.cp b/src/cpfront/linux/C99/Mod/sys_mman.cp
--- /dev/null
@@ -0,0 +1,86 @@
+MODULE C99sys_mman ['sys/mman.h'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types, C99sys_types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ CONST
+ PROT_EXEC* = 4;
+ PROT_NONE* = 0;
+ PROT_READ* = 1;
+ PROT_WRITE* = 2;
+
+ CONST
+ MAP_FIXED* = 16;
+ MAP_PRIVATE* = 2;
+ MAP_SHARED* = 1;
+
+ CONST
+ MS_ASYNC* = 1;
+ MS_INVALIDATE* = 2;
+ MS_SYNC* = 4;
+
+ CONST
+ MCL_CURRENT* = 1;
+ MCL_FUTURE* = 2;
+
+ CONST
+ MAP_FAILED* = -1;
+
+ CONST
+ POSIX_MADV_DONTNEED* = 4;
+ POSIX_MADV_NORMAL* = 0;
+ POSIX_MADV_RANDOM* = 1;
+ POSIX_MADV_SEQUENTIAL* = 2;
+ POSIX_MADV_WILLNEED* = 3;
+
+ TYPE
+ mode_t* = C99sys_types.mode_t;
+ off_t* = C99sys_types.off_t;
+ size_t* = C99sys_types.size_t;
+
+ PROCEDURE [ccall] mlock* (addr: C99types.Pvoid; len: size_t): int;
+ PROCEDURE [ccall] mlockall* (flags: int): int;
+ PROCEDURE [ccall] mmap* (addr: C99types.Pvoid; len: size_t; prot, flags, fildes: int; off: off_t): C99types.Pvoid;
+ PROCEDURE [ccall] mprotect* (addr: C99types.Pvoid; len: size_t; prot: int): int;
+ PROCEDURE [ccall] msync* (addr: C99types.Pvoid; len: size_t; flags: int): int;
+ PROCEDURE [ccall] munlock* (addr: C99types.Pvoid; len: size_t): int;
+ PROCEDURE [ccall] munlockall* (): int;
+ PROCEDURE [ccall] munmap* (addr: C99types.Pvoid; len: size_t): int;
+ PROCEDURE [ccall] posix_madvise* (addr: C99types.Pvoid; len: size_t; advice: int): int;
+ PROCEDURE [ccall] posix_mem_offset* (addr: C99types.Pvoid; len: size_t; VAR off: off_t; VAR contng_len: size_t; VAR fildes: int): int;
+ PROCEDURE [ccall] shm_open* (IN name: ARRAY [untagged] OF SHORTCHAR; oflag, mode: int): int;
+ PROCEDURE [ccall] shm_unlink* (IN name: ARRAY [untagged] OF SHORTCHAR): int;
+
+END C99sys_mman.
diff --git a/src/cpfront/linux/C99/Mod/sys_stat.cp b/src/cpfront/linux/C99/Mod/sys_stat.cp
--- /dev/null
@@ -0,0 +1,119 @@
+MODULE C99sys_stat ['sys/stat.h'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types, C99time, C99sys_types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ CONST
+ S_IFMT* = 61440;
+ S_IFBLK* = 24576;
+ S_IFCHR* = 8192;
+ S_IFIFO* = 4096;
+ S_IFREG* = 32768;
+ S_IFDIR* = 16384;
+ S_IFLNK* = 40960;
+ S_IFSOCK* = 49152;
+
+ CONST
+ S_IRWXU* = 448;
+ S_IRUSR* = 256;
+ S_IWUSR* = 128;
+ S_IXUSR* = 64;
+ S_IRWXG* = 56;
+ S_IRGRP* = 32;
+ S_IWGRP* = 16;
+ S_IXGRP* = 8;
+ S_IRWXO* = 7;
+ S_IROTH* = 4;
+ S_IWOTH* = 2;
+ S_IXOTH* = 1;
+ S_ISUID* = 2048;
+ S_ISGID* = 1024;
+ S_ISVTX* = 512;
+
+ CONST
+ UTIME_NOW* = 1073741823;
+ UTIME_OMIT* = 1073741822;
+
+ TYPE
+ blkcnt_t* = C99sys_types.blkcnt_t;
+ blksize_t* = C99sys_types.blksize_t;
+ dev_t* = C99sys_types.dev_t;
+ ino_t* = C99sys_types.ino_t;
+ mode_t* = C99sys_types.mode_t;
+ nlink_t* = C99sys_types.nlink_t;
+ uid_t* = C99sys_types.uid_t;
+ gid_t* = C99sys_types.gid_t;
+ off_t* = C99sys_types.off_t;
+ time_t* = C99sys_types.time_t;
+
+ TYPE
+ struct_timespec* = C99time.struct_timespec;
+
+ TYPE
+ Pstruct_stat* = POINTER TO struct_stat;
+ struct_stat* ['struct stat'] = RECORD [noalign] (* 88 *)
+ st_dev*: dev_t; (* 0+8 *)
+ st_ino*: ino_t; (* 12+4 *)
+ st_mode*: mode_t; (* 16+4 *)
+ st_nlink*: nlink_t; (* 20+4 *)
+ st_uid*: uid_t; (* 24+4 *)
+ st_gid*: gid_t; (* 28+4 *)
+ st_rdev*: dev_t; (* 32+8 *)
+ st_size*: off_t; (* 44+4 *)
+ st_blksize*: blksize_t; (* 48+4 *)
+ st_blocks*: blkcnt_t; (* 52+4 *)
+ st_atim*: struct_timespec; (* 56+8 *)
+ st_mtim*: struct_timespec; (* 64+8 *)
+ st_ctim*: struct_timespec; (* 72+8 *)
+ END;
+
+ PROCEDURE [ccall] chmod* (IN path: ARRAY [untagged] OF SHORTCHAR; mode: mode_t): int;
+ PROCEDURE [ccall] fchmod* (fd: int; IN path: ARRAY [untagged] OF SHORTCHAR; mode: mode_t): int;
+ PROCEDURE [ccall] fchmodat* (fd: int; IN path: ARRAY [untagged] OF SHORTCHAR; mode: mode_t; flag: int): int;
+ PROCEDURE [ccall] fstat* (fd: int; VAR buf: struct_stat): int;
+ PROCEDURE [ccall] fstatat* (fd: int; IN path: ARRAY [untagged] OF SHORTCHAR; VAR buf: struct_stat; flag: int): int;
+ PROCEDURE [ccall] futimens* (fd: int; IN times: ARRAY [untagged] 2 OF struct_timespec): int;
+ PROCEDURE [ccall] lstat* (IN path: ARRAY [untagged] OF SHORTCHAR; VAR buf: struct_stat): int;
+ PROCEDURE [ccall] mkdir* (IN path: ARRAY [untagged] OF SHORTCHAR; mode: mode_t): int;
+ PROCEDURE [ccall] mkdirat* (fd: int; IN path: ARRAY [untagged] OF SHORTCHAR; mode: mode_t): int;
+ PROCEDURE [ccall] mkfifo* (IN pathname: ARRAY [untagged] OF SHORTCHAR; mode: mode_t): int;
+ PROCEDURE [ccall] mkfifoat* (dirfd: int; IN pathname: ARRAY [untagged] OF SHORTCHAR; mode: mode_t): int;
+ PROCEDURE [ccall] mknod* (IN path: ARRAY [untagged] OF SHORTCHAR; mode: mode_t; dev: dev_t): int;
+ PROCEDURE [ccall] mknodat* (df: int; IN path: ARRAY [untagged] OF SHORTCHAR; mode: mode_t; dev: dev_t): int;
+ PROCEDURE [ccall] stat* (IN path: ARRAY [untagged] OF SHORTCHAR; VAR buf: struct_stat): int;
+ PROCEDURE [ccall] umask* (mode: mode_t): mode_t;
+ PROCEDURE [ccall] utimensat* (dirfd: int; IN pathname: ARRAY [untagged] OF SHORTCHAR; IN times: ARRAY [untagged] 2 OF struct_timespec; flags: int): int;
+
+END C99sys_stat.
diff --git a/src/cpfront/linux/C99/Mod/sys_types.cp b/src/cpfront/linux/C99/Mod/sys_types.cp
--- /dev/null
@@ -0,0 +1,75 @@
+MODULE C99sys_types ['sys/types.h'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ TYPE
+ blkcnt_t* = INTEGER;
+ blksize_t* = INTEGER;
+ clock_t* = INTEGER;
+ clockid_t* = INTEGER;
+ dev_t* = LONGINT;
+ fsblkcnt_t* = INTEGER;
+ fsfilcnt_t* = INTEGER;
+ gid_t* = INTEGER;
+ id_t* = INTEGER;
+ ino_t* = INTEGER;
+ key_t* = INTEGER;
+ mode_t* = INTEGER;
+ nlink_t* = INTEGER;
+ off_t* = INTEGER;
+ pid_t* = INTEGER;
+ pthread_attr_t* = RECORD [noalign] _: ARRAY [untagged] 36 OF BYTE END;
+ pthread_barrier_t* = RECORD [noalign] _: ARRAY [untagged] 20 OF BYTE END;
+ pthread_barrierattr_t* = INTEGER;
+ pthread_cond_t* = RECORD [noalign] _: ARRAY [untagged] 48 OF BYTE END;
+ pthread_condattr_t* = INTEGER;
+ pthread_key_t* = INTEGER;
+ pthread_mutex_t* = RECORD [noalign] _: ARRAY [untagged] 24 OF BYTE END;
+ pthread_mutexattr_t* = INTEGER;
+ pthread_once_t* = INTEGER;
+ pthread_rwlock_t* = RECORD [noalign] _: ARRAY [untagged] 32 OF BYTE END;
+ pthread_rwlockattr_t* = RECORD [noalign] _: ARRAY [untagged] 8 OF BYTE END;
+ pthread_spinlock_t* = INTEGER;
+ pthread_t* = INTEGER;
+ size_t* = INTEGER;
+ ssize_t* = INTEGER;
+ suseconds_t* = INTEGER;
+ time_t* = INTEGER;
+ timer_t* = INTEGER;
+ uid_t* = INTEGER;
+
+
+END C99sys_types.
diff --git a/src/cpfront/linux/C99/Mod/time.cp b/src/cpfront/linux/C99/Mod/time.cp
--- /dev/null
@@ -0,0 +1,117 @@
+MODULE C99time ['time.h'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types, C99sys_types, C99locale;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ TYPE
+ clock_t* = C99sys_types.clock_t;
+ size_t* = C99sys_types.size_t;
+ time_t* = C99sys_types.time_t;
+ clockid_t* = C99sys_types.clockid_t;
+ timer_t* = C99sys_types.timer_t;
+ pid_t* = C99sys_types.pid_t;
+
+ TYPE
+ locale_t* = C99locale.locale_t;
+
+ TYPE
+ Pstruct_tm* = POINTER TO struct_tm;
+ struct_tm* ['struct tm'] = RECORD [noalign] (* 44 *)
+ tm_sec*: int; (* 0+4 *)
+ tm_min*: int; (* 4+4 *)
+ tm_hour*: int; (* 8+4 *)
+ tm_mday*: int; (* 12+4 *)
+ tm_mon*: int; (* 16+4 *)
+ tm_year*: int; (* 20+4 *)
+ tm_wday*: int; (* 24+4 *)
+ tm_yday*: int; (* 28+4 *)
+ tm_isdst*: int; (* 32+4 *)
+ END;
+
+ TYPE
+ Pstruct_timespec* = POINTER TO struct_timespec;
+ struct_timespec* ['struct timespec'] = RECORD [noalign] (* 8 *)
+ tv_sec*: time_t; (* 0+4 *)
+ tv_nsec*: long; (* 4+4 *)
+ END;
+
+ TYPE
+ Pstruct_itimerspec* = POINTER TO struct_itimerspec;
+ struct_itimerspec* ['struct itimerspec'] = RECORD [noalign] (* 16 *)
+ it_interval*: struct_timespec; (* 0+8 *)
+ it_value*: struct_timespec; (* 8+8 *)
+ END;
+
+ CONST
+ CLOCKS_PER_SEC* = 1000000;
+
+ CONST
+ CLOCK_MONOTONIC* = 1;
+ CLOCK_PROCESS_CPUTIME_ID* = 2;
+ CLOCK_REALTIME* = 0;
+ CLOCK_THREAD_CPUTIME_ID* = 3;
+
+ CONST
+ TIMER_ABSTIME* = 1;
+
+ PROCEDURE [ccall] asctime* (IN tm: struct_tm): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] asctime_r* (IN tm: struct_tm; buf: POINTER TO ARRAY [untagged] OF SHORTCHAR): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] clock* (): clock_t;
+ PROCEDURE [ccall] clock_getcpuclockid* (pid: pid_t; VAR clock_id: clockid_t): int;
+ PROCEDURE [ccall] clock_getres* (clk_id: clockid_t; VAR res: struct_timespec): int;
+ PROCEDURE [ccall] clock_gettime* (clk_id: clockid_t; VAR res: struct_timespec): int;
+ PROCEDURE [ccall] clock_nanosleep* (clock_id: clockid_t; falgs: int; IN [nil] rqtp: struct_timespec; VAR [nil] rmtp: struct_timespec): int;
+ PROCEDURE [ccall] clock_settime* (clk_id: clockid_t; IN res: struct_timespec): int;
+ PROCEDURE [ccall] ctime* (VAR timep: time_t): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] ctime_r* (VAR timep: time_t; buf: POINTER TO ARRAY [untagged] OF SHORTCHAR): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] difftime* (time0, time1: time_t): double;
+ PROCEDURE [ccall] getdate* (IN string: ARRAY [untagged] OF SHORTCHAR): Pstruct_tm;
+ PROCEDURE [ccall] gmtime* (VAR timep: time_t): Pstruct_tm;
+ PROCEDURE [ccall] gmtime_r* (VAR timep: time_t; VAR result: struct_tm): Pstruct_tm;
+ PROCEDURE [ccall] localtime* (VAR timep: time_t): Pstruct_tm;
+ PROCEDURE [ccall] localtime_r* (VAR timep: time_t; VAR result: struct_tm): Pstruct_tm;
+ PROCEDURE [ccall] mktime* (VAR tm: struct_tm): time_t;
+ PROCEDURE [ccall] nanosleep* (IN [nil] rqtp: struct_timespec; VAR [nil] rmtp: struct_timespec): int;
+ PROCEDURE [ccall] strftime* (VAR s: ARRAY [untagged] OF SHORTCHAR; max: size_t; IN format: ARRAY [untagged] OF SHORTCHAR; IN tm: struct_tm): size_t;
+ PROCEDURE [ccall] strftime_l* (VAR s: ARRAY [untagged] OF SHORTCHAR; max: size_t; IN format: ARRAY [untagged] OF SHORTCHAR; IN tm: struct_tm; locale: locale_t): size_t;
+ PROCEDURE [ccall] strptime* (IN s, format: ARRAY [untagged] OF SHORTCHAR; VAR tm: struct_tm): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] time* (VAR [nil] tloc: time_t): time_t;
+ PROCEDURE [ccall] timer_delete* (timerid: timer_t): int;
+ PROCEDURE [ccall] timer_getoverrun* (timerid: timer_t): int;
+ PROCEDURE [ccall] timer_gettime* (timerid: timer_t; VAR value: struct_itimerspec): int;
+ PROCEDURE [ccall] timer_settime* (timerid: timer_t; flags: int; IN value: struct_itimerspec; VAR [nil] ovalue: struct_itimerspec): int;
+ PROCEDURE [ccall] tzset* ;
+
+END C99time.
diff --git a/src/cpfront/linux/C99/Mod/types.cp b/src/cpfront/linux/C99/Mod/types.cp
--- /dev/null
@@ -0,0 +1,38 @@
+MODULE C99types;
+
+ (* generated by genposix.sh, do not modify *)
+
+ TYPE
+ char* = BYTE;
+ signed_char* = BYTE;
+ unsigned_char* = BYTE;
+ short* = SHORTINT;
+ short_int* = SHORTINT;
+ signed_short* = SHORTINT;
+ signed_short_int* = SHORTINT;
+ unsigned_short* = SHORTINT;
+ unsigned_short_int* = SHORTINT;
+ int* = INTEGER;
+ signed* = INTEGER;
+ signed_int* = INTEGER;
+ unsigned* = INTEGER;
+ unsigned_int* = INTEGER;
+ long* = INTEGER;
+ long_int* = INTEGER;
+ signed_long* = INTEGER;
+ signed_long_int* = INTEGER;
+ unsigned_long* = INTEGER;
+ unsigned_long_int* = INTEGER;
+ long_long* = LONGINT;
+ long_long_int* = LONGINT;
+ signed_long_long* = LONGINT;
+ signed_long_long_int* = LONGINT;
+ unsigned_long_long* = LONGINT;
+ unsigned_long_long_int* = LONGINT;
+ float* = SHORTREAL;
+ double* = REAL;
+ long_double* = RECORD [noalign] _: ARRAY [untagged] 12 OF BYTE END;
+ Pvoid* = INTEGER;
+
+
+END C99types.
diff --git a/src/cpfront/linux/C99/Mod/unistd.cp b/src/cpfront/linux/C99/Mod/unistd.cp
--- /dev/null
@@ -0,0 +1,430 @@
+MODULE C99unistd ['unistd.h'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types, C99sys_types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ CONST
+ _POSIX_VERSION* = 200809;
+ _POSIX2_VERSION* = 200809;
+ _XOPEN_VERSION* = 700;
+
+ CONST
+ _POSIX_ADVISORY_INFO* = 200809;
+ _POSIX_ASYNCHRONOUS_IO* = 200809;
+ _POSIX_BARRIERS* = 200809;
+ _POSIX_CHOWN_RESTRICTED* = 0;
+ _POSIX_CLOCK_SELECTION* = 200809;
+ _POSIX_CPUTIME* = 0;
+ _POSIX_FSYNC* = 200809;
+ _POSIX_IPV6* = 200809;
+ _POSIX_JOB_CONTROL* = 1;
+ _POSIX_MAPPED_FILES* = 200809;
+ _POSIX_MEMLOCK* = 200809;
+ _POSIX_MEMLOCK_RANGE* = 200809;
+ _POSIX_MEMORY_PROTECTION* = 200809;
+ _POSIX_MESSAGE_PASSING* = 200809;
+ _POSIX_MONOTONIC_CLOCK* = 0;
+ _POSIX_NO_TRUNC* = 1;
+ _POSIX_PRIORITIZED_IO* = 200809;
+ _POSIX_PRIORITY_SCHEDULING* = 200809;
+ _POSIX_RAW_SOCKETS* = 200809;
+ _POSIX_READER_WRITER_LOCKS* = 200809;
+ _POSIX_REALTIME_SIGNALS* = 200809;
+ _POSIX_REGEXP* = 1;
+ _POSIX_SAVED_IDS* = 1;
+ _POSIX_SEMAPHORES* = 200809;
+ _POSIX_SHARED_MEMORY_OBJECTS* = 200809;
+ _POSIX_SHELL* = 1;
+ _POSIX_SPAWN* = 200809;
+ _POSIX_SPIN_LOCKS* = 200809;
+ _POSIX_SPORADIC_SERVER* = -1;
+ _POSIX_SYNCHRONIZED_IO* = 200809;
+ _POSIX_THREAD_ATTR_STACKADDR* = 200809;
+ _POSIX_THREAD_ATTR_STACKSIZE* = 200809;
+ _POSIX_THREAD_CPUTIME* = 0;
+ _POSIX_THREAD_PRIO_INHERIT* = 200809;
+ _POSIX_THREAD_PRIO_PROTECT* = 200809;
+ _POSIX_THREAD_PRIORITY_SCHEDULING* = 200809;
+ _POSIX_THREAD_PROCESS_SHARED* = 200809;
+ _POSIX_THREAD_ROBUST_PRIO_INHERIT* = 200809;
+ _POSIX_THREAD_ROBUST_PRIO_PROTECT* = -1;
+ _POSIX_THREAD_SAFE_FUNCTIONS* = 200809;
+ _POSIX_THREAD_SPORADIC_SERVER* = -1;
+ _POSIX_THREADS* = 200809;
+ _POSIX_TIMEOUTS* = 200809;
+ _POSIX_TIMERS* = 200809;
+ _POSIX_TRACE* = -1;
+ _POSIX_TRACE_EVENT_FILTER* = -1;
+ _POSIX_TRACE_INHERIT* = -1;
+ _POSIX_TRACE_LOG* = -1;
+ _POSIX_TYPED_MEMORY_OBJECTS* = -1;
+ _POSIX_V6_ILP32_OFF32* = 1;
+ _POSIX_V6_ILP32_OFFBIG* = 1;
+ _POSIX_V6_LP64_OFF64* = -1;
+ _POSIX_V6_LPBIG_OFFBIG* = -1;
+ _POSIX_V7_ILP32_OFF32* = 1;
+ _POSIX_V7_ILP32_OFFBIG* = 1;
+ _POSIX_V7_LP64_OFF64* = -1;
+ _POSIX_V7_LPBIG_OFFBIG* = -1;
+ _POSIX2_C_BIND* = 200809;
+ _POSIX2_C_DEV* = 200809;
+ _POSIX2_CHAR_TERM* = 200809;
+ _POSIX2_FORT_DEV* = -1;
+ _POSIX2_FORT_RUN* = -1;
+ _POSIX2_LOCALEDEF* = 200809;
+ _POSIX2_PBS* = -1;
+ _POSIX2_PBS_ACCOUNTING* = -1;
+ _POSIX2_PBS_CHECKPOINT* = -1;
+ _POSIX2_PBS_LOCATE* = -1;
+ _POSIX2_PBS_MESSAGE* = -1;
+ _POSIX2_PBS_TRACK* = -1;
+ _POSIX2_SW_DEV* = 200809;
+ _POSIX2_UPE* = -1;
+ _XOPEN_CRYPT* = 1;
+ _XOPEN_ENH_I18N* = 1;
+ _XOPEN_REALTIME* = 1;
+ _XOPEN_REALTIME_THREADS* = 1;
+ _XOPEN_SHM* = 1;
+ _XOPEN_STREAMS* = -1;
+ _XOPEN_UNIX* = 1;
+ _XOPEN_UUCP* = -1;
+
+ CONST
+ _POSIX_ASYNC_IO* = 1;
+ _POSIX_PRIO_IO* = -1;
+ _POSIX_SYNC_IO* = -1;
+ _POSIX_TIMESTAMP_RESOLUTION* = -1;
+ _POSIX2_SYMLINKS* = -1;
+
+ CONST
+ F_OK* = 0;
+ R_OK* = 4;
+ W_OK* = 2;
+ X_OK* = 1;
+
+ CONST
+ _CS_PATH* = 0;
+ _CS_POSIX_V7_ILP32_OFF32_CFLAGS* = 1132;
+ _CS_POSIX_V7_ILP32_OFF32_LDFLAGS* = 1133;
+ _CS_POSIX_V7_ILP32_OFF32_LIBS* = 1134;
+ _CS_POSIX_V7_ILP32_OFFBIG_CFLAGS* = 1136;
+ _CS_POSIX_V7_ILP32_OFFBIG_LDFLAGS* = 1137;
+ _CS_POSIX_V7_ILP32_OFFBIG_LIBS* = 1138;
+ _CS_POSIX_V7_LP64_OFF64_CFLAGS* = 1140;
+ _CS_POSIX_V7_LP64_OFF64_LDFLAGS* = 1141;
+ _CS_POSIX_V7_LP64_OFF64_LIBS* = 1142;
+ _CS_POSIX_V7_LPBIG_OFFBIG_CFLAGS* = 1144;
+ _CS_POSIX_V7_LPBIG_OFFBIG_LDFLAGS* = 1145;
+ _CS_POSIX_V7_LPBIG_OFFBIG_LIBS* = 1146;
+ _CS_POSIX_V7_THREADS_CFLAGS* = -1;
+ _CS_POSIX_V7_THREADS_LDFLAGS* = -1;
+ _CS_POSIX_V7_WIDTH_RESTRICTED_ENVS* = 5;
+ _CS_V7_ENV* = 1149;
+ _CS_POSIX_V6_ILP32_OFF32_CFLAGS* = 1116;
+ _CS_POSIX_V6_ILP32_OFF32_LDFLAGS* = 1117;
+ _CS_POSIX_V6_ILP32_OFF32_LIBS* = 1118;
+ _CS_POSIX_V6_ILP32_OFFBIG_CFLAGS* = 1120;
+ _CS_POSIX_V6_ILP32_OFFBIG_LDFLAGS* = 1121;
+ _CS_POSIX_V6_ILP32_OFFBIG_LIBS* = 1122;
+ _CS_POSIX_V6_LP64_OFF64_CFLAGS* = 1124;
+ _CS_POSIX_V6_LP64_OFF64_LDFLAGS* = 1125;
+ _CS_POSIX_V6_LP64_OFF64_LIBS* = 1126;
+ _CS_POSIX_V6_LPBIG_OFFBIG_CFLAGS* = 1128;
+ _CS_POSIX_V6_LPBIG_OFFBIG_LDFLAGS* = 1129;
+ _CS_POSIX_V6_LPBIG_OFFBIG_LIBS* = 1130;
+ _CS_POSIX_V6_WIDTH_RESTRICTED_ENVS* = 1;
+ _CS_V6_ENV* = 1148;
+
+ CONST
+ SEEK_CUR* = 1;
+ SEEK_END* = 2;
+ SEEK_SET* = 0;
+
+ CONST
+ F_LOCK* = 1;
+ F_TEST* = 3;
+ F_TLOCK* = 2;
+ F_ULOCK* = 0;
+
+ CONST
+ _PC_2_SYMLINKS* = 20;
+ _PC_ALLOC_SIZE_MIN* = 18;
+ _PC_ASYNC_IO* = 10;
+ _PC_CHOWN_RESTRICTED* = 6;
+ _PC_FILESIZEBITS* = 13;
+ _PC_LINK_MAX* = 0;
+ _PC_MAX_CANON* = 1;
+ _PC_MAX_INPUT* = 2;
+ _PC_NAME_MAX* = 3;
+ _PC_NO_TRUNC* = 7;
+ _PC_PATH_MAX* = 4;
+ _PC_PIPE_BUF* = 5;
+ _PC_PRIO_IO* = 11;
+ _PC_REC_INCR_XFER_SIZE* = 14;
+ _PC_REC_MAX_XFER_SIZE* = 15;
+ _PC_REC_MIN_XFER_SIZE* = 16;
+ _PC_REC_XFER_ALIGN* = 17;
+ _PC_SYMLINK_MAX* = 19;
+ _PC_SYNC_IO* = 9;
+ _PC_TIMESTAMP_RESOLUTION* = -1;
+ _PC_VDISABLE* = 8;
+
+ CONST
+ _SC_2_C_BIND* = 47;
+ _SC_2_C_DEV* = 48;
+ _SC_2_CHAR_TERM* = 95;
+ _SC_2_FORT_DEV* = 49;
+ _SC_2_FORT_RUN* = 50;
+ _SC_2_LOCALEDEF* = 52;
+ _SC_2_PBS* = 168;
+ _SC_2_PBS_ACCOUNTING* = 169;
+ _SC_2_PBS_CHECKPOINT* = 175;
+ _SC_2_PBS_LOCATE* = 170;
+ _SC_2_PBS_MESSAGE* = 171;
+ _SC_2_PBS_TRACK* = 172;
+ _SC_2_SW_DEV* = 51;
+ _SC_2_UPE* = 97;
+ _SC_2_VERSION* = 46;
+ _SC_ADVISORY_INFO* = 132;
+ _SC_AIO_LISTIO_MAX* = 23;
+ _SC_AIO_MAX* = 24;
+ _SC_AIO_PRIO_DELTA_MAX* = 25;
+ _SC_ARG_MAX* = 0;
+ _SC_ASYNCHRONOUS_IO* = 12;
+ _SC_ATEXIT_MAX* = 87;
+ _SC_BARRIERS* = 133;
+ _SC_BC_BASE_MAX* = 36;
+ _SC_BC_DIM_MAX* = 37;
+ _SC_BC_SCALE_MAX* = 38;
+ _SC_BC_STRING_MAX* = 39;
+ _SC_CHILD_MAX* = 1;
+ _SC_CLK_TCK* = 2;
+ _SC_CLOCK_SELECTION* = 137;
+ _SC_COLL_WEIGHTS_MAX* = 40;
+ _SC_CPUTIME* = 138;
+ _SC_DELAYTIMER_MAX* = 26;
+ _SC_EXPR_NEST_MAX* = 42;
+ _SC_FSYNC* = 15;
+ _SC_GETGR_R_SIZE_MAX* = 69;
+ _SC_GETPW_R_SIZE_MAX* = 70;
+ _SC_HOST_NAME_MAX* = 180;
+ _SC_IOV_MAX* = 60;
+ _SC_IPV6* = 235;
+ _SC_JOB_CONTROL* = 7;
+ _SC_LINE_MAX* = 43;
+ _SC_LOGIN_NAME_MAX* = 71;
+ _SC_MAPPED_FILES* = 16;
+ _SC_MEMLOCK* = 17;
+ _SC_MEMLOCK_RANGE* = 18;
+ _SC_MEMORY_PROTECTION* = 19;
+ _SC_MESSAGE_PASSING* = 20;
+ _SC_MONOTONIC_CLOCK* = 149;
+ _SC_MQ_OPEN_MAX* = 27;
+ _SC_MQ_PRIO_MAX* = 28;
+ _SC_NGROUPS_MAX* = 3;
+ _SC_OPEN_MAX* = 4;
+ _SC_PAGE_SIZE* = 30;
+ _SC_PAGESIZE* = 30;
+ _SC_PRIORITIZED_IO* = 13;
+ _SC_PRIORITY_SCHEDULING* = 10;
+ _SC_RAW_SOCKETS* = 236;
+ _SC_RE_DUP_MAX* = 44;
+ _SC_READER_WRITER_LOCKS* = 153;
+ _SC_REALTIME_SIGNALS* = 9;
+ _SC_REGEXP* = 155;
+ _SC_RTSIG_MAX* = 31;
+ _SC_SAVED_IDS* = 8;
+ _SC_SEM_NSEMS_MAX* = 32;
+ _SC_SEM_VALUE_MAX* = 33;
+ _SC_SEMAPHORES* = 21;
+ _SC_SHARED_MEMORY_OBJECTS* = 22;
+ _SC_SHELL* = 157;
+ _SC_SIGQUEUE_MAX* = 34;
+ _SC_SPAWN* = 159;
+ _SC_SPIN_LOCKS* = 154;
+ _SC_SPORADIC_SERVER* = 160;
+ _SC_SS_REPL_MAX* = 241;
+ _SC_STREAM_MAX* = 5;
+ _SC_SYMLOOP_MAX* = 173;
+ _SC_SYNCHRONIZED_IO* = 14;
+ _SC_THREAD_ATTR_STACKADDR* = 77;
+ _SC_THREAD_ATTR_STACKSIZE* = 78;
+ _SC_THREAD_CPUTIME* = 139;
+ _SC_THREAD_DESTRUCTOR_ITERATIONS* = 73;
+ _SC_THREAD_KEYS_MAX* = 74;
+ _SC_THREAD_PRIO_INHERIT* = 80;
+ _SC_THREAD_PRIO_PROTECT* = 81;
+ _SC_THREAD_PRIORITY_SCHEDULING* = 79;
+ _SC_THREAD_PROCESS_SHARED* = 82;
+ _SC_THREAD_ROBUST_PRIO_INHERIT* = 247;
+ _SC_THREAD_ROBUST_PRIO_PROTECT* = 248;
+ _SC_THREAD_SAFE_FUNCTIONS* = 68;
+ _SC_THREAD_SPORADIC_SERVER* = 161;
+ _SC_THREAD_STACK_MIN* = 75;
+ _SC_THREAD_THREADS_MAX* = 76;
+ _SC_THREADS* = 67;
+ _SC_TIMEOUTS* = 164;
+ _SC_TIMER_MAX* = 35;
+ _SC_TIMERS* = 11;
+ _SC_TRACE* = 181;
+ _SC_TRACE_EVENT_FILTER* = 182;
+ _SC_TRACE_EVENT_NAME_MAX* = 242;
+ _SC_TRACE_INHERIT* = 183;
+ _SC_TRACE_LOG* = 184;
+ _SC_TRACE_NAME_MAX* = 243;
+ _SC_TRACE_SYS_MAX* = 244;
+ _SC_TRACE_USER_EVENT_MAX* = 245;
+ _SC_TTY_NAME_MAX* = 72;
+ _SC_TYPED_MEMORY_OBJECTS* = 165;
+ _SC_TZNAME_MAX* = 6;
+ _SC_V7_ILP32_OFF32* = 237;
+ _SC_V7_ILP32_OFFBIG* = 238;
+ _SC_V7_LP64_OFF64* = 239;
+ _SC_V7_LPBIG_OFFBIG* = 240;
+ _SC_V6_ILP32_OFF32* = 176;
+ _SC_V6_ILP32_OFFBIG* = 177;
+ _SC_V6_LP64_OFF64* = 178;
+ _SC_V6_LPBIG_OFFBIG* = 179;
+ _SC_VERSION* = 29;
+ _SC_XOPEN_CRYPT* = 92;
+ _SC_XOPEN_ENH_I18N* = 93;
+ _SC_XOPEN_REALTIME* = 130;
+ _SC_XOPEN_REALTIME_THREADS* = 131;
+ _SC_XOPEN_SHM* = 94;
+ _SC_XOPEN_STREAMS* = 246;
+ _SC_XOPEN_UNIX* = 91;
+ _SC_XOPEN_UUCP* = -1;
+ _SC_XOPEN_VERSION* = 89;
+
+ CONST
+ STDERR_FILENO* = 2;
+ STDIN_FILENO* = 0;
+ STDOUT_FILENO* = 1;
+
+ CONST
+ _POSIX_VDISABLE* = 0;
+
+ TYPE
+ size_t* = C99sys_types.size_t;
+ ssize_t* = C99sys_types.ssize_t;
+ uid_t* = C99sys_types.uid_t;
+ gid_t* = C99sys_types.gid_t;
+ off_t* = C99sys_types.off_t;
+ pid_t* = C99sys_types.pid_t;
+
+ TYPE
+ intptr_t* = INTEGER;
+
+ PROCEDURE [ccall] access* (IN path: ARRAY [untagged] OF SHORTCHAR; amode: int): int;
+ PROCEDURE [ccall] alarm* (seconds: unsigned): unsigned;
+ PROCEDURE [ccall] chdir* (IN path: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] chown* (IN path: ARRAY [untagged] OF SHORTCHAR; owner: uid_t; group: gid_t): int;
+ PROCEDURE [ccall] close* (fd: int): int;
+ PROCEDURE [ccall] confstr* (name: int; VAR buf: ARRAY [untagged] OF SHORTCHAR; len: size_t);
+ PROCEDURE [ccall] crypt* (IN key, salt: ARRAY [untagged] OF SHORTCHAR);
+ PROCEDURE [ccall] dup* (oldfd: int): int;
+ PROCEDURE [ccall] dup2* (oldfd, newfd: int): int;
+ PROCEDURE [ccall] _exit* (status: int);
+ PROCEDURE [ccall] encrypt* (VAR block: ARRAY [untagged] 64 OF SHORTCHAR; edflag: int);
+ PROCEDURE [ccall] execv* (IN path: ARRAY [untagged] OF SHORTCHAR; IN argv: ARRAY [untagged] OF POINTER TO ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] execve* (IN path: ARRAY [untagged] OF SHORTCHAR; IN argv, envp: ARRAY [untagged] OF POINTER TO ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] execvp* (IN file: ARRAY [untagged] OF SHORTCHAR; IN argv, envp: ARRAY [untagged] OF POINTER TO ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] faccessat* (fd: int; IN path: ARRAY [untagged] OF SHORTCHAR; amode, flag: int): int;
+ PROCEDURE [ccall] fchdir* (fildes: int): int;
+ PROCEDURE [ccall] fchown* (fildes: int; owner: uid_t; group: gid_t): int;
+ PROCEDURE [ccall] fchownat* (fd: int; IN path: ARRAY [untagged] OF SHORTCHAR; owner: uid_t; group: gid_t; flag: int): int;
+ PROCEDURE [ccall] fdatasync* (fildes: int): int;
+ PROCEDURE [ccall] fexecve* (fd: int; IN argv, envp: ARRAY [untagged] OF POINTER TO ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] fork* (): pid_t;
+ PROCEDURE [ccall] fpathconf* (fd, name: int): long;
+ PROCEDURE [ccall] fsync* (fildes: int): int;
+ PROCEDURE [ccall] ftruncate* (fildes: int; length: off_t): int;
+ PROCEDURE [ccall] getcwd* (VAR [nil] buf: ARRAY [untagged] OF SHORTCHAR; size: size_t): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] getegid* (): gid_t;
+ PROCEDURE [ccall] geteuid* (): uid_t;
+ PROCEDURE [ccall] getgid* (): gid_t;
+ PROCEDURE [ccall] getgroups* (gidsetsize: int; VAR grouplist: ARRAY [untagged] OF gid_t): int;
+ PROCEDURE [ccall] gethostid* (): long;
+ PROCEDURE [ccall] gethostname* (VAR name: ARRAY [untagged] OF SHORTCHAR; namelen: size_t): int;
+ PROCEDURE [ccall] getlogin* (): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] getlogin_r* (VAR buf: ARRAY [untagged] OF SHORTCHAR; bufsize: size_t): int;
+ PROCEDURE [ccall] getopt* (argc: int; IN argv: ARRAY [untagged] OF POINTER TO ARRAY [untagged] OF SHORTCHAR; IN optstring: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] getpgid* (pid: pid_t): pid_t;
+ PROCEDURE [ccall] getpgrp* (): pid_t;
+ PROCEDURE [ccall] getpid* (): pid_t;
+ PROCEDURE [ccall] getppid* (): pid_t;
+ PROCEDURE [ccall] getsid* (): pid_t;
+ PROCEDURE [ccall] getuid* (): uid_t;
+ PROCEDURE [ccall] isatty* (fd: int): int;
+ PROCEDURE [ccall] lchown* (IN path: ARRAY [untagged] OF SHORTCHAR; owner: uid_t; group: gid_t): int;
+ PROCEDURE [ccall] link* (IN path1, path2: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] linkat* (fd1: int; IN path1: ARRAY [untagged] OF SHORTCHAR; fd2: int; IN path2: ARRAY [untagged] OF SHORTCHAR; flag: int): int;
+ PROCEDURE [ccall] lockf* (fd, cmd: int; len: off_t): int;
+ PROCEDURE [ccall] lseek* (fildes: int; offset: off_t; whence: int): off_t;
+ PROCEDURE [ccall] nice* (incr: int): int;
+ PROCEDURE [ccall] pathconf* (IN path: ARRAY [untagged] OF SHORTCHAR; name: int): long;
+ PROCEDURE [ccall] pause* (): int;
+ PROCEDURE [ccall] pipe* (VAR fildes: ARRAY [untagged] 2 OF int): int;
+ PROCEDURE [ccall] pread* (fildes: int; buf: C99types.Pvoid; nbyte: size_t; offset: off_t): ssize_t;
+ PROCEDURE [ccall] pwrite* (fildes: int; buf: C99types.Pvoid; nbyte: size_t; offset: off_t): ssize_t;
+ PROCEDURE [ccall] read* (fildes: int; buf: C99types.Pvoid; nbyte: size_t): ssize_t;
+ PROCEDURE [ccall] readlink* (IN path: ARRAY [untagged] OF SHORTCHAR; VAR buf: ARRAY [untagged] OF SHORTCHAR; bufsize: size_t): ssize_t;
+ PROCEDURE [ccall] readlinkat* (fd: int; IN path: ARRAY [untagged] OF SHORTCHAR; VAR buf: ARRAY [untagged] OF SHORTCHAR; bufsize: size_t): ssize_t;
+ PROCEDURE [ccall] rmdir* (IN path: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] setegid* (gid: gid_t): int;
+ PROCEDURE [ccall] seteuid* (uid: uid_t): int;
+ PROCEDURE [ccall] setgid* (gid: gid_t): int;
+ PROCEDURE [ccall] setpgid* (pid, pgid: pid_t): int;
+ PROCEDURE [ccall] setpgrp* (): pid_t;
+ PROCEDURE [ccall] setregid* (rgid, egid: pid_t): int;
+ PROCEDURE [ccall] setreuid* (ruid, euid: uid_t): int;
+ PROCEDURE [ccall] setsid* (): pid_t;
+ PROCEDURE [ccall] setuid* (uid: uid_t): int;
+ PROCEDURE [ccall] sleep* (seconds: unsigned): unsigned;
+ PROCEDURE [ccall] swab* (from, to: C99types.Pvoid; n: ssize_t);
+ PROCEDURE [ccall] symlink* (IN path1, path2: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] symlinkat* (IN path1: ARRAY [untagged] OF SHORTCHAR; fd: int; IN path2: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] sync* ;
+ PROCEDURE [ccall] sysconf* (name: int): long;
+ PROCEDURE [ccall] tcgetpgrp* (fd: int): pid_t;
+ PROCEDURE [ccall] tcsetpgrp* (fd: int; pgrp: pid_t): int;
+ PROCEDURE [ccall] truncate* (IN path: ARRAY [untagged] OF SHORTCHAR; length: off_t): int;
+ PROCEDURE [ccall] ttyname* (fd: int): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] ttyname_r* (fd: int; VAR buf: ARRAY [untagged] OF SHORTCHAR; buflen: size_t): int;
+ PROCEDURE [ccall] unlink* (IN path: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] unlinkat* (fd: int; IN path: ARRAY [untagged] OF SHORTCHAR; flag: int): int;
+ PROCEDURE [ccall] write* (fildes: int; buf: C99types.Pvoid; nbyte: size_t): int;
+
+END C99unistd.
diff --git a/src/cpfront/linux/C99/Mod/wctype.cp b/src/cpfront/linux/C99/Mod/wctype.cp
--- /dev/null
@@ -0,0 +1,58 @@
+MODULE C99wctype ['wctype.h'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types, C99locale;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ TYPE
+ wint_t* = INTEGER;
+ wctype_t* = INTEGER;
+
+ TYPE
+ wctrans_t* = INTEGER;
+
+ TYPE
+ locale_t* = C99locale.locale_t;
+
+ CONST
+ WEOF* = -1;
+
+ PROCEDURE [ccall] iswalpha* (wc: wint_t): int;
+ PROCEDURE [ccall] iswdigit* (wc: wint_t): int;
+ PROCEDURE [ccall] iswlower* (wc: wint_t): int;
+ PROCEDURE [ccall] iswupper* (wc: wint_t): int;
+ PROCEDURE [ccall] towlower* (wc: wint_t): wint_t;
+ PROCEDURE [ccall] towupper* (wc: wint_t): wint_t;
+
+END C99wctype.
diff --git a/src/cpfront/posix/System/Mod/Kernel.cp b/src/cpfront/posix/System/Mod/Kernel.cp
--- /dev/null
@@ -0,0 +1,1698 @@
+MODULE Kernel;
+
+ IMPORT S := SYSTEM, stdlib := C99stdlib, stdio := C99stdio,
+ time := C99time, wctype := C99wctype, sysmman := C99sys_mman,
+ dlfcn := C99dlfcn, fcntl := C99fcntl, types := C99types,
+ unistd := C99unistd, signal := C99signal, setjmp := C99setjmp;
+
+ (* init fpu? *)
+ (* add signal blocking to avoid race conditions in Try/Trap/TrapHandler *)
+ (* add BeepHook for Beep *)
+ (* implement Call using libffi *)
+
+ CONST
+ nameLen* = 256;
+
+ littleEndian* = TRUE;
+ timeResolution* = 1000; (* ticks per second *)
+
+ processor* = 1; (* generic c *)
+
+ objType* = "ocf"; (* file types *)
+ symType* = "osf";
+ docType* = "odc";
+
+ (* loader constants *)
+ done* = 0;
+ fileNotFound* = 1;
+ syntaxError* = 2;
+ objNotFound* = 3;
+ illegalFPrint* = 4;
+ cyclicImport* = 5;
+ noMem* = 6;
+ commNotFound* = 7;
+ commSyntaxError* = 8;
+ moduleNotFound* = 9;
+
+ any = 1000000;
+
+ strictStackSweep = FALSE;
+ N = 128 DIV 16; (* free lists *)
+
+ (* kernel flags in module desc *)
+ init = 16; dyn = 17; dll = 24; iptrs = 30;
+
+ (* meta interface consts *)
+ mConst = 1; mTyp = 2; mVar = 3; mProc = 4; mField = 5;
+
+ TYPE
+ Name* = ARRAY nameLen OF CHAR;
+ Utf8Name* = ARRAY nameLen OF SHORTCHAR;
+ Command* = PROCEDURE;
+
+ Module* = POINTER TO RECORD [untagged]
+ next-: Module;
+ opts-: SET; (* 0..15: compiler opts, 16..31: kernel flags *)
+ refcnt-: INTEGER; (* <0: module invalidated *)
+ compTime-, loadTime-: ARRAY 6 OF SHORTINT;
+ ext-: INTEGER; (* currently not used *)
+ term-: Command; (* terminator *)
+ nofimps-, nofptrs-: INTEGER;
+ csize-, dsize-, rsize-: INTEGER;
+ code-, data-, refs-: INTEGER;
+ procBase-, varBase-: INTEGER; (* meta base addresses *)
+ names-: POINTER TO ARRAY [untagged] OF SHORTCHAR; (* names[0] = 0X *)
+ ptrs-: POINTER TO ARRAY [untagged] OF INTEGER;
+ imports-: POINTER TO ARRAY [untagged] OF Module;
+ export-: Directory; (* exported objects (name sorted) *)
+ name-: Utf8Name
+ END;
+
+ Type* = POINTER TO RECORD [untagged]
+ (* record: ptr to method n at offset - 4 * (n+1) *)
+ size-: INTEGER; (* record: size, array: #elem, dyn array: 0, proc: sigfp *)
+ mod-: Module;
+ id-: INTEGER; (* name idx * 256 + lev * 16 + attr * 4 + form *)
+ base-: ARRAY 16 OF Type; (* signature if form = ProcTyp *)
+ fields-: Directory; (* new fields (declaration order) *)
+ ptroffs-: ARRAY any OF INTEGER (* array of any length *)
+ END;
+
+ Object* = POINTER TO ObjDesc;
+
+ ObjDesc* = RECORD [untagged]
+ fprint-: INTEGER;
+ offs-: INTEGER; (* pvfprint for record types *)
+ id-: INTEGER; (* name idx * 256 + vis * 16 + mode *)
+ struct-: Type (* id of basic type or pointer to typedesc/signature *)
+ END;
+
+ Directory* = POINTER TO RECORD [untagged]
+ num-: INTEGER; (* number of entries *)
+ obj-: ARRAY any OF ObjDesc (* array of any length *)
+ END;
+
+ Signature* = POINTER TO RECORD [untagged]
+ retStruct-: Type; (* id of basic type or pointer to typedesc or 0 *)
+ num-: INTEGER; (* number of parameters *)
+ par-: ARRAY any OF RECORD [untagged] (* parameters *)
+ id-: INTEGER; (* name idx * 256 + kind *)
+ struct-: Type (* id of basic type or pointer to typedesc *)
+ END
+ END;
+
+ Handler* = PROCEDURE;
+
+ Reducer* = POINTER TO ABSTRACT RECORD
+ next: Reducer
+ END;
+
+ Identifier* = ABSTRACT RECORD
+ typ*: INTEGER;
+ obj-: ANYPTR
+ END;
+
+ TrapCleaner* = POINTER TO ABSTRACT RECORD
+ next: TrapCleaner
+ END;
+
+ TryHandler* = PROCEDURE (a, b, c: INTEGER);
+
+ (* meta extension suport *)
+
+ ItemExt* = POINTER TO ABSTRACT RECORD END;
+
+ ItemAttr* = RECORD
+ obj*, vis*, typ*, adr*: INTEGER;
+ mod*: Module;
+ desc*: Type;
+ ptr*: S.PTR;
+ ext*: ItemExt
+ END;
+
+ Hook* = POINTER TO ABSTRACT RECORD END;
+
+ LoaderHook* = POINTER TO ABSTRACT RECORD (Hook)
+ res*: INTEGER;
+ importing*, imported*, object*: ARRAY 256 OF CHAR
+ END;
+
+ Block = POINTER TO RECORD [untagged]
+ tag: Type;
+ last: INTEGER; (* arrays: last element *)
+ actual: INTEGER; (* arrays: used during mark phase *)
+ first: INTEGER (* arrays: first element *)
+ END;
+
+ FreeBlock = POINTER TO FreeDesc;
+
+ FreeDesc = RECORD [untagged]
+ tag: Type; (* f.tag = ADR(f.size) *)
+ size: INTEGER;
+ next: FreeBlock
+ END;
+
+ Cluster = POINTER TO RECORD [untagged]
+ size: INTEGER; (* total size *)
+ next: Cluster;
+ max: INTEGER (* exe: reserved size, dll: original address *)
+ (* start of first block *)
+ END;
+
+ FList = POINTER TO RECORD
+ next: FList;
+ blk: Block;
+ iptr, aiptr: BOOLEAN
+ END;
+
+ CList = POINTER TO RECORD
+ next: CList;
+ do: Command;
+ trapped: BOOLEAN
+ END;
+
+
+ PtrType = RECORD v: S.PTR END; (* used for array of pointer *)
+ Char8Type = RECORD v: SHORTCHAR END;
+ Char16Type = RECORD v: CHAR END;
+ Int8Type = RECORD v: BYTE END;
+ Int16Type = RECORD v: SHORTINT END;
+ Int32Type = RECORD v: INTEGER END;
+ Int64Type = RECORD v: LONGINT END;
+ BoolType = RECORD v: BOOLEAN END;
+ SetType = RECORD v: SET END;
+ Real32Type = RECORD v: SHORTREAL END;
+ Real64Type = RECORD v: REAL END;
+ ProcType = RECORD v: PROCEDURE END;
+ UPtrType = RECORD v: INTEGER END;
+ StrPtr = POINTER TO ARRAY [untagged] OF SHORTCHAR;
+
+ (* SYSTEM.h -> SYSTEM_DLINK *)
+ DLink = POINTER TO RECORD [untagged]
+ next: DLink;
+ name: StrPtr
+ END;
+ ArrStrPtr = POINTER TO ARRAY [untagged] OF StrPtr;
+
+ ADDRESS* = types.Pvoid;
+
+ VAR
+ baseStack: INTEGER;
+ root: Cluster;
+ modList-: Module;
+ trapCount-: INTEGER;
+ err-, pc-, sp-, fp-, stack-, val-: INTEGER;
+
+ isTry: BOOLEAN;
+ startEnv: setjmp.sigjmp_buf;
+ tryEnv: setjmp.jmp_buf;
+ startDLink, tryDLink: DLink;
+
+ argc-: INTEGER;
+ argv-: ArrStrPtr;
+ pagesize: unistd.long;
+
+ free: ARRAY N OF FreeBlock; (* free list *)
+ sentinelBlock: FreeDesc;
+ sentinel: FreeBlock;
+ candidates: ARRAY 1024 OF INTEGER;
+ nofcand: INTEGER;
+ allocated: INTEGER; (* bytes allocated on BlackBox heap *)
+ total: INTEGER; (* current total size of BlackBox heap *)
+ used: INTEGER; (* bytes allocated on system heap *)
+ finalizers: FList;
+ hotFinalizers: FList;
+ cleaners: CList;
+ reducers: Reducer;
+ trapStack: TrapCleaner;
+ actual: Module; (* valid during module initialization *)
+
+ trapViewer, trapChecker: Handler;
+ trapped, guarded, secondTrap: BOOLEAN;
+ interrupted: BOOLEAN;
+ static, inDll, terminating: BOOLEAN;
+ restart: Command;
+
+ loader: LoaderHook;
+ loadres: INTEGER;
+
+ wouldFinalize: BOOLEAN;
+
+ watcher*: PROCEDURE (event: INTEGER); (* for debugging *)
+
+ PROCEDURE Erase (adr, words: INTEGER);
+ BEGIN
+ ASSERT(words >= 0, 20);
+ WHILE words > 0 DO
+ S.PUT(adr, 0);
+ INC(adr, 4);
+ DEC(words)
+ END
+ END Erase;
+
+
+ PROCEDURE (VAR id: Identifier) Identified* (): BOOLEAN, NEW, ABSTRACT;
+ PROCEDURE (r: Reducer) Reduce* (full: BOOLEAN), NEW, ABSTRACT;
+ PROCEDURE (c: TrapCleaner) Cleanup*, NEW, EMPTY;
+
+ (* meta extension suport *)
+
+ PROCEDURE (e: ItemExt) Lookup* (name: ARRAY OF CHAR; VAR i: ANYREC), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) Index* (index: INTEGER; VAR elem: ANYREC), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) Deref* (VAR ref: ANYREC), NEW, ABSTRACT;
+
+ PROCEDURE (e: ItemExt) Valid* (): BOOLEAN, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) Size* (): INTEGER, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) BaseTyp* (): INTEGER, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) Len* (): INTEGER, NEW, ABSTRACT;
+
+ PROCEDURE (e: ItemExt) Call* (OUT ok: BOOLEAN), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) BoolVal* (): BOOLEAN, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutBoolVal* (x: BOOLEAN), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) CharVal* (): CHAR, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutCharVal* (x: CHAR), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) IntVal* (): INTEGER, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutIntVal* (x: INTEGER), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) LongVal* (): LONGINT, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutLongVal* (x: LONGINT), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) RealVal* (): REAL, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutRealVal* (x: REAL), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) SetVal* (): SET, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutSetVal* (x: SET), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PtrVal* (): ANYPTR, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutPtrVal* (x: ANYPTR), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) GetSStringVal* (OUT x: ARRAY OF SHORTCHAR;
+ OUT ok: BOOLEAN), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutSStringVal* (IN x: ARRAY OF SHORTCHAR;
+ OUT ok: BOOLEAN), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) GetStringVal* (OUT x: ARRAY OF CHAR; OUT ok: BOOLEAN), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutStringVal* (IN x: ARRAY OF CHAR; OUT ok: BOOLEAN), NEW, ABSTRACT;
+
+ (* -------------------- miscellaneous tools -------------------- *)
+
+ PROCEDURE IsUpper* (ch: CHAR): BOOLEAN;
+ BEGIN
+ RETURN wctype.iswupper(ORD(ch)) # 0
+ END IsUpper;
+
+ PROCEDURE Upper* (ch: CHAR): CHAR;
+ BEGIN
+ RETURN CHR(wctype.towupper(ORD(ch)))
+ END Upper;
+
+ PROCEDURE IsLower* (ch: CHAR): BOOLEAN;
+ BEGIN
+ RETURN wctype.iswlower(ORD(ch)) # 0
+ END IsLower;
+
+ PROCEDURE Lower* (ch: CHAR): CHAR;
+ BEGIN
+ RETURN CHR(wctype.towlower(ORD(ch)))
+ END Lower;
+
+ PROCEDURE IsAlpha* (ch: CHAR): BOOLEAN;
+ BEGIN
+ RETURN wctype.iswalpha(ORD(ch)) # 0
+ END IsAlpha;
+
+ PROCEDURE Utf8ToString* (IN in: ARRAY OF SHORTCHAR; OUT out: ARRAY OF CHAR; OUT res: INTEGER);
+ VAR i, j, val, max: INTEGER; ch: SHORTCHAR;
+
+ PROCEDURE FormatError();
+ BEGIN out := in$; res := 2 (*format error*)
+ END FormatError;
+
+ BEGIN
+ ch := in[0]; i := 1; j := 0; max := LEN(out) - 1;
+ WHILE (ch # 0X) & (j < max) DO
+ IF ch < 80X THEN
+ out[j] := ch; INC(j)
+ ELSIF ch < 0E0X THEN
+ val := ORD(ch) - 192;
+ IF val < 0 THEN FormatError; RETURN END ;
+ ch := in[i]; INC(i); val := val * 64 + ORD(ch) - 128;
+ IF (ch < 80X) OR (ch >= 0E0X) THEN FormatError; RETURN END ;
+ out[j] := CHR(val); INC(j)
+ ELSIF ch < 0F0X THEN
+ val := ORD(ch) - 224;
+ ch := in[i]; INC(i); val := val * 64 + ORD(ch) - 128;
+ IF (ch < 80X) OR (ch >= 0E0X) THEN FormatError; RETURN END ;
+ ch := in[i]; INC(i); val := val * 64 + ORD(ch) - 128;
+ IF (ch < 80X) OR (ch >= 0E0X) THEN FormatError; RETURN END ;
+ out[j] := CHR(val); INC(j)
+ ELSE
+ FormatError; RETURN
+ END ;
+ ch := in[i]; INC(i)
+ END;
+ out[j] := 0X;
+ IF ch = 0X THEN res := 0 (*ok*) ELSE res := 1 (*truncated*) END
+ END Utf8ToString;
+
+ PROCEDURE StringToUtf8* (IN in: ARRAY OF CHAR; OUT out: ARRAY OF SHORTCHAR; OUT res: INTEGER);
+ VAR i, j, val, max: INTEGER;
+ BEGIN
+ i := 0; j := 0; max := LEN(out) - 3;
+ WHILE (in[i] # 0X) & (j < max) DO
+ val := ORD(in[i]); INC(i);
+ IF val < 128 THEN
+ out[j] := SHORT(CHR(val)); INC(j)
+ ELSIF val < 2048 THEN
+ out[j] := SHORT(CHR(val DIV 64 + 192)); INC(j);
+ out[j] := SHORT(CHR(val MOD 64 + 128)); INC(j)
+ ELSE
+ out[j] := SHORT(CHR(val DIV 4096 + 224)); INC(j);
+ out[j] := SHORT(CHR(val DIV 64 MOD 64 + 128)); INC(j);
+ out[j] := SHORT(CHR(val MOD 64 + 128)); INC(j)
+ END;
+ END;
+ out[j] := 0X;
+ IF in[i] = 0X THEN res := 0 (*ok*) ELSE res := 1 (*truncated*) END
+ END StringToUtf8;
+
+ PROCEDURE SplitName* (name: ARRAY OF CHAR; VAR head, tail: ARRAY OF CHAR);
+ (* portable *)
+ VAR i, j: INTEGER; ch, lch: CHAR;
+ BEGIN
+ i := 0; ch := name[0];
+ IF ch # 0X THEN
+ REPEAT
+ head[i] := ch; lch := ch; INC(i); ch := name[i]
+ UNTIL (ch = 0X) OR (ch = ".") OR IsUpper(ch) & ~IsUpper(lch);
+ IF ch = "." THEN i := 0; ch := name[0] END;
+ head[i] := 0X; j := 0;
+ WHILE ch # 0X DO tail[j] := ch; INC(i); INC(j); ch := name[i] END;
+ tail[j] := 0X;
+ IF tail = "" THEN tail := head$; head := "" END
+ ELSE head := ""; tail := ""
+ END
+ END SplitName;
+
+ PROCEDURE MakeFileName* (VAR name: ARRAY OF CHAR; type: ARRAY OF CHAR);
+ VAR i, j: INTEGER; ext: ARRAY 8 OF CHAR; ch: CHAR;
+ BEGIN
+ i := 0;
+ WHILE (name[i] # 0X) & (name[i] # ".") DO INC(i) END;
+ IF name[i] = "." THEN
+ IF name[i + 1] = 0X THEN name[i] := 0X END
+ ELSE
+ IF type = "" THEN ext := docType ELSE ext := type$ END;
+ IF i < LEN(name) - LEN(ext$) - 1 THEN
+ name[i] := "."; INC(i); j := 0; ch := ext[0];
+ WHILE ch # 0X DO
+ name[i] := Lower(ch); INC(i); INC(j); ch := ext[j]
+ END;
+ name[i] := 0X
+ END
+ END
+ END MakeFileName;
+
+ PROCEDURE Time* (): LONGINT;
+ VAR res: time.int; tp: time.struct_timespec;
+ BEGIN
+ ASSERT(timeResolution >= 1);
+ ASSERT(timeResolution <= 1000000000);
+ res := time.clock_gettime(time.CLOCK_MONOTONIC, tp);
+ ASSERT(res = 0, 100);
+ RETURN tp.tv_sec * LONG(timeResolution) + tp.tv_nsec DIV LONG(1000000000 DIV timeResolution)
+ END Time;
+
+ PROCEDURE Beep*;
+ (* !!! *)
+ END Beep;
+
+ PROCEDURE SearchProcVar* (var: INTEGER; VAR m: Module; VAR adr: INTEGER);
+ BEGIN
+ adr := var; m := NIL;
+ IF var # 0 THEN
+ m := modList;
+ WHILE (m # NIL) & ((var < m.code) OR (var >= m.code + m.csize)) DO m := m.next END;
+ IF m # NIL THEN DEC(adr, m.code) END
+ END
+ END SearchProcVar;
+
+ (* -------------------- system memory management --------------------- *)
+
+ PROCEDURE AllocMem (size: sysmman.size_t; VAR max: sysmman.size_t): ADDRESS;
+ VAR fd, flags, res: fcntl.int; ptr: ADDRESS;
+ BEGIN
+ max := (size + pagesize - 1) DIV pagesize * pagesize;
+ fd := fcntl.open("/dev/zero", fcntl.O_RDWR, 0);
+ IF fd # -1 THEN
+ flags := sysmman.PROT_READ + sysmman.PROT_WRITE;
+ ptr := sysmman.mmap(0, max, flags, sysmman.MAP_PRIVATE, fd, 0);
+ IF ptr = sysmman.MAP_FAILED THEN ptr := 0 END;
+ res := unistd.close(fd);
+ ASSERT(res = 0, 100)
+ ELSE
+ ptr := 0
+ END;
+ RETURN ptr
+ END AllocMem;
+
+ PROCEDURE FreeMem (adr: ADDRESS; size: sysmman.size_t);
+ VAR res: sysmman.int;
+ BEGIN
+ size := (size + pagesize - 1) DIV pagesize * pagesize;
+ res := sysmman.munmap(adr, size);
+ ASSERT(res = 0, 100)
+ END FreeMem;
+
+ PROCEDURE AllocHeapMem (size: INTEGER; VAR c: Cluster);
+ CONST N = 65536; (* cluster size for dll *)
+ VAR adr, allocated: INTEGER;
+ BEGIN
+ INC(size, 16);
+ ASSERT(size > 0, 100); adr := 0;
+ IF size < N THEN adr := stdlib.malloc(N) END;
+ IF adr = 0 THEN adr := stdlib.malloc(size); allocated := size ELSE allocated := N END;
+ IF adr = 0 THEN c := NIL
+ ELSE
+ c := S.VAL(Cluster, (adr + 15) DIV 16 * 16); c.max := adr;
+ c.size := allocated - (S.VAL(INTEGER, c) - adr);
+ INC(used, c.size); INC(total, c.size)
+ END;
+ ASSERT((adr = 0) OR (adr MOD 16 = 0) & (c.size >= size), 101);
+ (* post: (c = NIL) OR (c MOD 16 = 0) & (c.size >= size) *)
+ END AllocHeapMem;
+
+ PROCEDURE FreeHeapMem (c: Cluster);
+ BEGIN
+ DEC(used, c.size); DEC(total, c.size);
+ stdlib.free(S.VAL(ADDRESS, c.max))
+ END FreeHeapMem;
+
+ PROCEDURE HeapFull (size: INTEGER): BOOLEAN;
+ BEGIN
+ RETURN TRUE
+ END HeapFull;
+
+ PROCEDURE AllocModMem* (descSize, modSize: INTEGER; VAR descAdr, modAdr: INTEGER);
+ BEGIN
+ descAdr := 0; modAdr := 0;
+ descAdr := AllocMem(descSize, descSize);
+ IF descAdr # 0 THEN
+ modAdr := AllocMem(modSize, modSize);
+ IF modAdr = 0 THEN
+ FreeMem(descAdr, descSize)
+ ELSE
+ INC(used, descSize + modSize)
+ END
+ END
+ END AllocModMem;
+
+ PROCEDURE DeallocModMem* (descSize, modSize, descAdr, modAdr: INTEGER);
+ BEGIN
+ FreeMem(descAdr, descSize);
+ FreeMem(modAdr, modSize);
+ DEC(used, descSize + modSize)
+ END DeallocModMem;
+
+ PROCEDURE InvalModMem (modSize, modAdr: INTEGER);
+ BEGIN
+ FreeMem(modAdr, modSize)
+ END InvalModMem;
+
+ PROCEDURE TryRead (from, to, c: INTEGER);
+ VAR i: INTEGER; x: BYTE;
+ BEGIN
+ IF from <= to THEN
+ FOR i := from TO to DO
+ S.GET(i, x)
+ END
+ ELSE
+ FOR i := to TO from BY -1 DO
+ S.GET(i, x)
+ END
+ END;
+ END TryRead;
+
+ PROCEDURE^ Try* (h: TryHandler; a, b, c: INTEGER);
+
+ PROCEDURE IsReadable* (from, to: INTEGER): BOOLEAN;
+ VAR i: INTEGER;
+ BEGIN
+ i := trapCount;
+ Try(TryRead, from, to, 0);
+ RETURN trapCount = i
+ END IsReadable;
+
+ (* --------------------- NEW implementation (portable) -------------------- *)
+
+ PROCEDURE^ NewBlock (size: INTEGER): Block;
+
+ PROCEDURE NewRec* (typ: INTEGER): INTEGER; (* implementation of NEW(ptr) *)
+ VAR size, adr: INTEGER; b: Block; tag: Type; l: FList;
+ BEGIN
+ IF ~ODD(typ) THEN
+ tag := S.VAL(Type, typ);
+ b := NewBlock(tag.size);
+ IF b # NIL THEN
+ b.tag := tag;
+ S.GET(typ - 4, size);
+ IF size # 0 THEN (* record uses a finalizer *)
+ l := S.VAL(FList, S.ADR(b.last)); (* anchor new object! *)
+ l := S.VAL(FList, NewRec(S.TYP(FList))); (* NEW(l) *)
+ l.blk := b; l.next := finalizers; finalizers := l
+ END;
+ adr := S.ADR(b.last)
+ ELSE
+ adr := 0
+ END
+ ELSE
+ HALT(100) (* COM interface pointers not supported *)
+ END;
+ RETURN adr
+ END NewRec;
+
+ PROCEDURE NewArr* (eltyp, nofelem, nofdim: INTEGER): INTEGER; (* impl. of NEW(ptr, dim0, dim1, ...) *)
+ VAR b: Block; size, headSize: INTEGER; t: Type;
+ BEGIN
+ CASE eltyp OF
+ | -1: HALT(100) (* COM interface pointers not supported *)
+ | 0: eltyp := S.ADR(PtrType)
+ | 1: eltyp := S.ADR(Char8Type)
+ | 2: eltyp := S.ADR(Int16Type)
+ | 3: eltyp := S.ADR(Int8Type)
+ | 4: eltyp := S.ADR(Int32Type)
+ | 5: eltyp := S.ADR(BoolType)
+ | 6: eltyp := S.ADR(SetType)
+ | 7: eltyp := S.ADR(Real32Type)
+ | 8: eltyp := S.ADR(Real64Type)
+ | 9: eltyp := S.ADR(Char16Type)
+ | 10: eltyp := S.ADR(Int64Type)
+ | 11: eltyp := S.ADR(ProcType)
+ | 12: HALT(101) (* COM interface pointers not supported *)
+ ELSE
+ ASSERT(~ODD(eltyp), 102) (* COM interface pointers not supported *)
+ END;
+ t := S.VAL(Type, eltyp);
+ headSize := 4 * nofdim + 12;
+ size := headSize + nofelem * t.size;
+ b := NewBlock(size);
+ IF b # NIL THEN
+ b.tag := S.VAL(Type, eltyp + 2); (* tag + array mark *)
+ b.last := S.ADR(b.last) + size - t.size; (* pointer to last elem *)
+ b.first := S.ADR(b.last) + headSize; (* pointer to first elem *)
+ RETURN S.ADR(b.last)
+ ELSE
+ RETURN 0
+ END;
+ END NewArr;
+
+ (* -------------------- handler installation (portable) --------------------- *)
+
+ PROCEDURE ThisFinObj* (VAR id: Identifier): ANYPTR;
+ VAR l: FList;
+ BEGIN
+ ASSERT(id.typ # 0, 100);
+ l := finalizers;
+ WHILE l # NIL DO
+ IF S.VAL(INTEGER, l.blk.tag) = id.typ THEN
+ id.obj := S.VAL(ANYPTR, S.ADR(l.blk.last));
+ IF id.Identified() THEN RETURN id.obj END
+ END;
+ l := l.next
+ END;
+ RETURN NIL
+ END ThisFinObj;
+
+ PROCEDURE InstallReducer* (r: Reducer);
+ BEGIN
+ r.next := reducers; reducers := r
+ END InstallReducer;
+
+ PROCEDURE InstallTrapViewer* (h: Handler);
+ BEGIN
+ trapViewer := h
+ END InstallTrapViewer;
+
+ PROCEDURE InstallTrapChecker* (h: Handler);
+ BEGIN
+ trapChecker := h
+ END InstallTrapChecker;
+
+ PROCEDURE PushTrapCleaner* (c: TrapCleaner);
+ VAR t: TrapCleaner;
+ BEGIN
+ t := trapStack; WHILE (t # NIL) & (t # c) DO t := t.next END;
+ ASSERT(t = NIL, 20);
+ c.next := trapStack; trapStack := c
+ END PushTrapCleaner;
+
+ PROCEDURE PopTrapCleaner* (c: TrapCleaner);
+ VAR t: TrapCleaner;
+ BEGIN
+ t := NIL;
+ WHILE (trapStack # NIL) & (t # c) DO
+ t := trapStack; trapStack := trapStack.next
+ END
+ END PopTrapCleaner;
+
+ PROCEDURE InstallCleaner* (p: Command);
+ VAR c: CList;
+ BEGIN
+ c := S.VAL(CList, NewRec(S.TYP(CList))); (* NEW(c) *)
+ c.do := p; c.trapped := FALSE; c.next := cleaners; cleaners := c
+ END InstallCleaner;
+
+ PROCEDURE RemoveCleaner* (p: Command);
+ VAR c0, c: CList;
+ BEGIN
+ c := cleaners; c0 := NIL;
+ WHILE (c # NIL) & (c.do # p) DO c0 := c; c := c.next END;
+ IF c # NIL THEN
+ IF c0 = NIL THEN cleaners := cleaners.next ELSE c0.next := c.next END
+ END
+ END RemoveCleaner;
+
+ PROCEDURE Cleanup*;
+ VAR c, c0: CList;
+ BEGIN
+ c := cleaners; c0 := NIL;
+ WHILE c # NIL DO
+ IF ~c.trapped THEN
+ c.trapped := TRUE; c.do; c.trapped := FALSE; c0 := c
+ ELSE
+ IF c0 = NIL THEN cleaners := cleaners.next
+ ELSE c0.next := c.next
+ END
+ END;
+ c := c.next
+ END
+ END Cleanup;
+
+ (* -------------------- meta information (portable) --------------------- *)
+
+ PROCEDURE (h: LoaderHook) ThisMod* (IN name: ARRAY OF CHAR): Module, NEW, ABSTRACT;
+
+ PROCEDURE SetLoaderHook*(h: LoaderHook);
+ BEGIN
+ loader := h
+ END SetLoaderHook;
+
+ PROCEDURE InitModule (mod: Module); (* initialize linked modules *)
+ VAR body: Command;
+ BEGIN
+ IF ~(dyn IN mod.opts) & (mod.next # NIL) & ~(init IN mod.next.opts) THEN InitModule(mod.next) END;
+ IF ~(init IN mod.opts) THEN
+ body := S.VAL(Command, mod.code);
+ INCL(mod.opts, init);
+ actual := mod;
+ body(); actual := NIL
+ END
+ END InitModule;
+
+ PROCEDURE ThisLoadedMod* (IN name: ARRAY OF CHAR): Module; (* loaded modules only *)
+ VAR m: Module; res: INTEGER; n: Utf8Name;
+ BEGIN
+ StringToUtf8(name, n, res); ASSERT(res = 0);
+ loadres := done;
+ m := modList;
+ WHILE (m # NIL) & ((m.name # n) OR (m.refcnt < 0)) DO m := m.next END;
+ IF (m # NIL) & ~(init IN m.opts) THEN InitModule(m) END;
+ IF m = NIL THEN loadres := moduleNotFound END;
+ RETURN m
+ END ThisLoadedMod;
+
+ PROCEDURE ThisMod* (IN name: ARRAY OF CHAR): Module;
+ BEGIN
+ IF loader # NIL THEN
+ loader.res := done;
+ RETURN loader.ThisMod(name)
+ ELSE
+ RETURN ThisLoadedMod(name)
+ END
+ END ThisMod;
+
+ PROCEDURE LoadMod* (IN name: ARRAY OF CHAR);
+ VAR m: Module;
+ BEGIN
+ m := ThisMod(name)
+ END LoadMod;
+
+ PROCEDURE GetLoaderResult* (OUT res: INTEGER; OUT importing, imported, object: ARRAY OF CHAR);
+ BEGIN
+ IF loader # NIL THEN
+ res := loader.res;
+ importing := loader.importing$;
+ imported := loader.imported$;
+ object := loader.object$
+ ELSE
+ res := loadres;
+ importing := "";
+ imported := "";
+ object := ""
+ END
+ END GetLoaderResult;
+
+ PROCEDURE ThisObject* (mod: Module; IN name: ARRAY OF CHAR): Object;
+ VAR l, r, m, res: INTEGER; p: StrPtr; n: Utf8Name;
+ BEGIN
+ StringToUtf8(name, n, res); ASSERT(res = 0);
+ l := 0; r := mod.export.num;
+ WHILE l < r DO (* binary search *)
+ m := (l + r) DIV 2;
+ p := S.VAL(StrPtr, S.ADR(mod.names[mod.export.obj[m].id DIV 256]));
+ IF p^ = n THEN RETURN S.VAL(Object, S.ADR(mod.export.obj[m])) END;
+ IF p^ < n THEN l := m + 1 ELSE r := m END
+ END;
+ RETURN NIL
+ END ThisObject;
+
+ PROCEDURE ThisDesc* (mod: Module; fprint: INTEGER): Object;
+ VAR i, n: INTEGER;
+ BEGIN
+ i := 0; n := mod.export.num;
+ WHILE (i < n) & (mod.export.obj[i].id DIV 256 = 0) DO
+ IF mod.export.obj[i].offs = fprint THEN RETURN S.VAL(Object, S.ADR(mod.export.obj[i])) END;
+ INC(i)
+ END;
+ RETURN NIL
+ END ThisDesc;
+
+ PROCEDURE ThisField* (rec: Type; IN name: ARRAY OF CHAR): Object;
+ VAR n, res: INTEGER; p: StrPtr; obj: Object; m: Module; nn: Utf8Name;
+ BEGIN
+ StringToUtf8(name, nn, res); ASSERT(res = 0);
+ m := rec.mod;
+ obj := S.VAL(Object, S.ADR(rec.fields.obj[0])); n := rec.fields.num;
+ WHILE n > 0 DO
+ p := S.VAL(StrPtr, S.ADR(m.names[obj.id DIV 256]));
+ IF p^ = nn THEN RETURN obj END;
+ DEC(n); INC(S.VAL(INTEGER, obj), 16)
+ END;
+ RETURN NIL
+ END ThisField;
+
+ PROCEDURE ThisCommand* (mod: Module; IN name: ARRAY OF CHAR): Command;
+ VAR x: Object; sig: Signature;
+ BEGIN
+ x := ThisObject(mod, name);
+ IF (x # NIL) & (x.id MOD 16 = mProc) THEN
+ sig := S.VAL(Signature, x.struct);
+ IF (sig.retStruct = NIL) & (sig.num = 0) THEN RETURN S.VAL(Command, mod.procBase + x.offs) END
+ END;
+ RETURN NIL
+ END ThisCommand;
+
+ PROCEDURE ThisType* (mod: Module; IN name: ARRAY OF CHAR): Type;
+ VAR x: Object;
+ BEGIN
+ x := ThisObject(mod, name);
+ IF (x # NIL) & (x.id MOD 16 = mTyp) & (S.VAL(INTEGER, x.struct) DIV 256 # 0) THEN
+ RETURN x.struct
+ ELSE
+ RETURN NIL
+ END
+ END ThisType;
+
+ PROCEDURE TypeOf* (IN rec: ANYREC): Type;
+ BEGIN
+ RETURN S.VAL(Type, S.TYP(rec))
+ END TypeOf;
+
+ PROCEDURE LevelOf* (t: Type): SHORTINT;
+ BEGIN
+ RETURN SHORT(t.id DIV 16 MOD 16)
+ END LevelOf;
+
+ PROCEDURE NewObj* (VAR o: S.PTR; t: Type);
+ VAR i: INTEGER;
+ BEGIN
+ IF t.size = -1 THEN o := NIL
+ ELSE
+ i := 0; WHILE t.ptroffs[i] >= 0 DO INC(i) END;
+ IF t.ptroffs[i+1] >= 0 THEN INC(S.VAL(INTEGER, t)) END; (* with interface pointers *)
+ o := S.VAL(S.PTR, NewRec(S.VAL(INTEGER, t))) (* generic NEW *)
+ END
+ END NewObj;
+
+ PROCEDURE GetModName* (mod: Module; OUT name: Name);
+ VAR res: INTEGER;
+ BEGIN
+ Utf8ToString(mod.name, name, res); ASSERT(res = 0)
+ END GetModName;
+
+ PROCEDURE GetObjName* (mod: Module; obj: Object; OUT name: Name);
+ VAR p: StrPtr; res: INTEGER;
+ BEGIN
+ p := S.VAL(StrPtr, S.ADR(mod.names[obj.id DIV 256]));
+ Utf8ToString(p^$, name, res); ASSERT(res = 0)
+ END GetObjName;
+
+ PROCEDURE GetTypeName* (t: Type; OUT name: Name);
+ VAR p: StrPtr; res: INTEGER;
+ BEGIN
+ p := S.VAL(StrPtr, S.ADR(t.mod.names[t.id DIV 256]));
+ Utf8ToString(p^$, name, res); ASSERT(res = 0)
+ END GetTypeName;
+
+ PROCEDURE RegisterMod* (mod: Module);
+ VAR i: INTEGER; epoch: time.time_t; tm: time.struct_tm; ptm: time.Pstruct_tm;
+ BEGIN
+ mod.next := modList; modList := mod; mod.refcnt := 0; INCL(mod.opts, dyn); i := 0;
+ WHILE i < mod.nofimps DO
+ IF mod.imports[i] # NIL THEN INC(mod.imports[i].refcnt) END;
+ INC(i)
+ END;
+ epoch := time.time(NIL);
+ ptm := time.localtime_r(epoch, tm);
+ IF ptm # NIL THEN
+ mod.loadTime[0] := SHORT(tm.tm_year + 1900);
+ mod.loadTime[1] := SHORT(tm.tm_mon + 1);
+ mod.loadTime[2] := SHORT(tm.tm_mday);
+ mod.loadTime[3] := SHORT(tm.tm_hour);
+ mod.loadTime[4] := SHORT(tm.tm_min);
+ mod.loadTime[5] := SHORT(tm.tm_sec)
+ ELSE
+ mod.loadTime[0] := 0;
+ mod.loadTime[1] := 0;
+ mod.loadTime[2] := 0;
+ mod.loadTime[3] := 0;
+ mod.loadTime[4] := 0;
+ mod.loadTime[5] := 0
+ END;
+ IF ~(init IN mod.opts) THEN InitModule(mod) END
+ END RegisterMod;
+
+ PROCEDURE^ Collect*;
+
+ PROCEDURE UnloadMod* (mod: Module);
+ VAR i: INTEGER; t: Command;
+ BEGIN
+ IF mod.refcnt = 0 THEN
+ t := mod.term; mod.term := NIL;
+ IF t # NIL THEN t() END; (* terminate module *)
+ i := 0;
+ WHILE i < mod.nofptrs DO (* release global pointers *)
+ S.PUT(mod.varBase + mod.ptrs[i], 0); INC(i)
+ END;
+ Collect; (* call finalizers *)
+ i := 0;
+ WHILE i < mod.nofimps DO (* release imported modules *)
+ IF mod.imports[i] # NIL THEN DEC(mod.imports[i].refcnt) END;
+ INC(i)
+ END;
+ mod.refcnt := -1;
+ IF dyn IN mod.opts THEN (* release memory *)
+ InvalModMem(mod.data + mod.dsize - mod.refs, mod.refs)
+ END
+ END
+ END UnloadMod;
+
+ (* -------------------- dynamic procedure call --------------------- *)
+
+ PROCEDURE Call* (adr: INTEGER; sig: Signature; IN par: ARRAY OF INTEGER; n: INTEGER): LONGINT;
+ BEGIN
+ HALT(126); (* !!! *)
+ RETURN 0
+ END Call;
+
+ (* -------------------- reference information (portable) --------------------- *)
+
+ PROCEDURE RefCh (VAR ref: INTEGER; OUT ch: SHORTCHAR);
+ BEGIN
+ S.GET(ref, ch); INC(ref)
+ END RefCh;
+
+ PROCEDURE RefNum (VAR ref: INTEGER; OUT x: INTEGER);
+ VAR s, n: INTEGER; ch: SHORTCHAR;
+ BEGIN
+ s := 0; n := 0; RefCh(ref, ch);
+ WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); RefCh(ref, ch) END;
+ x := n + ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s)
+ END RefNum;
+
+ PROCEDURE RefName (VAR ref: INTEGER; OUT n: Utf8Name);
+ VAR i: INTEGER; ch: SHORTCHAR;
+ BEGIN
+ i := 0; RefCh(ref, ch);
+ WHILE ch # 0X DO n[i] := ch; INC(i); RefCh(ref, ch) END;
+ n[i] := 0X
+ END RefName;
+
+ PROCEDURE GetRefProc* (VAR ref: INTEGER; OUT adr: INTEGER; OUT name: Utf8Name);
+ VAR ch: SHORTCHAR;
+ BEGIN
+ S.GET(ref, ch);
+ WHILE ch >= 0FDX DO (* skip variables *)
+ INC(ref); RefCh(ref, ch);
+ IF ch = 10X THEN INC(ref, 4) END;
+ RefNum(ref, adr); RefName(ref, name); S.GET(ref, ch)
+ END;
+ WHILE (ch > 0X) & (ch < 0FCX) DO (* skip source refs *)
+ INC(ref); RefNum(ref, adr); S.GET(ref, ch)
+ END;
+ IF ch = 0FCX THEN INC(ref); RefNum(ref, adr); RefName(ref, name)
+ ELSE adr := 0
+ END
+ END GetRefProc;
+
+ PROCEDURE GetRefVar* (VAR ref: INTEGER; OUT mode, form: SHORTCHAR; OUT desc: Type; OUT adr: INTEGER; OUT name: Utf8Name);
+ BEGIN
+ S.GET(ref, mode); desc := NIL;
+ IF mode >= 0FDX THEN
+ mode := SHORT(CHR(ORD(mode) - 0FCH));
+ INC(ref); RefCh(ref, form);
+ IF form = 10X THEN
+ S.GET(ref, desc); INC(ref, 4); form := SHORT(CHR(16 + desc.id MOD 4))
+ END;
+ RefNum(ref, adr); RefName(ref, name)
+ ELSE
+ mode := 0X; form := 0X; adr := 0
+ END
+ END GetRefVar;
+
+ PROCEDURE SourcePos* (mod: Module; codePos: INTEGER): INTEGER;
+ VAR ref, pos, ad, d: INTEGER; ch: SHORTCHAR; name: Utf8Name;
+ BEGIN
+ IF mod # NIL THEN (* mf, 12.02.04 *)
+ ref := mod.refs; pos := 0; ad := 0; S.GET(ref, ch);
+ WHILE ch # 0X DO
+ WHILE (ch > 0X) & (ch < 0FCX) DO (* srcref: {dAdr,dPos} *)
+ INC(ad, ORD(ch)); INC(ref); RefNum(ref, d);
+ IF ad > codePos THEN RETURN pos END;
+ INC(pos, d); S.GET(ref, ch)
+ END;
+ IF ch = 0FCX THEN (* proc: 0FCX,Adr,Name *)
+ INC(ref); RefNum(ref, d); RefName(ref, name); S.GET(ref, ch);
+ IF (d > codePos) & (pos > 0) THEN RETURN pos END
+ END;
+ WHILE ch >= 0FDX DO (* skip variables: Mode, Form, adr, Name *)
+ INC(ref); RefCh(ref, ch);
+ IF ch = 10X THEN INC(ref, 4) END;
+ RefNum(ref, d); RefName(ref, name); S.GET(ref, ch)
+ END
+ END;
+ END;
+ RETURN -1
+ END SourcePos;
+
+ PROCEDURE LoadDll* (IN name: ARRAY OF CHAR; VAR ok: BOOLEAN);
+ VAR h: ADDRESS; file: Utf8Name; res: INTEGER;
+ BEGIN
+ StringToUtf8(name, file, res);
+ IF res = 0 THEN
+ h := dlfcn.dlopen(file, dlfcn.RTLD_LAZY + dlfcn.RTLD_GLOBAL);
+ ok := h # 0
+ ELSE
+ ok := FALSE
+ END
+ END LoadDll;
+
+ PROCEDURE ThisDllObj* (mode, fprint: INTEGER; IN dll, name: ARRAY OF CHAR): INTEGER;
+ VAR h, p: ADDRESS; file, sym: Utf8Name; res: INTEGER; err: dlfcn.int;
+ BEGIN
+ StringToUtf8(dll, file, res);
+ IF res = 0 THEN
+ h := dlfcn.dlopen(file, dlfcn.RTLD_LAZY + dlfcn.RTLD_GLOBAL);
+ IF h # 0 THEN
+ StringToUtf8(name, sym, res);
+ IF res = 0 THEN
+ p := dlfcn.dlsym(h, sym)
+ ELSE
+ p := 0
+ END;
+ err := dlfcn.dlclose(h);
+ ASSERT(err = 0, 100)
+ ELSE
+ p := 0
+ END
+ ELSE
+ p := 0
+ END;
+ RETURN p
+ END ThisDllObj;
+
+ (* -------------------- garbage collector (portable) --------------------- *)
+
+ PROCEDURE Mark (this: Block);
+ VAR father, son: Block; tag: Type; flag, offset, actual: INTEGER;
+ BEGIN
+ IF ~ODD(S.VAL(INTEGER, this.tag)) THEN
+ father := NIL;
+ LOOP
+ INC(S.VAL(INTEGER, this.tag));
+ flag := S.VAL(INTEGER, this.tag) MOD 4;
+ tag := S.VAL(Type, S.VAL(INTEGER, this.tag) - flag);
+ IF flag >= 2 THEN actual := this.first; this.actual := actual
+ ELSE actual := S.ADR(this.last)
+ END;
+ LOOP
+ offset := tag.ptroffs[0];
+ IF offset < 0 THEN
+ INC(S.VAL(INTEGER, tag), offset + 4); (* restore tag *)
+ IF (flag >= 2) & (actual < this.last) & (offset < -4) THEN (* next array element *)
+ INC(actual, tag.size); this.actual := actual
+ ELSE (* up *)
+ this.tag := S.VAL(Type, S.VAL(INTEGER, tag) + flag);
+ IF father = NIL THEN RETURN END;
+ son := this; this := father;
+ flag := S.VAL(INTEGER, this.tag) MOD 4;
+ tag := S.VAL(Type, S.VAL(INTEGER, this.tag) - flag);
+ offset := tag.ptroffs[0];
+ IF flag >= 2 THEN actual := this.actual ELSE actual := S.ADR(this.last) END;
+ S.GET(actual + offset, father); S.PUT(actual + offset, S.ADR(son.last));
+ INC(S.VAL(INTEGER, tag), 4)
+ END
+ ELSE
+ S.GET(actual + offset, son);
+ IF son # NIL THEN
+ DEC(S.VAL(INTEGER, son), 4);
+ IF ~ODD(S.VAL(INTEGER, son.tag)) THEN (* down *)
+ this.tag := S.VAL(Type, S.VAL(INTEGER, tag) + flag);
+ S.PUT(actual + offset, father); father := this; this := son;
+ EXIT
+ END
+ END;
+ INC(S.VAL(INTEGER, tag), 4)
+ END
+ END
+ END
+ END
+ END Mark;
+
+ PROCEDURE MarkGlobals;
+ VAR m: Module; i, p: INTEGER;
+ BEGIN
+ m := modList;
+ WHILE m # NIL DO
+ IF m.refcnt >= 0 THEN
+ i := 0;
+ WHILE i < m.nofptrs DO
+ S.GET(m.varBase + m.ptrs[i], p); INC(i);
+ IF p # 0 THEN Mark(S.VAL(Block, p - 4)) END
+ END
+ END;
+ m := m.next
+ END
+ END MarkGlobals;
+
+ PROCEDURE Next (b: Block): Block; (* next block in same cluster *)
+ VAR size: INTEGER;
+ BEGIN
+ S.GET(S.VAL(INTEGER, b.tag) DIV 4 * 4, size);
+ IF ODD(S.VAL(INTEGER, b.tag) DIV 2) THEN INC(size, b.last - S.ADR(b.last)) END;
+ RETURN S.VAL(Block, S.VAL(INTEGER, b) + (size + 19) DIV 16 * 16)
+ END Next;
+
+ PROCEDURE CheckCandidates;
+ (* pre: nofcand > 0 *)
+ VAR i, j, h, p, end: INTEGER; c: Cluster; blk, next: Block;
+ BEGIN
+ (* sort candidates (shellsort) *)
+ h := 1; REPEAT h := h*3 + 1 UNTIL h > nofcand;
+ REPEAT h := h DIV 3; i := h;
+ WHILE i < nofcand DO p := candidates[i]; j := i;
+ WHILE (j >= h) & (candidates[j-h] > p) DO
+ candidates[j] := candidates[j-h]; j := j-h
+ END;
+ candidates[j] := p; INC(i)
+ END
+ UNTIL h = 1;
+ (* sweep *)
+ c := root; i := 0;
+ WHILE c # NIL DO
+ blk := S.VAL(Block, S.VAL(INTEGER, c) + 12);
+ end := S.VAL(INTEGER, blk) + (c.size - 12) DIV 16 * 16;
+ WHILE candidates[i] < S.VAL(INTEGER, blk) DO
+ INC(i);
+ IF i = nofcand THEN RETURN END
+ END;
+ WHILE S.VAL(INTEGER, blk) < end DO
+ next := Next(blk);
+ IF candidates[i] < S.VAL(INTEGER, next) THEN
+ IF (S.VAL(INTEGER, blk.tag) # S.ADR(blk.last)) (* not a free block *)
+ & (~strictStackSweep OR (candidates[i] = S.ADR(blk.last))) THEN
+ Mark(blk)
+ END;
+ REPEAT
+ INC(i);
+ IF i = nofcand THEN RETURN END
+ UNTIL candidates[i] >= S.VAL(INTEGER, next)
+ END;
+ IF (S.VAL(INTEGER, blk.tag) MOD 4 = 0) & (S.VAL(INTEGER, blk.tag) # S.ADR(blk.last))
+ & (blk.tag.base[0] = NIL) & (blk.actual > 0) THEN (* referenced interface record *)
+ Mark(blk)
+ END;
+ blk := next
+ END;
+ c := c.next
+ END
+ END CheckCandidates;
+
+ PROCEDURE MarkLocals;
+ VAR sp, p, min, max: INTEGER; c: Cluster;
+ BEGIN
+ sp := S.ADR(sp); nofcand := 0; c := root;
+ WHILE c.next # NIL DO c := c.next END;
+ min := S.VAL(INTEGER, root); max := S.VAL(INTEGER, c) + c.size;
+ WHILE sp < baseStack DO
+ S.GET(sp, p);
+ IF (p > min) & (p < max) & (~strictStackSweep OR (p MOD 16 = 0)) THEN
+ candidates[nofcand] := p; INC(nofcand);
+ IF nofcand = LEN(candidates) - 1 THEN CheckCandidates; nofcand := 0 END
+ END;
+ INC(sp, 4)
+ END;
+ candidates[nofcand] := max; INC(nofcand); (* ensure complete scan for interface mark*)
+ IF nofcand > 0 THEN CheckCandidates END
+ END MarkLocals;
+
+ PROCEDURE MarkFinObj;
+ VAR f: FList;
+ BEGIN
+ wouldFinalize := FALSE;
+ f := finalizers;
+ WHILE f # NIL DO
+ IF ~ODD(S.VAL(INTEGER, f.blk.tag)) THEN wouldFinalize := TRUE END;
+ Mark(f.blk);
+ f := f.next
+ END;
+ f := hotFinalizers;
+ WHILE f # NIL DO IF ~ODD(S.VAL(INTEGER, f.blk.tag)) THEN wouldFinalize := TRUE END;
+ Mark(f.blk);
+ f := f.next
+ END
+ END MarkFinObj;
+
+ PROCEDURE CheckFinalizers;
+ VAR f, g, h, k: FList;
+ BEGIN
+ f := finalizers; g := NIL;
+ IF hotFinalizers = NIL THEN k := NIL
+ ELSE
+ k := hotFinalizers;
+ WHILE k.next # NIL DO k := k.next END
+ END;
+ WHILE f # NIL DO
+ h := f; f := f.next;
+ IF ~ODD(S.VAL(INTEGER, h.blk.tag)) THEN
+ IF g = NIL THEN finalizers := f ELSE g.next := f END;
+ IF k = NIL THEN hotFinalizers := h ELSE k.next := h END;
+ k := h; h.next := NIL
+ ELSE g := h
+ END
+ END;
+ h := hotFinalizers;
+ WHILE h # NIL DO Mark(h.blk); h := h.next END
+ END CheckFinalizers;
+
+ PROCEDURE ExecFinalizer (a, b, c: INTEGER);
+ VAR f: FList; fin: PROCEDURE(this: ANYPTR);
+ BEGIN
+ f := S.VAL(FList, a);
+ S.GET(S.VAL(INTEGER, f.blk.tag) - 4, fin); (* method 0 *)
+ IF (fin # NIL) & (f.blk.tag.mod.refcnt >= 0) THEN fin(S.VAL(ANYPTR, S.ADR(f.blk.last))) END;
+ END ExecFinalizer;
+
+ PROCEDURE^ Try* (h: TryHandler; a, b, c: INTEGER); (* COMPILER DEPENDENT *)
+
+ PROCEDURE CallFinalizers;
+ VAR f: FList;
+ BEGIN
+ WHILE hotFinalizers # NIL DO
+ f := hotFinalizers; hotFinalizers := hotFinalizers.next;
+ Try(ExecFinalizer, S.VAL(INTEGER, f), 0, 0)
+ END;
+ wouldFinalize := FALSE
+ END CallFinalizers;
+
+ PROCEDURE Insert (blk: FreeBlock; size: INTEGER); (* insert block in free list *)
+ VAR i: INTEGER;
+ BEGIN
+ blk.size := size - 4; blk.tag := S.VAL(Type, S.ADR(blk.size));
+ i := MIN(N - 1, (blk.size DIV 16));
+ blk.next := free[i]; free[i] := blk
+ END Insert;
+
+ PROCEDURE Sweep (dealloc: BOOLEAN);
+ VAR cluster, last, c: Cluster; blk, next: Block; fblk, b, t: FreeBlock; end, i: INTEGER;
+ BEGIN
+ cluster := root; last := NIL; allocated := 0;
+ i := N;
+ REPEAT DEC(i); free[i] := sentinel UNTIL i = 0;
+ WHILE cluster # NIL DO
+ blk := S.VAL(Block, S.VAL(INTEGER, cluster) + 12);
+ end := S.VAL(INTEGER, blk) + (cluster.size - 12) DIV 16 * 16;
+ fblk := NIL;
+ WHILE S.VAL(INTEGER, blk) < end DO
+ next := Next(blk);
+ IF ODD(S.VAL(INTEGER, blk.tag)) THEN
+ IF fblk # NIL THEN
+ Insert(fblk, S.VAL(INTEGER, blk) - S.VAL(INTEGER, fblk));
+ fblk := NIL
+ END;
+ DEC(S.VAL(INTEGER, blk.tag)); (* unmark *)
+ INC(allocated, S.VAL(INTEGER, next) - S.VAL(INTEGER, blk))
+ ELSIF fblk = NIL THEN
+ fblk := S.VAL(FreeBlock, blk)
+ END;
+ blk := next
+ END;
+ IF dealloc & (S.VAL(INTEGER, fblk) = S.VAL(INTEGER, cluster) + 12) THEN (* deallocate cluster *)
+ c := cluster; cluster := cluster.next;
+ IF last = NIL THEN root := cluster ELSE last.next := cluster END;
+ FreeHeapMem(c)
+ ELSE
+ IF fblk # NIL THEN Insert(fblk, end - S.VAL(INTEGER, fblk)) END;
+ last := cluster; cluster := cluster.next
+ END
+ END;
+ (* reverse free list *)
+ i := N;
+ REPEAT
+ DEC(i);
+ b := free[i]; fblk := sentinel;
+ WHILE b # sentinel DO t := b; b := t.next; t.next := fblk; fblk := t END;
+ free[i] := fblk
+ UNTIL i = 0
+ END Sweep;
+
+ PROCEDURE Collect*;
+ BEGIN
+ IF root # NIL THEN
+ CallFinalizers; (* trap cleanup *)
+ MarkGlobals;
+ MarkLocals;
+ CheckFinalizers;
+ Sweep(TRUE);
+ CallFinalizers
+ END
+ END Collect;
+
+ PROCEDURE FastCollect*;
+ BEGIN
+ IF root # NIL THEN
+ MarkGlobals;
+ MarkLocals;
+ MarkFinObj;
+ Sweep(FALSE)
+ END
+ END FastCollect;
+
+ PROCEDURE WouldFinalize* (): BOOLEAN;
+ BEGIN
+ RETURN wouldFinalize
+ END WouldFinalize;
+
+ (* --------------------- memory allocation (portable) -------------------- *)
+
+ PROCEDURE OldBlock (size: INTEGER): FreeBlock; (* size MOD 16 = 0 *)
+ VAR b, l: FreeBlock; s, i: INTEGER;
+ BEGIN
+ s := size - 4;
+ i := MIN(N - 1, s DIV 16);
+ WHILE (i # N - 1) & (free[i] = sentinel) DO INC(i) END;
+ b := free[i]; l := NIL;
+ WHILE b.size < s DO l := b; b := b.next END;
+ IF b # sentinel THEN
+ IF l = NIL THEN free[i] := b.next ELSE l.next := b.next END
+ ELSE b := NIL
+ END;
+ RETURN b
+ END OldBlock;
+
+ PROCEDURE LastBlock (limit: INTEGER): FreeBlock; (* size MOD 16 = 0 *)
+ VAR b, l: FreeBlock; s, i: INTEGER;
+ BEGIN
+ s := limit - 4;
+ i := 0;
+ REPEAT
+ b := free[i]; l := NIL;
+ WHILE (b # sentinel) & (S.VAL(INTEGER, b) + b.size # s) DO l := b; b := b.next END;
+ IF b # sentinel THEN
+ IF l = NIL THEN free[i] := b.next ELSE l.next := b.next END
+ ELSE b := NIL
+ END;
+ INC(i)
+ UNTIL (b # NIL) OR (i = N);
+ RETURN b
+ END LastBlock;
+
+ PROCEDURE NewBlock (size: INTEGER): Block;
+ VAR tsize, a, s: INTEGER; b: FreeBlock; new, c: Cluster; r: Reducer;
+ BEGIN
+ ASSERT(size >= 0, 20);
+ IF size > MAX(INTEGER) - 19 THEN RETURN NIL END;
+ tsize := (size + 19) DIV 16 * 16;
+ b := OldBlock(tsize); (* 1) search for free block *)
+ IF b = NIL THEN
+ FastCollect; b := OldBlock(tsize); (* 2) collect *)
+ IF b = NIL THEN
+ Collect; b := OldBlock(tsize); (* 2a) fully collect *)
+ END;
+ IF b = NIL THEN
+ AllocHeapMem(tsize + 12, new); (* 3) allocate new cluster *)
+ IF new # NIL THEN
+ IF (root = NIL) OR (S.VAL(INTEGER, new) < S.VAL(INTEGER, root)) THEN
+ new.next := root; root := new
+ ELSE
+ c := root;
+ WHILE (c.next # NIL) & (S.VAL(INTEGER, new) > S.VAL(INTEGER, c.next)) DO c := c.next END;
+ new.next := c.next; c.next := new
+ END;
+ b := S.VAL(FreeBlock, S.VAL(INTEGER, new) + 12);
+ b.size := (new.size - 12) DIV 16 * 16 - 4
+ ELSE
+ RETURN NIL (* 4) give up *)
+ END
+ END
+ END;
+ (* b # NIL *)
+ a := b.size + 4 - tsize;
+ IF a > 0 THEN Insert(S.VAL(FreeBlock, S.VAL(INTEGER, b) + tsize), a) END;
+ IF size > 0 THEN Erase(S.ADR(b.size), (size + 3) DIV 4) END;
+ INC(allocated, tsize);
+ RETURN S.VAL(Block, b)
+ END NewBlock;
+
+ PROCEDURE Allocated* (): INTEGER;
+ BEGIN
+ RETURN allocated
+ END Allocated;
+
+ PROCEDURE Used* (): INTEGER;
+ BEGIN
+ RETURN used
+ END Used;
+
+ PROCEDURE Root* (): INTEGER;
+ BEGIN
+ RETURN S.VAL(INTEGER, root)
+ END Root;
+
+ (* -------------------- Trap Handling --------------------- *)
+
+ PROCEDURE [code] GetDLink (): DLink "(Kernel_DLink)SYSTEM_dlink";
+ PROCEDURE [code] SetDLink (dl: DLink) "SYSTEM_dlink = (SYSTEM_DLINK*)dl";
+
+ PROCEDURE Start* (code: Command);
+ VAR res: setjmp.int; dl: DLink;
+ BEGIN
+ restart := code;
+ baseStack := S.ADR(code); (* XXX: expected that target uses one stack *)
+ startDLink := GetDLink();
+ res := setjmp.sigsetjmp(startEnv, 1);
+ restart
+ END Start;
+
+ PROCEDURE Quit* (exitCode: INTEGER);
+ VAR m: Module; term: Command; t: BOOLEAN;
+ BEGIN
+ trapViewer := NIL; trapChecker := NIL; restart := NIL;
+ t := terminating; terminating := TRUE; m := modList;
+ WHILE m # NIL DO (* call terminators *)
+ IF ~static OR ~t THEN
+ term := m.term; m.term := NIL;
+ IF term # NIL THEN term() END
+ END;
+ m := m.next
+ END;
+ CallFinalizers;
+ hotFinalizers := finalizers; finalizers := NIL;
+ CallFinalizers;
+ stdlib.exit(exitCode)
+ END Quit;
+
+ PROCEDURE FatalError* (id: INTEGER; str: ARRAY OF CHAR);
+ VAR res: stdio.int; title: ARRAY 16 OF CHAR; text: ARRAY 256 OF SHORTCHAR;
+ BEGIN
+ title := "Error xy";
+ title[6] := CHR(id DIV 10 + ORD("0"));
+ title[7] := CHR(id MOD 10 + ORD("0"));
+ res := unistd.write(2, S.ADR(title), 8);
+ stdlib.abort
+ END FatalError;
+
+ PROCEDURE DefaultTrapViewer;
+ VAR out: ARRAY 256 OF SHORTCHAR; c, len: INTEGER; res: unistd.int; dl: DLink;
+
+ PROCEDURE WriteString (IN s: ARRAY OF SHORTCHAR);
+ VAR i: INTEGER;
+ BEGIN
+ i := 0;
+ WHILE (len < LEN(out) - 1) & (s[i] # 0X) DO out[len] := s[i]; INC(i); INC(len) END
+ END WriteString;
+
+ PROCEDURE WriteHex (x, n: INTEGER);
+ VAR i, y: INTEGER;
+ BEGIN
+ IF len + n < LEN(out) THEN
+ i := len + n - 1;
+ WHILE i >= len DO
+ y := x MOD 16; x := x DIV 16;
+ IF y > 9 THEN y := y + (ORD("A") - ORD("0") - 10) END;
+ out[i] := SHORT(CHR(y + ORD("0"))); DEC(i)
+ END;
+ INC(len, n)
+ END
+ END WriteHex;
+
+ PROCEDURE WriteLn;
+ BEGIN
+ IF len < LEN(out) - 1 THEN out[len] := 0AX; INC(len) END
+ END WriteLn;
+
+ BEGIN
+ len := 0;
+ WriteString("====== ");
+ IF err = 129 THEN WriteString("invalid with")
+ ELSIF err = 130 THEN WriteString("invalid case")
+ ELSIF err = 131 THEN WriteString("function without return")
+ ELSIF err = 132 THEN WriteString("type guard")
+ ELSIF err = 133 THEN WriteString("implied type guard")
+ ELSIF err = 134 THEN WriteString("value out of range")
+ ELSIF err = 135 THEN WriteString("index out of range")
+ ELSIF err = 136 THEN WriteString("string too long")
+ ELSIF err = 137 THEN WriteString("stack overflow")
+ ELSIF err = 138 THEN WriteString("integer overflow")
+ ELSIF err = 139 THEN WriteString("division by zero")
+ ELSIF err = 140 THEN WriteString("infinite real result")
+ ELSIF err = 141 THEN WriteString("real underflow")
+ ELSIF err = 142 THEN WriteString("real overflow")
+ ELSIF err = 143 THEN WriteString("undefined real result")
+ ELSIF err = 144 THEN WriteString("not a number")
+ ELSIF err = 200 THEN WriteString("keyboard interrupt")
+ ELSIF err = 201 THEN WriteString("NIL dereference")
+ ELSIF err = 202 THEN WriteString("illegal instruction: ");
+ WriteHex(val, 4)
+ ELSIF err = 203 THEN WriteString("illegal memory read [ad = ");
+ WriteHex(val, 8); WriteString("]")
+ ELSIF err = 204 THEN WriteString("illegal memory write [ad = ");
+ WriteHex(val, 8); WriteString("]")
+ ELSIF err = 205 THEN WriteString("illegal execution [ad = ");
+ WriteHex(val, 8); WriteString("]")
+ ELSIF err = 257 THEN WriteString("out of memory")
+ ELSIF err = 10001H THEN WriteString("bus error")
+ ELSIF err = 10002H THEN WriteString("address error")
+ ELSIF err = 10007H THEN WriteString("fpu error")
+ ELSIF err < 0 THEN WriteString("exception #"); WriteHex(-err, 2)
+ ELSE err := err DIV 100 * 256 + err DIV 10 MOD 10 * 16 + err MOD 10;
+ WriteString("trap #"); WriteHex(err, 3)
+ END;
+ WriteString(" ======");
+ WriteLn;
+ dl := GetDLink();
+ (* skip Kernel.DefaultTrapViewer & Kernel.Trap/Kernel.TrapHandler *)
+ c := 2;
+ WHILE (c > 0) & (dl # NIL) DO
+ dl := dl.next;
+ DEC(c)
+ END;
+ (* stack trace *)
+ c := 16;
+ WHILE (c > 0) & (dl # NIL) DO
+ WriteString("- "); WriteString(dl.name$); WriteLn;
+ dl := dl.next;
+ DEC(c)
+ END;
+ out[len] := 0X;
+ res := unistd.write(2, S.ADR(out), len)
+ END DefaultTrapViewer;
+
+ PROCEDURE TrapCleanup;
+ VAR t: TrapCleaner;
+ BEGIN
+ WHILE trapStack # NIL DO
+ t := trapStack; trapStack := trapStack.next; t.Cleanup
+ END;
+ IF (trapChecker # NIL) & (err # 128) THEN trapChecker END
+ END TrapCleanup;
+
+ PROCEDURE SetTrapGuard* (on: BOOLEAN);
+ BEGIN
+ guarded := on
+ END SetTrapGuard;
+
+ PROCEDURE Try* (h: TryHandler; a, b, c: INTEGER);
+ VAR oldIsTry: BOOLEAN; oldTryEnv: setjmp.jmp_buf; oldTryDLink: DLink; res: setjmp.int;
+ BEGIN
+ oldIsTry := isTry; oldTryEnv := tryEnv; oldTryDLink := tryDLink;
+ isTry := TRUE; tryDLink := GetDLink();
+ res := setjmp._setjmp(tryEnv);
+ IF res = 0 THEN h(a, b, c) END;
+ isTry := oldIsTry; tryEnv := oldTryEnv; tryDLink := oldTryDLink
+ END Try;
+
+ PROCEDURE Trap* (n: INTEGER);
+ BEGIN
+ IF trapped THEN
+ DefaultTrapViewer;
+ IF ~secondTrap THEN trapped := FALSE; secondTrap := TRUE END
+ END;
+ IF n >= 0 THEN err := n
+ ELSE err := -n + 128
+ END;
+ pc := 0; sp := 0; fp := 0; stack := 0; val := 0;
+ INC(trapCount);
+ (* !!! InitFPU *)
+ TrapCleanup;
+ IF isTry THEN
+ SetDLink(tryDLink);
+ setjmp._longjmp(tryEnv, 1)
+ END;
+ IF err = 128 THEN (* do nothing *)
+ ELSIF (trapViewer # NIL) & (restart # NIL) & ~trapped & ~guarded THEN
+ trapped := TRUE; trapViewer()
+ ELSE DefaultTrapViewer
+ END;
+ trapped := FALSE; secondTrap := FALSE;
+ IF restart # NIL THEN
+ SetDLink(startDLink);
+ setjmp.siglongjmp(startEnv, 1)
+ END;
+ stdlib.abort
+ END Trap;
+
+ PROCEDURE [ccall] TrapHandler (signo: signal.int; IN _info: signal.siginfo_t; context: ADDRESS);
+ TYPE SigInfo = POINTER [untagged] TO signal._siginfo_t;
+ VAR res: signal.int; info: SigInfo;
+ BEGIN
+ info := S.VAL(SigInfo, S.ADR(_info)); (* !!! hack for CPfront *)
+ IF trapped THEN
+ DefaultTrapViewer;
+ IF ~secondTrap THEN trapped := FALSE; secondTrap := TRUE END
+ END;
+ err := -signo; pc := 0; sp := 0; fp := 0; stack := 0; val := 0;
+ CASE signo OF
+ | signal.SIGFPE:
+ pc := info.si_addr;
+ val := info.si_code;
+ CASE info.si_code OF
+ | signal.FPE_INTDIV: err := 139 (* division by zero *)
+ | signal.FPE_INTOVF: err := 138 (* integer overflow *)
+ | signal.FPE_FLTDIV: err := 140 (* fpu: division by zero *)
+ | signal.FPE_FLTOVF: err := 142 (* fpu: overflow *)
+ | signal.FPE_FLTUND: err := 141 (* fpu: underflow *)
+ (* !!! | signal.FPE_FLTRES: err := ??? (* fpu: *) *)
+ | signal.FPE_FLTINV: err := 143 (* val := opcode *) (* fpu: invalid op *)
+ (* !!! | signal.FPE_FLTSUB: err := ??? (* fpu: *) *)
+ ELSE (* unknown *)
+ END
+ | signal.SIGINT:
+ val := info.si_code;
+ err := 200 (* keyboard interrupt *)
+ | signal.SIGSEGV:
+ val := info.si_addr;
+ err := 203 (* illigal read *)
+ | signal.SIGBUS:
+ val := info.si_addr;
+ err := 10001H (* bus error *)
+ | signal.SIGILL:
+ pc := info.si_addr;
+ err := 202; (* illigal instruction *)
+ IF IsReadable(pc, pc + 4) THEN
+ S.GET(pc, val)
+ (* !!! err := halt code *)
+ END;
+ ELSE (* unknown *)
+ END;
+ INC(trapCount);
+ (* !!! InitFPU *)
+ TrapCleanup;
+ IF isTry THEN
+ SetDLink(tryDLink);
+ setjmp._longjmp(tryEnv, 1)
+ END;
+ IF err = 128 THEN (* do nothing *)
+ ELSIF (trapViewer # NIL) & (restart # NIL) & ~trapped & ~guarded THEN
+ trapped := TRUE; trapViewer()
+ ELSE DefaultTrapViewer
+ END;
+ trapped := FALSE; secondTrap := FALSE;
+ IF restart # NIL THEN
+ SetDLink(startDLink);
+ setjmp.siglongjmp(startEnv, 1)
+ END;
+ stdlib.abort
+ END TrapHandler;
+
+ (* -------------------- Initialization --------------------- *)
+
+ PROCEDURE InstallTrap (signo: signal.int);
+ VAR act: signal._struct_sigaction; (* !!! CPfront hack *) res: signal.int;
+ BEGIN
+ act.sa_handler := NIL;
+ res := signal.sigemptyset(act.sa_mask);
+ act.sa_flags := signal.SA_NODEFER + signal.SA_SIGINFO;
+ act.sa_sigaction := TrapHandler;
+ res := signal.sigaction(signo, S.VAL(signal.struct_sigaction, act), NIL);
+ END InstallTrap;
+
+ PROCEDURE InstallTrapVectors;
+ BEGIN
+ InstallTrap(signal.SIGFPE);
+ InstallTrap(signal.SIGINT);
+ InstallTrap(signal.SIGSEGV);
+ InstallTrap(signal.SIGBUS);
+ InstallTrap(signal.SIGILL)
+ END InstallTrapVectors;
+
+ PROCEDURE RemoveTrapVectors;
+ END RemoveTrapVectors;
+
+ PROCEDURE Init;
+ VAR i: INTEGER;
+ BEGIN
+ baseStack := S.ADR(i); (* XXX *)
+ pagesize := unistd.sysconf(unistd._SC_PAGESIZE);
+
+ (* init heap *)
+ allocated := 0; total := 0; used := 0;
+ sentinelBlock.size := MAX(INTEGER);
+ sentinel := S.ADR(sentinelBlock);
+ i := N;
+ REPEAT DEC(i); free[i] := sentinel UNTIL i = 0;
+
+ IF ~inDll THEN
+ InstallTrapVectors
+ END;
+
+ (* !!! InitFPU *)
+ IF ~static THEN
+ InitModule(modList);
+ IF ~inDll THEN Quit(1) END
+ END
+ END Init;
+
+ PROCEDURE [code] SYSTEM_argCount (): INTEGER "SYSTEM_argCount";
+ PROCEDURE [code] SYSTEM_argVector (): ArrStrPtr "(Kernel_ArrStrPtr)SYSTEM_argVector";
+ PROCEDURE [code] SYSTEM_modlist (): Module "(Kernel_Module)SYSTEM_modlist";
+
+BEGIN
+ IF modList = NIL THEN (* only once *)
+ argc := SYSTEM_argCount();
+ argv := SYSTEM_argVector();
+ modList := SYSTEM_modlist();
+ static := init IN modList.opts;
+ inDll := dll IN modList.opts;
+ Init
+ END
+CLOSE
+ IF ~terminating THEN
+ terminating := TRUE;
+ Quit(0)
+ END
+END Kernel.
diff --git a/src/cpfront/posix/System/Mod/Math.cp b/src/cpfront/posix/System/Mod/Math.cp
--- /dev/null
@@ -0,0 +1,231 @@
+MODULE Math;
+
+ IMPORT SYSTEM;
+
+ VAR
+ eps, e: REAL;
+
+ PROCEDURE [code] IncludeMATH "#include <math.h>";
+ PROCEDURE [code] M_PI (): REAL "M_PI";
+ PROCEDURE [code] sqrt (x: REAL): REAL "sqrt(x)";
+ PROCEDURE [code] exp (x: REAL): REAL "exp(x)";
+ PROCEDURE [code] log (x: REAL): REAL "log(x)";
+ PROCEDURE [code] log10 (x: REAL): REAL "log10(x)";
+ PROCEDURE [code] pow (x, y: REAL): REAL "pow(x, y)";
+ PROCEDURE [code] sin (x: REAL): REAL "sin(x)";
+ PROCEDURE [code] cos (x: REAL): REAL "cos(x)";
+ PROCEDURE [code] tan (x: REAL): REAL "tan(x)";
+ PROCEDURE [code] asin (x: REAL): REAL "asin(x)";
+ PROCEDURE [code] acos (x: REAL): REAL "acos(x)";
+ PROCEDURE [code] atan (x: REAL): REAL "atan(x)";
+ PROCEDURE [code] atan2 (y, x: REAL): REAL "atan2(y, x)";
+ PROCEDURE [code] sinh (x: REAL): REAL "sinh(x)";
+ PROCEDURE [code] cosh (x: REAL): REAL "cosh(x)";
+ PROCEDURE [code] tanh (x: REAL): REAL "tanh(x)";
+ PROCEDURE [code] asinh (x: REAL): REAL "asinh(x)";
+ PROCEDURE [code] acosh (x: REAL): REAL "acosh(x)";
+ PROCEDURE [code] atanh (x: REAL): REAL "atanh(x)";
+ PROCEDURE [code] floor (x: REAL): REAL "floor(x)";
+ PROCEDURE [code] ceil (x: REAL): REAL "ceil(x)";
+ PROCEDURE [code] round (x: REAL): REAL "round(x)";
+ PROCEDURE [code] trunc (x: REAL): REAL "trunc(x)";
+ PROCEDURE [code] copysign (x, y: REAL): REAL "copysign(x, y)";
+ PROCEDURE [code] frexp (x: REAL; OUT exp: INTEGER): REAL "frexp(x, exp)";
+ PROCEDURE [code] ldexp (x: REAL; exp: INTEGER): REAL "ldexp(x, exp)";
+
+ PROCEDURE Pi* (): REAL;
+ BEGIN
+ RETURN M_PI()
+ END Pi;
+
+ PROCEDURE Eps* (): REAL;
+ BEGIN
+ RETURN eps
+ END Eps;
+
+ PROCEDURE Sqrt* (x: REAL): REAL;
+ BEGIN
+ RETURN sqrt(x)
+ END Sqrt;
+
+ PROCEDURE Exp* (x: REAL): REAL;
+ BEGIN
+ RETURN exp(x)
+ END Exp;
+
+ PROCEDURE Ln* (x: REAL): REAL;
+ BEGIN
+ RETURN log(x)
+ END Ln;
+
+ PROCEDURE Log* (x: REAL): REAL;
+ BEGIN
+ RETURN log10(x)
+ END Log;
+
+ PROCEDURE Power* (x, y: REAL): REAL;
+ BEGIN
+ RETURN pow(x, y)
+ END Power;
+
+ PROCEDURE IntPower* (x: REAL; n: INTEGER): REAL;
+ VAR y: REAL;
+ BEGIN
+ IF n = MIN(INTEGER) THEN RETURN IntPower(x, n + 1) / x END;
+ y := 1.0;
+ IF n < 0 THEN x := 1.0 / x; n := -n END;
+ WHILE n > 0 DO
+ IF ODD(n) THEN y := y * x; DEC(n)
+ ELSE x := x * x; n := n DIV 2
+ END
+ END;
+ RETURN y
+ END IntPower;
+
+ PROCEDURE Sin* (x: REAL): REAL;
+ BEGIN
+ RETURN sin(x)
+ END Sin;
+
+ PROCEDURE Cos* (x: REAL): REAL;
+ BEGIN
+ RETURN cos(x)
+ END Cos;
+
+ PROCEDURE Tan* (x: REAL): REAL;
+ BEGIN
+ RETURN tan(x)
+ END Tan;
+
+ PROCEDURE SinCos* (x: REAL; OUT s, c: REAL);
+ BEGIN
+ s := sin(x); c := cos(x)
+ END SinCos;
+
+ PROCEDURE ArcSin* (x: REAL): REAL;
+ BEGIN
+ RETURN asin(x)
+ END ArcSin;
+
+ PROCEDURE ArcCos* (x: REAL): REAL;
+ BEGIN
+ RETURN acos(x)
+ END ArcCos;
+
+ PROCEDURE ArcTan* (x: REAL): REAL;
+ BEGIN
+ RETURN atan(x)
+ END ArcTan;
+
+ PROCEDURE ArcTan2* (y, x: REAL): REAL;
+ BEGIN
+ RETURN atan2(y, x)
+ END ArcTan2;
+
+ PROCEDURE Sinh* (x: REAL): REAL;
+ BEGIN
+ RETURN sinh(x)
+ END Sinh;
+
+ PROCEDURE Cosh* (x: REAL): REAL;
+ BEGIN
+ RETURN cosh(x)
+ END Cosh;
+
+ PROCEDURE Tanh* (x: REAL): REAL;
+ BEGIN
+ RETURN tanh(x)
+ END Tanh;
+
+ PROCEDURE ArcSinh* (x: REAL): REAL;
+ BEGIN
+ RETURN asinh(x)
+ END ArcSinh;
+
+ PROCEDURE ArcCosh* (x: REAL): REAL;
+ BEGIN
+ RETURN acosh(x)
+ END ArcCosh;
+
+ PROCEDURE ArcTanh* (x: REAL): REAL;
+ BEGIN
+ RETURN atanh(x)
+ END ArcTanh;
+
+ PROCEDURE Floor* (x: REAL): REAL;
+ BEGIN
+ RETURN floor(x)
+ END Floor;
+
+ PROCEDURE Ceiling* (x: REAL): REAL;
+ BEGIN
+ RETURN ceil(x)
+ END Ceiling;
+
+ PROCEDURE Round* (x: REAL): REAL;
+ BEGIN
+ RETURN round(x)
+ END Round;
+
+ PROCEDURE Trunc* (x: REAL): REAL;
+ BEGIN
+ RETURN trunc(x)
+ END Trunc;
+
+ PROCEDURE Frac* (x: REAL): REAL;
+ BEGIN
+ IF x >= 0 THEN RETURN x - ENTIER(x)
+ ELSE RETURN x + ENTIER(-x)
+ END
+ END Frac;
+
+ PROCEDURE Mod1* (x: REAL): REAL;
+ BEGIN
+ RETURN x - ENTIER(x)
+ END Mod1;
+
+ PROCEDURE Sign* (x: REAL): REAL;
+ BEGIN
+ IF x > 0 THEN RETURN 1
+ ELSIF x < 0 THEN RETURN -1
+ ELSE RETURN x
+ END
+ END Sign;
+
+ PROCEDURE SignBit* (x: REAL): BOOLEAN;
+ BEGIN
+ RETURN copysign(1.0, x) > 0
+ END SignBit;
+
+ PROCEDURE CopySign* (x, y: REAL): REAL;
+ BEGIN
+ RETURN copysign(x, y)
+ END CopySign;
+
+ PROCEDURE Mantissa* (x: REAL): REAL;
+ VAR e: INTEGER;
+ BEGIN
+ RETURN frexp(x, e);
+ END Mantissa;
+
+ PROCEDURE Exponent* (x: REAL): INTEGER;
+ VAR m: REAL; e: INTEGER;
+ BEGIN
+ m := frexp(x, e);
+ RETURN e
+ END Exponent;
+
+ PROCEDURE Real* (m: REAL; e: INTEGER): REAL;
+ BEGIN
+ RETURN ldexp(m, e)
+ END Real;
+
+BEGIN
+ eps := 1.0E+0;
+ e := 2.0E+0;
+ WHILE e > 1.0E+0 DO
+ eps := eps/2.0E+0;
+ e := 1.0E+0 + eps
+ END;
+ eps := 2.0E+0 * eps
+END Math.
diff --git a/src/cpfront/posix/System/Mod/SMath.cp b/src/cpfront/posix/System/Mod/SMath.cp
--- /dev/null
@@ -0,0 +1,231 @@
+MODULE SMath;
+
+ IMPORT SYSTEM;
+
+ VAR
+ eps, e: SHORTREAL;
+
+ PROCEDURE [code] IncludeMATH "#include <math.h>";
+ PROCEDURE [code] M_PI (): SHORTREAL "M_PI";
+ PROCEDURE [code] sqrtf (x: SHORTREAL): SHORTREAL "sqrtf(x)";
+ PROCEDURE [code] expf (x: SHORTREAL): SHORTREAL "expf(x)";
+ PROCEDURE [code] logf (x: SHORTREAL): SHORTREAL "logf(x)";
+ PROCEDURE [code] log10f (x: SHORTREAL): SHORTREAL "log10f(x)";
+ PROCEDURE [code] powf (x, y: SHORTREAL): SHORTREAL "powf(x, y)";
+ PROCEDURE [code] sinf (x: SHORTREAL): SHORTREAL "sinf(x)";
+ PROCEDURE [code] cosf (x: SHORTREAL): SHORTREAL "cosf(x)";
+ PROCEDURE [code] tanf (x: SHORTREAL): SHORTREAL "tanf(x)";
+ PROCEDURE [code] asinf (x: SHORTREAL): SHORTREAL "asinf(x)";
+ PROCEDURE [code] acosf (x: SHORTREAL): SHORTREAL "acosf(x)";
+ PROCEDURE [code] atanf (x: SHORTREAL): SHORTREAL "atanf(x)";
+ PROCEDURE [code] atan2f (y, x: SHORTREAL): SHORTREAL "atan2f(y, x)";
+ PROCEDURE [code] sinhf (x: SHORTREAL): SHORTREAL "sinhf(x)";
+ PROCEDURE [code] coshf (x: SHORTREAL): SHORTREAL "coshf(x)";
+ PROCEDURE [code] tanhf (x: SHORTREAL): SHORTREAL "tanhf(x)";
+ PROCEDURE [code] asinhf (x: SHORTREAL): SHORTREAL "asinhf(x)";
+ PROCEDURE [code] acoshf (x: SHORTREAL): SHORTREAL "acoshf(x)";
+ PROCEDURE [code] atanhf (x: SHORTREAL): SHORTREAL "atanhf(x)";
+ PROCEDURE [code] floorf (x: SHORTREAL): SHORTREAL "floorf(x)";
+ PROCEDURE [code] ceilf (x: SHORTREAL): SHORTREAL "ceilf(x)";
+ PROCEDURE [code] roundf (x: SHORTREAL): SHORTREAL "roundf(x)";
+ PROCEDURE [code] truncf (x: SHORTREAL): SHORTREAL "truncf(x)";
+ PROCEDURE [code] copysignf (x, y: SHORTREAL): SHORTREAL "copysignf(x, y)";
+ PROCEDURE [code] frexpf (x: SHORTREAL; OUT exp: INTEGER): SHORTREAL "frexpf(x, exp)";
+ PROCEDURE [code] ldexpf (x: SHORTREAL; exp: INTEGER): SHORTREAL "ldexpf(x, exp)";
+
+ PROCEDURE Pi* (): SHORTREAL;
+ BEGIN
+ RETURN M_PI()
+ END Pi;
+
+ PROCEDURE Eps* (): SHORTREAL;
+ BEGIN
+ RETURN eps
+ END Eps;
+
+ PROCEDURE Sqrt* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN sqrtf(x)
+ END Sqrt;
+
+ PROCEDURE Exp* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN expf(x)
+ END Exp;
+
+ PROCEDURE Ln* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN logf(x)
+ END Ln;
+
+ PROCEDURE Log* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN log10f(x)
+ END Log;
+
+ PROCEDURE Power* (x, y: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN powf(x, y)
+ END Power;
+
+ PROCEDURE IntPower* (x: SHORTREAL; n: INTEGER): SHORTREAL;
+ VAR y: SHORTREAL;
+ BEGIN
+ IF n = MIN(INTEGER) THEN RETURN IntPower(x, n + 1) / x END;
+ y := 1.0;
+ IF n < 0 THEN x := 1.0 / x; n := -n END;
+ WHILE n > 0 DO
+ IF ODD(n) THEN y := y * x; DEC(n)
+ ELSE x := x * x; n := n DIV 2
+ END
+ END;
+ RETURN y
+ END IntPower;
+
+ PROCEDURE Sin* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN sinf(x)
+ END Sin;
+
+ PROCEDURE Cos* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN cosf(x)
+ END Cos;
+
+ PROCEDURE Tan* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN tanf(x)
+ END Tan;
+
+ PROCEDURE SinCos* (x: SHORTREAL; OUT s, c: SHORTREAL);
+ BEGIN
+ s := sinf(x); c := cosf(x)
+ END SinCos;
+
+ PROCEDURE ArcSin* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN asinf(x)
+ END ArcSin;
+
+ PROCEDURE ArcCos* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN acosf(x)
+ END ArcCos;
+
+ PROCEDURE ArcTan* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN atanf(x)
+ END ArcTan;
+
+ PROCEDURE ArcTan2* (y, x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN atan2f(y, x)
+ END ArcTan2;
+
+ PROCEDURE Sinh* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN sinhf(x)
+ END Sinh;
+
+ PROCEDURE Cosh* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN coshf(x)
+ END Cosh;
+
+ PROCEDURE Tanh* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN tanhf(x)
+ END Tanh;
+
+ PROCEDURE ArcSinh* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN asinhf(x)
+ END ArcSinh;
+
+ PROCEDURE ArcCosh* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN acoshf(x)
+ END ArcCosh;
+
+ PROCEDURE ArcTanh* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN atanhf(x)
+ END ArcTanh;
+
+ PROCEDURE Floor* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN floorf(x)
+ END Floor;
+
+ PROCEDURE Ceiling* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN ceilf(x)
+ END Ceiling;
+
+ PROCEDURE Round* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN roundf(x)
+ END Round;
+
+ PROCEDURE Trunc* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN truncf(x)
+ END Trunc;
+
+ PROCEDURE Frac* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ IF x >= 0 THEN RETURN x - ENTIER(x)
+ ELSE RETURN x + ENTIER(-x)
+ END
+ END Frac;
+
+ PROCEDURE Mod1* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN x - ENTIER(x)
+ END Mod1;
+
+ PROCEDURE Sign* (x: SHORTREAL): SHORTREAL;
+ BEGIN
+ IF x > 0 THEN RETURN 1
+ ELSIF x < 0 THEN RETURN -1
+ ELSE RETURN x
+ END
+ END Sign;
+
+ PROCEDURE SignBit* (x: SHORTREAL): BOOLEAN;
+ BEGIN
+ RETURN copysignf(1.0, x) > 0
+ END SignBit;
+
+ PROCEDURE CopySign* (x, y: SHORTREAL): SHORTREAL;
+ BEGIN
+ RETURN copysignf(x, y)
+ END CopySign;
+
+ PROCEDURE Mantissa* (x: SHORTREAL): SHORTREAL;
+ VAR e: INTEGER;
+ BEGIN
+ RETURN frexpf(x, e);
+ END Mantissa;
+
+ PROCEDURE Exponent* (x: SHORTREAL): INTEGER;
+ VAR m: SHORTREAL; e: INTEGER;
+ BEGIN
+ m := frexpf(x, e);
+ RETURN e
+ END Exponent;
+
+ PROCEDURE Real* (m: SHORTREAL; e: INTEGER): SHORTREAL;
+ BEGIN
+ RETURN ldexpf(m, e)
+ END Real;
+
+BEGIN
+ eps := 1.0E+0;
+ e := 2.0E+0;
+ WHILE e > 1.0E+0 DO
+ eps := eps/2.0E+0;
+ e := 1.0E+0 + eps
+ END;
+ eps := 2.0E+0 * eps
+END SMath.
diff --git a/src/generic/CPfront/Mod/CPC.odc b/src/generic/CPfront/Mod/CPC.odc
new file mode 100644 (file)
index 0000000..e4fe990
Binary files /dev/null and b/src/generic/CPfront/Mod/CPC.odc differ
index 0000000..e4fe990
Binary files /dev/null and b/src/generic/CPfront/Mod/CPC.odc differ
diff --git a/src/generic/CPfront/Mod/CPG.odc b/src/generic/CPfront/Mod/CPG.odc
new file mode 100644 (file)
index 0000000..fd732b9
Binary files /dev/null and b/src/generic/CPfront/Mod/CPG.odc differ
index 0000000..fd732b9
Binary files /dev/null and b/src/generic/CPfront/Mod/CPG.odc differ
diff --git a/src/generic/CPfront/Mod/CPV.odc b/src/generic/CPfront/Mod/CPV.odc
new file mode 100644 (file)
index 0000000..0fbf6c0
Binary files /dev/null and b/src/generic/CPfront/Mod/CPV.odc differ
index 0000000..0fbf6c0
Binary files /dev/null and b/src/generic/CPfront/Mod/CPV.odc differ
diff --git a/src/generic/Dev/Mod/CPB.odc b/src/generic/Dev/Mod/CPB.odc
new file mode 100644 (file)
index 0000000..ef98324
Binary files /dev/null and b/src/generic/Dev/Mod/CPB.odc differ
index 0000000..ef98324
Binary files /dev/null and b/src/generic/Dev/Mod/CPB.odc differ
diff --git a/src/generic/Dev/Mod/CPC486.odc b/src/generic/Dev/Mod/CPC486.odc
new file mode 100644 (file)
index 0000000..0898cd2
Binary files /dev/null and b/src/generic/Dev/Mod/CPC486.odc differ
index 0000000..0898cd2
Binary files /dev/null and b/src/generic/Dev/Mod/CPC486.odc differ
diff --git a/src/generic/Dev/Mod/CPE.odc b/src/generic/Dev/Mod/CPE.odc
new file mode 100644 (file)
index 0000000..2ac4588
Binary files /dev/null and b/src/generic/Dev/Mod/CPE.odc differ
index 0000000..2ac4588
Binary files /dev/null and b/src/generic/Dev/Mod/CPE.odc differ
diff --git a/src/generic/Dev/Mod/CPH.odc b/src/generic/Dev/Mod/CPH.odc
new file mode 100644 (file)
index 0000000..014828b
Binary files /dev/null and b/src/generic/Dev/Mod/CPH.odc differ
index 0000000..014828b
Binary files /dev/null and b/src/generic/Dev/Mod/CPH.odc differ
diff --git a/src/generic/Dev/Mod/CPL486.odc b/src/generic/Dev/Mod/CPL486.odc
new file mode 100644 (file)
index 0000000..eca6a68
Binary files /dev/null and b/src/generic/Dev/Mod/CPL486.odc differ
index 0000000..eca6a68
Binary files /dev/null and b/src/generic/Dev/Mod/CPL486.odc differ
diff --git a/src/generic/Dev/Mod/CPM.cp b/src/generic/Dev/Mod/CPM.cp
--- /dev/null
@@ -0,0 +1,1194 @@
+MODULE DevCPM;
+
+ IMPORT SYSTEM, Kernel, Files, Console, Strings;
+
+ CONST
+ ProcSize* = 4; (* PROCEDURE type *)
+ PointerSize* = 4; (* POINTER type *)
+ DArrSizeA* = 8; (* dyn array descriptor *)
+ DArrSizeB* = 4; (* size = A + B * typ.n *)
+
+ MaxSet* = 31;
+ MaxIndex* = 7FFFFFFFH; (* maximal index value for array declaration *)
+
+ MinReal32Pat = 0FF7FFFFFH; (* most positive, 32-bit pattern *)
+ MinReal64PatL = 0FFFFFFFFH; (* most negative, lower 32-bit pattern *)
+ MinReal64PatH = 0FFEFFFFFH; (* most negative, higher 32-bit pattern *)
+ MaxReal32Pat = 07F7FFFFFH; (* most positive, 32-bit pattern *)
+ MaxReal64PatL = 0FFFFFFFFH; (* most positive, lower 32-bit pattern *)
+ MaxReal64PatH = 07FEFFFFFH; (* most positive, higher 32-bit pattern *)
+ InfRealPat = 07F800000H; (* real infinity pattern *)
+
+
+ (* inclusive range of parameter of standard procedure HALT *)
+ MinHaltNr* = 0;
+ MaxHaltNr* = 128;
+
+ (* inclusive range of register number of procedures SYSTEM.GETREG and SYSTEM.PUTREG *)
+ MinRegNr* = 0;
+ MaxRegNr* = 31;
+
+ (* maximal value of flag used to mark interface structures *)
+ MaxSysFlag* = 127; (* shortint *)
+ CProcFlag* = 1; (* code procedures *)
+
+ (* maximal condition value of parameter of SYSTEM.CC *)
+ MaxCC* = 15;
+
+ (* initialization of constant address, must be different from any valid constant address *)
+ ConstNotAlloc* = -1;
+
+ (* whether hidden pointer fields have to be nevertheless exported *)
+ ExpHdPtrFld* = TRUE;
+ HdPtrName* = "@ptr";
+
+ (* whether hidden untagged pointer fields have to be nevertheless exported *)
+ ExpHdUtPtrFld* = TRUE;
+ HdUtPtrName* = "@utptr";
+
+ (* whether hidden procedure fields have to be nevertheless exported (may be used for System.Free) *)
+ ExpHdProcFld* = TRUE;
+ HdProcName* = "@proc";
+
+ (* whether hidden bound procedures have to be nevertheless exported *)
+ ExpHdTProc* = FALSE;
+ HdTProcName* = "@tproc";
+
+ (* maximal number of exported stuctures: *)
+ MaxStruct* = 16000; (* must be < MAX(INTEGER) DIV 2 in object model *)
+
+ (* maximal number of record extensions: *)
+ MaxExts* = 15; (* defined by type descriptor layout *)
+
+ (* whether field leaf of pointer variable p has to be set to FALSE, when NEW(p) or SYSTEM.NEW(p, n) is used *)
+ NEWusingAdr* = FALSE;
+
+ (* special character (< " ") returned by procedure Get, if end of text reached *)
+ Eot* = 0X;
+
+ (* warnings *)
+ longreal* = 0; largeint* = 1; realConst* = 2; copy* = 3; lchr* = 4; lentier* = 5; invar* = 6; outvar* = 7;
+
+ (* language options *)
+ interface* = 1;
+ com* = 2; comAware* = 3;
+ som* = 4; somAware* = 5;
+ oberon* = 6;
+ java* = 7; javaAware* = 8;
+ noCode* = 9;
+ allSysVal* = 14;
+ sysImp* = 15;
+ trap* = 31;
+ sys386 = 10; sys68k = 20; (* processor type in options if system imported *)
+
+ CONST
+ SFdir = "Sym";
+ OFdir = "Code";
+ SYSdir = "System";
+ SFtag = 6F4F5346H; (* symbol file tag *)
+ OFtag = 6F4F4346H; (* object file tag *)
+ maxErrors = 64;
+ errFile = "Errors";
+
+ TYPE
+ Directory* = POINTER TO RECORD
+ path*: Files.Name;
+ legacy*: BOOLEAN;
+ next*: Directory
+ END;
+
+ VAR
+ LEHost*: BOOLEAN; (* little or big endian host *)
+ MinReal32*, MaxReal32*, InfReal*,
+ MinReal64*, MaxReal64*: REAL;
+ noerr*: BOOLEAN; (* no error found until now *)
+ curpos*, startpos*, errpos*: INTEGER; (* character, start, and error position in source file *)
+ searchpos*: INTEGER; (* search position in source file *)
+ errors*: INTEGER;
+ breakpc*: INTEGER; (* set by OPV.Init *)
+ options*: SET; (* language options *)
+ file*: Files.File; (* used for sym file import *)
+ legacy*: BOOLEAN; (* use BlackBox subsystems *)
+ symList*: Directory;
+ codePath*: Files.Name;
+ symPath*: Files.Name;
+ codeDir*: ARRAY 16 OF CHAR;
+ symDir*: ARRAY 16 OF CHAR;
+ name*: Files.Name; (* source name *)
+ checksum*: INTEGER; (* symbol file checksum *)
+ verbose*: INTEGER;
+
+ lastpos: INTEGER;
+ ObjFName: Files.Name;
+
+ in: POINTER TO ARRAY OF CHAR;
+ oldSymFile, symFile, objFile: Files.File;
+ inSym: Files.Reader;
+ outSym, outObj: Files.Writer;
+
+ errNo, errPos: ARRAY maxErrors OF INTEGER;
+
+ crc32tab: ARRAY 256 OF INTEGER;
+
+
+ PROCEDURE^ err* (n: INTEGER);
+
+ PROCEDURE Init* (source: POINTER TO ARRAY OF CHAR);
+ BEGIN
+ in := source;
+ noerr := TRUE; options := {};
+ curpos := 0; errpos := curpos; lastpos := curpos - 11; errors := 0;
+ codePath := ""; symPath := ""; name := "";
+ codeDir := OFdir; symDir := SFdir;
+ END Init;
+
+ PROCEDURE Close*;
+ BEGIN
+ oldSymFile := NIL; inSym := NIL;
+ symFile := NIL; outSym := NIL;
+ objFile := NIL; outObj := NIL;
+ in := NIL
+ END Close;
+
+ PROCEDURE Get* (VAR ch: CHAR);
+ BEGIN
+ ch := in[curpos]; INC(curpos)
+ END Get;
+
+ PROCEDURE LineColOf (pos: INTEGER; OUT line, col, beg, end: INTEGER);
+ VAR i: INTEGER;
+ BEGIN
+ i := 0; line := 1; col := 1; beg := 0; end := 0;
+ WHILE i < pos DO
+ IF in[i] = 0DX THEN
+ INC(i);
+ IF in[i] = 0AX THEN
+ INC(i)
+ END;
+ INC(line);
+ beg := i;
+ col := 1
+ ELSIF in[i] = 0AX THEN
+ INC(i);
+ INC(line);
+ beg := i;
+ col := 1
+ ELSIF in[i] = 09X THEN
+ INC(i); INC(col, 2)
+ ELSE
+ INC(i); INC(col)
+ END;
+ END;
+ WHILE (in[i] # 0DX) & (in[i] # 0AX) & (in[i] # 0X) DO
+ INC(i)
+ END;
+ end := i - 1
+ END LineColOf;
+
+ PROCEDURE LineOf* (pos: INTEGER): INTEGER;
+ VAR line, col, beg, end: INTEGER;
+ BEGIN
+ LineColOf(pos, line, col, beg, end);
+ RETURN line
+ END LineOf;
+
+ PROCEDURE LoWord (r: REAL): INTEGER;
+ VAR x: INTEGER;
+ BEGIN
+ x := SYSTEM.ADR(r);
+ IF ~LEHost THEN INC(x, 4) END;
+ SYSTEM.GET(x, x);
+ RETURN x
+ END LoWord;
+
+ PROCEDURE HiWord (r: REAL): INTEGER;
+ VAR x: INTEGER;
+ BEGIN
+ x := SYSTEM.ADR(r);
+ IF LEHost THEN INC(x, 4) END;
+ SYSTEM.GET(x, x);
+ RETURN x
+ END HiWord;
+
+ PROCEDURE Compound (lo, hi: INTEGER): REAL;
+ VAR r: REAL;
+ BEGIN
+ IF LEHost THEN
+ SYSTEM.PUT(SYSTEM.ADR(r), lo); SYSTEM.PUT(SYSTEM.ADR(r) + 4, hi)
+ ELSE
+ SYSTEM.PUT(SYSTEM.ADR(r) + 4, lo); SYSTEM.PUT(SYSTEM.ADR(r), hi)
+ END;
+ RETURN r
+ END Compound;
+
+
+ (* sysflag control *)
+
+ PROCEDURE ValidGuid* (IN str: ARRAY OF SHORTCHAR): BOOLEAN;
+ VAR i: INTEGER; ch: SHORTCHAR;
+ BEGIN
+ IF (LEN(str$) # 38) OR (str[0] # "{") & (str[37] # "}") THEN RETURN FALSE END;
+ i := 1;
+ WHILE i < 37 DO
+ ch := str[i];
+ IF (i = 9) OR (i = 14) OR (i = 19) OR (i = 24) THEN
+ IF ch # "-" THEN RETURN FALSE END
+ ELSE
+ IF (ch < "0") OR (ch > "9") & (CAP(ch) < "A") OR (CAP(ch) > "Z") THEN RETURN FALSE END
+ END;
+ INC(i)
+ END;
+ RETURN TRUE
+ END ValidGuid;
+
+ PROCEDURE GetProcSysFlag* (IN id: ARRAY OF SHORTCHAR; num: SHORTINT; VAR flag: SHORTINT);
+ BEGIN
+ IF id # "" THEN
+ IF id = "code" THEN num := 1
+ ELSIF id = "callback" THEN num := 2
+ ELSIF id = "nostkchk" THEN num := 4
+ ELSIF id = "ccall" THEN num := -10
+ ELSIF id = "ccall16" THEN num := -12
+ ELSIF id = "guarded" THEN num := 8
+ ELSIF id = "noframe" THEN num := 16
+ ELSIF id = "native" THEN num := -33
+ ELSIF id = "bytecode" THEN num := -35
+ END
+ END;
+ IF (options * {sysImp, sys386, sys68k} # {}) & ((num = 1) OR (num = 2)) THEN INC(flag, num)
+ ELSIF (sys68k IN options) & (num = 4) THEN INC(flag, num)
+ ELSIF (options * {sys386, interface} # {}) & (num = -10) & (flag = 0) THEN flag := -10
+ ELSIF (options * {sys386, interface} # {}) & (num = -12) & (flag = 0) THEN flag := -12
+ ELSIF (options * {sys386, com} # {}) & (num = 8) & (flag = 0) THEN flag := 8
+ ELSIF (options * {sysImp, sys386} # {}) & (num = 16) & (flag = 0) THEN flag := 16
+ ELSIF ({sysImp, java} - options = {}) & ((num= -33) OR (num = -35)) & (flag = 0) THEN flag := num
+ ELSE err(225); flag := 0
+ END
+ END GetProcSysFlag;
+
+ PROCEDURE GetVarParSysFlag* (IN id: ARRAY OF SHORTCHAR; num: SHORTINT; VAR flag: SHORTINT);
+ VAR old: SHORTINT;
+ BEGIN
+ old := flag; flag := 0;
+ IF (options * {sys386, sys68k, interface, com} # {}) THEN
+ IF (num = 1) OR (id = "nil") THEN
+ IF ~ODD(old) THEN flag := SHORT(old + 1) END
+ ELSIF ((num = 2) OR (id = "in")) & (oberon IN options) THEN
+ IF old <= 1 THEN flag := SHORT(old + 2) END
+ ELSIF ((num = 4) OR (id = "out")) & (oberon IN options) THEN
+ IF old <= 1 THEN flag := SHORT(old + 4) END
+ ELSIF ((num = 8) OR (id = "new")) & (options * {com, interface} # {}) THEN
+ IF old <= 1 THEN flag := SHORT(old + 8) END
+ ELSIF ((num = 16) OR (id = "iid")) & (com IN options) THEN
+ IF old <= 1 THEN flag := SHORT(old + 16) END
+ END
+ END;
+ IF flag = 0 THEN err(225) END
+ END GetVarParSysFlag;
+
+ PROCEDURE GetRecordSysFlag* (IN id: ARRAY OF SHORTCHAR; num: SHORTINT; VAR flag: SHORTINT);
+ VAR old: SHORTINT;
+ BEGIN
+ old := flag; flag := 0;
+ IF (num = 1) OR (id = "untagged") THEN
+ IF (options * {sysImp, sys386, sys68k, interface, com, som} # {}) & (old = 0) THEN flag := 1 END
+ ELSIF (num = 3) OR (id = "noalign") THEN
+ IF (options * {sys386, sys68k, interface, com, som} # {}) & (old = 0) THEN flag := 3 END
+ ELSIF (num = 4) OR (id = "align2") THEN
+ IF (options * {sys386, interface, com} # {}) & (old = 0) THEN flag := 4 END
+ ELSIF (num = 5) OR (id = "align4") THEN
+ IF (options * {sys386, interface, com} # {}) & (old = 0) THEN flag := 5 END
+ ELSIF (num = 6) OR (id = "align8") THEN
+ IF (options * {sys386, interface, com} # {}) & (old = 0) THEN flag := 6 END
+ ELSIF (num = 7) OR (id = "union") THEN
+ IF (options * {sys386, sys68k, interface, com} # {}) & (old = 0) THEN flag := 7 END
+ ELSIF (num = 10) OR (id = "interface") OR ValidGuid(id) THEN
+ IF (com IN options) & (old = 0) THEN flag := 10 END
+ ELSIF (num = -11) OR (id = "jint") THEN
+ IF (java IN options) & (old = 0) THEN flag := -11 END
+ ELSIF (num = -13) OR (id = "jstr") THEN
+ IF (java IN options) & (old = 0) THEN flag := -13 END
+ ELSIF (num = 20) OR (id = "som") THEN
+ IF (som IN options) & (old = 0) THEN flag := 20 END
+ END;
+ IF flag = 0 THEN err(225) END
+ END GetRecordSysFlag;
+
+ PROCEDURE GetArraySysFlag* (IN id: ARRAY OF SHORTCHAR; num: SHORTINT; VAR flag: SHORTINT);
+ VAR old: SHORTINT;
+ BEGIN
+ old := flag; flag := 0;
+ IF (num = 1) OR (id = "untagged") THEN
+ IF (options * {sysImp, sys386, sys68k, interface, com, som} # {}) & (old = 0) THEN flag := 1 END
+ ELSIF (num = -12) OR (id = "jarr") THEN
+ IF (java IN options) & (old = 0) THEN flag := -12 END
+ ELSIF (num = -13) OR (id = "jstr") THEN
+ IF (java IN options) & (old = 0) THEN flag := -13 END
+ END;
+ IF flag = 0 THEN err(225) END
+ END GetArraySysFlag;
+
+ PROCEDURE GetPointerSysFlag* (IN id: ARRAY OF SHORTCHAR; num: SHORTINT; VAR flag: SHORTINT);
+ VAR old: SHORTINT;
+ BEGIN
+ old := flag; flag := 0;
+ IF (num = 1) OR (id = "untagged") THEN
+ IF (options * {sys386, sys68k, interface, com, som} # {}) & (old = 0) THEN flag := 1 END
+ ELSIF (num = 2) OR (id = "handle") THEN
+ IF (sys68k IN options) & (old = 0) THEN flag := 2 END
+ ELSIF (num = 10) OR (id = "interface") THEN
+ IF (com IN options) & (old = 0) THEN flag := 10 END
+ ELSIF (num = 20) OR (id = "som") THEN
+ IF (som IN options) & (old = 0) THEN flag := 20 END
+ END;
+ IF flag = 0 THEN err(225) END
+ END GetPointerSysFlag;
+
+ PROCEDURE GetProcTypSysFlag* (IN id: ARRAY OF SHORTCHAR; num: SHORTINT; VAR flag: SHORTINT);
+ BEGIN
+ IF ((num = -10) OR (id = "ccall")) & (options * {sys386, interface} # {}) THEN flag := -10
+ ELSIF ((num = -12) OR (id = "ccall16")) & (options * {sys386, interface} # {}) THEN flag := -12
+ ELSE err(225); flag := 0
+ END
+ END GetProcTypSysFlag;
+
+ PROCEDURE PropagateRecordSysFlag* (baseFlag: SHORTINT; VAR flag: SHORTINT);
+ BEGIN
+ IF (baseFlag = 1) OR (baseFlag >= 3) & (baseFlag <= 7) THEN (* propagate untagged .. union *)
+ IF flag = 0 THEN flag := baseFlag
+ ELSIF (flag = 6) & (baseFlag < 6) THEN (* OK *) (* special case for 8 byte aligned records *)
+ ELSIF flag # baseFlag THEN err(225); flag := 0
+ END
+ ELSIF (baseFlag # 10) & (flag = 10) THEN err(225)
+ END
+ END PropagateRecordSysFlag;
+
+ PROCEDURE PropagateRecPtrSysFlag* (baseFlag: SHORTINT; VAR flag: SHORTINT);
+ BEGIN
+ IF (baseFlag = 1) OR (baseFlag >= 3) & (baseFlag <= 7) THEN (* pointer to untagged .. union is untagged *)
+ IF flag = 0 THEN flag := 1
+ ELSIF (flag # 1) & (flag # 2) THEN err(225); flag := 0
+ END
+ ELSIF baseFlag = 10 THEN (* pointer to interface is interface *)
+ IF flag = 0 THEN flag := 10
+ ELSIF flag # 10 THEN err(225); flag := 0
+ END
+ ELSIF baseFlag = -11 THEN (* pointer to java interface is java interface *)
+ IF flag # 0 THEN err(225) END;
+ flag := -11
+ ELSIF baseFlag = -13 THEN (* pointer to java string is java string *)
+ IF flag # 0 THEN err(225) END;
+ flag := -13
+ END
+ END PropagateRecPtrSysFlag;
+
+ PROCEDURE PropagateArrPtrSysFlag* (baseFlag: SHORTINT; VAR flag: SHORTINT);
+ BEGIN
+ IF baseFlag = 1 THEN (* pointer to untagged or guid is untagged *)
+ IF flag = 0 THEN flag := 1
+ ELSIF (flag # 1) & (flag # 2) THEN err(225); flag := 0
+ END
+ ELSIF baseFlag = -12 THEN (* pointer to java array is java array *)
+ IF flag # 0 THEN err(225) END;
+ flag := -12
+ ELSIF baseFlag = -13 THEN (* pointer to java string is java string *)
+ IF flag # 0 THEN err(225) END;
+ flag := -13
+ END
+ END PropagateArrPtrSysFlag;
+
+
+ (* utf8 strings *)
+
+ PROCEDURE PutUtf8* (VAR str: ARRAY OF SHORTCHAR; val: INTEGER; VAR idx: INTEGER);
+ BEGIN
+ ASSERT((val >= 0) & (val < 65536));
+ IF val < 128 THEN
+ str[idx] := SHORT(CHR(val)); INC(idx)
+ ELSIF val < 2048 THEN
+ str[idx] := SHORT(CHR(val DIV 64 + 192)); INC(idx);
+ str[idx] := SHORT(CHR(val MOD 64 + 128)); INC(idx)
+ ELSE
+ str[idx] := SHORT(CHR(val DIV 4096 + 224)); INC(idx);
+ str[idx] := SHORT(CHR(val DIV 64 MOD 64 + 128)); INC(idx);
+ str[idx] := SHORT(CHR(val MOD 64 + 128)); INC(idx)
+ END
+ END PutUtf8;
+
+ PROCEDURE GetUtf8* (IN str: ARRAY OF SHORTCHAR; VAR val, idx: INTEGER);
+ VAR ch: SHORTCHAR;
+ BEGIN
+ ch := str[idx]; INC(idx);
+ IF ch < 80X THEN
+ val := ORD(ch)
+ ELSIF ch < 0E0X THEN
+ val := ORD(ch) - 192;
+ ch := str[idx]; INC(idx); val := val * 64 + ORD(ch) - 128
+ ELSE
+ val := ORD(ch) - 224;
+ ch := str[idx]; INC(idx); val := val * 64 + ORD(ch) - 128;
+ ch := str[idx]; INC(idx); val := val * 64 + ORD(ch) - 128
+ END
+ END GetUtf8;
+
+
+ (* log output *)
+
+ PROCEDURE LogW* (ch: CHAR);
+ BEGIN
+ Console.WriteChar(ch)
+ END LogW;
+
+ PROCEDURE LogWStr* (IN s: ARRAY OF CHAR);
+ BEGIN
+ Console.WriteStr(s)
+ END LogWStr;
+
+ PROCEDURE LogWPar* (IN key: ARRAY OF CHAR; IN p0, p1: ARRAY OF SHORTCHAR);
+ VAR s, s0, s1: ARRAY 256 OF CHAR; i, res: INTEGER;
+ BEGIN
+ Kernel.Utf8ToString(p0, s0, res);
+ Kernel.Utf8ToString(p1, s1, res);
+ IF key = "#Dev:NotImplementedIn" THEN s := "^0 not implemented in ^1"
+ ELSIF key = "#Dev:NotImplemented" THEN s := "^0 not implemented"
+ ELSIF key = "#Dev:InconsistentImport" THEN s := "^0.^1 is not consistently imported"
+ ELSIF key = "#Dev:ChangedLibFlag" THEN s := "changed library flag"
+ ELSIF key = "#Dev:IsNoLongerInSymFile" THEN s := "^0 is no longer in symbol file"
+ ELSIF key = "#Dev:IsRedefinedInternally" THEN s := "^0 is redefined internally"
+ ELSIF key = "#Dev:IsRedefined" THEN s := "^0 is redefined"
+ ELSIF key = "#Dev:IsNewInSymFile" THEN s := "^0 is new in symbol file"
+ ELSIF key = "#Dev:NewSymFile" THEN s := "new symbol file"
+ ELSE s := key$
+ END;
+ i := 0;
+ WHILE s[i] # 0X DO
+ IF s[i] = "^" THEN
+ CASE s[i + 1] OF
+ | "0": Console.WriteStr(s0)
+ | "1": Console.WriteStr(s1)
+ | "2": (* skip *)
+ ELSE Console.WriteChar("^")
+ END;
+ INC(i, 2)
+ ELSE
+ Console.WriteChar(s[i]);
+ INC(i)
+ END
+ END
+ END LogWPar;
+
+ PROCEDURE LogWNum* (i, len: INTEGER);
+ VAR s: ARRAY 32 OF CHAR;
+ BEGIN
+ Strings.IntToStringForm(i, 10, len, " ", FALSE, s);
+ Console.WriteStr(s)
+ END LogWNum;
+
+ PROCEDURE LogWLn*;
+ BEGIN
+ Console.WriteLn
+ END LogWLn;
+
+ PROCEDURE Mark* (n, pos: INTEGER);
+ BEGIN
+ IF (n >= 0) & ~((oberon IN options) & (n >= 181) & (n <= 190)) THEN
+ noerr := FALSE;
+ IF pos < 0 THEN pos := 0 END;
+ IF (pos < lastpos) OR (lastpos + 9 < pos) THEN
+ lastpos := pos;
+ IF errors < maxErrors THEN
+ errNo[errors] := n; errPos[errors] := pos
+ END;
+ INC(errors)
+ END;
+ IF trap IN options THEN HALT(100) END;
+ ELSIF (n <= -700) & (errors < maxErrors) THEN
+ errNo[errors] := -n; errPos[errors] := pos; INC(errors)
+ END
+ END Mark;
+
+ PROCEDURE err* (n: INTEGER);
+ BEGIN
+ Mark(n, errpos)
+ END err;
+
+ PROCEDURE GetErrorMsg (err: INTEGER; OUT msg: ARRAY OF CHAR);
+ BEGIN
+ CASE err OF
+ | 0: msg := 'undeclared identifier'
+ | 1: msg := 'multiply defined identifier'
+ | 2: msg := 'illegal character in number'
+ | 3: msg := 'illegal character in string'
+ | 4: msg := 'identifier does not match procedure name'
+ | 5: msg := 'comment not closed'
+ | 9: msg := '"=" expected'
+ | 12: msg := 'type definition starts with incorrect symbol'
+ | 13: msg := 'factor starts with incorrect symbol'
+ | 14: msg := 'statement starts with incorrect symbol'
+ | 15: msg := 'declaration followed by incorrect symbol'
+ | 16: msg := 'MODULE expected'
+ | 19: msg := '"." missing'
+ | 20: msg := '"," missing'
+ | 21: msg := '":" missing'
+ | 23: msg := '")" missing'
+ | 24: msg := '"]" missing'
+ | 25: msg := '"}" missing'
+ | 26: msg := 'OF missing'
+ | 27: msg := 'THEN missing'
+ | 28: msg := 'DO missing'
+ | 29: msg := 'TO missing'
+ | 35: msg := '"," or OF expected'
+ | 36: msg := 'CONST, TYPE, VAR, PROCEDURE, BEGIN, or END missing'
+ | 37: msg := 'PROCEDURE, BEGIN, or END missing'
+ | 38: msg := 'BEGIN or END missing'
+ | 40: msg := '"(" missing'
+ | 41: msg := 'illegally marked identifier'
+ | 42: msg := 'constant not an integer'
+ | 43: msg := 'UNTIL missing'
+ | 44: msg := '":=" missing'
+ | 46: msg := 'EXIT not within loop statement'
+ | 47: msg := 'string expected'
+ | 48: msg := 'identifier expected'
+ | 49: msg := '";" missing'
+ | 50: msg := 'expression should be constant'
+ | 51: msg := 'END missing'
+ | 52: msg := 'identifier does not denote a type'
+ | 53: msg := 'identifier does not denote a record type'
+ | 54: msg := 'result type of procedure is not a basic type'
+ | 55: msg := 'procedure call of a function'
+ | 56: msg := 'assignment to non-variable'
+ | 57: msg := 'pointer not bound to record or array type'
+ | 58: msg := 'recursive type definition'
+ | 59: msg := 'illegal open array parameter'
+ | 60: msg := 'wrong type of case label'
+ | 61: msg := 'inadmissible type of case label'
+ | 62: msg := 'case label defined more than once'
+ | 63: msg := 'illegal value of constant'
+ | 64: msg := 'more actual than formal parameters'
+ | 65: msg := 'fewer actual than formal parameters'
+ | 66: msg := 'element types of actual array and formal open array differ'
+ | 67: msg := 'actual parameter corresponding to open array is not an array'
+ | 68: msg := 'control variable must be integer'
+ | 69: msg := 'parameter must be an integer constant'
+ | 70: msg := 'pointer or VAR / IN record required as formal receiver'
+ | 71: msg := 'pointer expected as actual receiver'
+ | 72: msg := 'procedure must be bound to a record of the same scope'
+ | 73: msg := 'procedure must have level 0'
+ | 74: msg := 'procedure unknown in base type'
+ | 75: msg := 'invalid call of base procedure'
+ | 76: msg := 'this variable (field) is read only'
+ | 77: msg := 'object is not a record'
+ | 78: msg := 'dereferenced object is not a variable'
+ | 79: msg := 'indexed object is not a variable'
+ | 80: msg := 'index expression is not an integer'
+ | 81: msg := 'index out of specified bounds'
+ | 82: msg := 'indexed variable is not an array'
+ | 83: msg := 'undefined record field'
+ | 84: msg := 'dereferenced variable is not a pointer'
+ | 85: msg := 'guard or test type is not an extension of variable type'
+ | 86: msg := 'guard or testtype is not a pointer'
+ | 87: msg := 'guarded or tested variable is neither a pointer nor a VAR- or IN-parameter record'
+ | 88: msg := 'open array not allowed as variable, record field or array element'
+ | 89: msg := 'ANYRECORD may not be allocated'
+ | 90: msg := 'dereferenced variable is not a character array'
+ | 92: msg := 'operand of IN not an integer, or not a set'
+ | 93: msg := 'set element type is not an integer'
+ | 94: msg := 'operand of & is not of type BOOLEAN'
+ | 95: msg := 'operand of OR is not of type BOOLEAN'
+ | 96: msg := 'operand not applicable to (unary) +'
+ | 97: msg := 'operand not applicable to (unary) -'
+ | 98: msg := 'operand of ~ is not of type BOOLEAN'
+ | 99: msg := 'ASSERT fault'
+ | 100: msg := 'incompatible operands of dyadic operator'
+ | 101: msg := 'operand type inapplicable to *'
+ | 102: msg := 'operand type inapplicable to /'
+ | 103: msg := 'operand type inapplicable to DIV'
+ | 104: msg := 'operand type inapplicable to MOD'
+ | 105: msg := 'operand type inapplicable to +'
+ | 106: msg := 'operand type inapplicable to -'
+ | 107: msg := 'operand type inapplicable to = or #'
+ | 108: msg := 'operand type inapplicable to relation'
+ | 109: msg := 'overriding method must be exported'
+ | 110: msg := 'operand is not a type'
+ | 111: msg := 'operand inapplicable to (this) function'
+ | 112: msg := 'operand is not a variable'
+ | 113: msg := 'incompatible assignment'
+ | 114: msg := 'string too long to be assigned'
+ | 115: msg := 'parameter does not match'
+ | 116: msg := 'number of parameters does not match'
+ | 117: msg := 'result type does not match'
+ | 118: msg := 'export mark does not match with forward declaration'
+ | 119: msg := 'redefinition textually precedes procedure bound to base type'
+ | 120: msg := 'type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN'
+ | 121: msg := 'called object is not a procedure'
+ | 122: msg := 'actual VAR-, IN-, or OUT-parameter is not a variable'
+ | 123: msg := 'type is not identical with that of formal VAR-, IN-, or OUT-parameter'
+ | 124: msg := 'type of result expression differs from that of procedure'
+ | 125: msg := 'type of case expression is neither INTEGER nor CHAR'
+ | 126: msg := 'this expression cannot be a type or a procedure'
+ | 127: msg := 'illegal use of object'
+ | 128: msg := 'unsatisfied forward reference'
+ | 129: msg := 'unsatisfied forward procedure'
+ | 130: msg := 'WITH clause does not specify a variable'
+ | 131: msg := 'LEN not applied to array'
+ | 132: msg := 'dimension in LEN too large or negative'
+ | 133: msg := 'function without RETURN'
+ | 135: msg := 'SYSTEM not imported'
+ | 136: msg := 'LEN applied to untagged array'
+ | 137: msg := 'unknown array length'
+ | 138: msg := 'NEW not allowed for untagged structures'
+ | 139: msg := 'Test applied to untagged record'
+ | 140: msg := 'untagged receiver'
+ | 141: msg := 'SYSTEM.NEW not implemented'
+ | 142: msg := 'tagged structures not allowed for NIL compatible var parameters'
+ | 143: msg := 'tagged pointer not allowed in untagged structure'
+ | 144: msg := 'no pointers allowed in BYTES argument'
+ | 145: msg := 'untagged open array not allowed as value parameter'
+ | 150: msg := 'key inconsistency of imported module'
+ | 151: msg := 'incorrect symbol file'
+ | 152: msg := 'symbol file of imported module not found'
+ | 153: msg := 'object or symbol file not opened (disk full?)'
+ | 154: msg := 'recursive import not allowed'
+ | 155: msg := 'generation of new symbol file not allowed'
+ | 160: msg := 'interfaces must be extensions of IUnknown'
+ | 161: msg := 'interfaces must not have fields'
+ | 162: msg := 'interface procedures must be abstract'
+ | 163: msg := 'interface records must be abstract'
+ | 164: msg := 'pointer must be extension of queried interface type'
+ | 165: msg := 'illegal guid constant'
+ | 166: msg := 'AddRef & Release may not be used'
+ | 167: msg := 'illegal assignment to [new] parameter'
+ | 168: msg := 'wrong [iid] - [new] pair'
+ | 169: msg := 'must be an interface pointer'
+ | 177: msg := 'IN only allowed for records and arrays'
+ | 178: msg := 'illegal attribute'
+ | 179: msg := 'abstract methods of exported records must be exported'
+ | 180: msg := 'illegal receiver type'
+ | 181: msg := 'base type is not extensible'
+ | 182: msg := 'base procedure is not extensible'
+ | 183: msg := 'non-matching export'
+ | 184: msg := 'Attribute does not match with forward declaration'
+ | 185: msg := 'missing NEW attribute'
+ | 186: msg := 'illegal NEW attribute'
+ | 187: msg := 'new empty procedure in non extensible record'
+ | 188: msg := 'extensible procedure in non extensible record'
+ | 189: msg := 'illegal attribute change'
+ | 190: msg := 'record must be abstract'
+ | 191: msg := 'base type must be abstract'
+ | 192: msg := 'unimplemented abstract procedures in base types'
+ | 193: msg := 'abstract or limited records may not be allocated'
+ | 194: msg := 'no supercall allowed to abstract or empty procedures'
+ | 195: msg := 'empty procedures may not have out parameters or return a value'
+ | 196: msg := 'procedure is implement-only exported'
+ | 197: msg := 'extension of limited type must be limited'
+ | 198: msg := 'obsolete oberon type'
+ | 199: msg := 'obsolete oberon function'
+ | 200: msg := 'not yet implemented'
+ | 201: msg := 'lower bound of set range greater than higher bound'
+ | 202: msg := 'set element greater than MAX(SET) or less than 0'
+ | 203: msg := 'number too large'
+ | 204: msg := 'product too large'
+ | 205: msg := 'division by zero'
+ | 206: msg := 'sum too large'
+ | 207: msg := 'difference too large'
+ | 208: msg := 'overflow in arithmetic shift'
+ | 209: msg := 'case range too large'
+ | 210: msg := 'code too long'
+ | 211: msg := 'jump distance too large'
+ | 212: msg := 'illegal real operation'
+ | 213: msg := 'too many cases in case statement'
+ | 214: msg := 'structure too large'
+ | 215: msg := 'not enough registers: simplify expression'
+ | 216: msg := 'not enough floating-point registers: simplify expression'
+ | 217: msg := 'unimplemented SYSTEM function'
+ | 218: msg := 'illegal value of parameter (0 <= p < 128)'
+ | 219: msg := 'illegal value of parameter (0 <= p < 16)'
+ | 220: msg := 'illegal value of parameter'
+ | 221: msg := 'too many pointers in a record'
+ | 222: msg := 'too many global pointers'
+ | 223: msg := 'too many record types'
+ | 224: msg := 'too many pointer types'
+ | 225: msg := 'illegal sys flag'
+ | 226: msg := 'too many exported procedures'
+ | 227: msg := 'too many imported modules'
+ | 228: msg := 'too many exported structures'
+ | 229: msg := 'too many nested records for import'
+ | 230: msg := 'too many constants (strings) in module'
+ | 231: msg := 'too many link table entries (external procedures)'
+ | 232: msg := 'too many commands in module'
+ | 233: msg := 'record extension hierarchy too high'
+ | 235: msg := 'too many modifiers '
+ | 240: msg := 'identifier too long'
+ | 241: msg := 'string too long'
+ | 242: msg := 'too many meta names'
+ | 243: msg := 'too many imported variables'
+ | 249: msg := 'inconsistent import'
+ | 250: msg := 'code proc must not be exported'
+ | 251: msg := 'too many nested function calls'
+ | 254: msg := 'debug position not found'
+ | 255: msg := 'debug position'
+ | 260: msg := 'illegal LONGINT operation'
+ | 261: msg := 'unsupported mode or size of second argument of SYSTEM.VAL'
+ | 265: msg := 'unsupported string operation'
+ | 270: msg := 'interface pointer reference counting restriction violated'
+ | 301: msg := 'implicit type cast'
+ | 302: msg := 'guarded variable can be side-effected'
+ | 303: msg := 'open array (or pointer to array) containing pointers'
+ | 900: msg := 'never used'
+ | 901: msg := 'never set'
+ | 902: msg := 'used before set'
+ | 903: msg := 'set but never used'
+ | 904: msg := 'used as varpar, possibly not set'
+ | 905: msg := 'also declared in outer scope'
+ | 906: msg := 'access/assignment to intermediate'
+ | 907: msg := 'redefinition'
+ | 908: msg := 'new definition'
+ | 909: msg := 'statement after RETURN/EXIT'
+ | 910: msg := 'for loop variable set'
+ | 911: msg := 'implied type guard'
+ | 912: msg := 'superfluous type guard'
+ | 913: msg := 'call might depend on evaluation sequence of params.'
+ | 930: msg := 'superfluous semicolon'
+ | 401: msg := 'bytecode restriction: no structured assignment'
+ | 402: msg := 'bytecode restriction: no procedure types'
+ | 403: msg := 'bytecode restriction: no nested procedures'
+ | 404: msg := 'bytecode restriction: illegal SYSTEM function'
+ | 410: msg := 'variable may not have been assigned'
+ | 411: msg := 'no proofable return'
+ | 412: msg := 'illegal constructor call'
+ | 413: msg := 'missing constructor call'
+ ELSE Strings.IntToString(err, msg)
+ END
+ END GetErrorMsg;
+
+ PROCEDURE InsertMarks*;
+ VAR i, j, x, y, n, line, col, beg, end: INTEGER; s: ARRAY 128 OF CHAR;
+ BEGIN
+ n := errors;
+ IF n > maxErrors THEN n := maxErrors END;
+ (* sort *)
+ i := 1;
+ WHILE i < n DO
+ x := errPos[i]; y := errNo[i]; j := i-1;
+ WHILE (j >= 0) & (errPos[j] < x) DO
+ errPos[j+1] := errPos[j];
+ errNo[j+1] := errNo[j];
+ DEC(j)
+ END;
+ errPos[j+1] := x; errNo[j+1] := y; INC(i)
+ END;
+ (* insert *)
+ IF n > 0 THEN
+ WHILE n > 0 DO DEC(n);
+ LineColOf(errPos[n], line, col, beg, end);
+ IF name = "" THEN Console.WriteStr("???")
+ ELSE Console.WriteStr(name)
+ END;
+ Console.WriteChar(":");
+ Strings.IntToString(line, s); Console.WriteStr(s);
+ Console.WriteChar(":");
+ Strings.IntToString(col, s); Console.WriteStr(s);
+ Console.WriteChar(":");
+ Strings.IntToString(errPos[n], s); Console.WriteStr(s);
+ Console.WriteStr(": ");
+ GetErrorMsg(errNo[n], s);
+ Console.WriteStr(s);
+ Console.WriteLn;
+ Console.WriteStr(" ");
+ FOR i := beg TO end DO
+ IF in[i] = 09X THEN Console.WriteStr(" ")
+ ELSE Console.WriteChar(in[i])
+ END
+ END;
+ Console.WriteLn;
+ Console.WriteStr(" ");
+ FOR i := 1 TO col - 2 DO
+ Console.WriteChar(" ")
+ END;
+ Console.WriteChar("^");
+ Console.WriteLn;
+ Console.WriteLn
+ END;
+ END
+ END InsertMarks;
+
+
+ (* fingerprinting *)
+
+ PROCEDURE InitCrcTab;
+ (* CRC32, high bit first, pre & post inverted *)
+ CONST poly = {0, 1, 2, 4, 5, 7, 8, 10, 11, 12, 16, 22, 23, 26}; (* CRC32 polynom *)
+ VAR x, c, i: INTEGER;
+ BEGIN
+ x := 0;
+ WHILE x < 256 DO
+ c := x * 1000000H; i := 0;
+ WHILE i < 8 DO
+ IF c < 0 THEN c := ORD(BITS(c * 2) / poly)
+ ELSE c := c * 2
+ END;
+ INC(i)
+ END;
+ crc32tab[ORD(BITS(x) / BITS(255))] := ORD(BITS(c) / BITS(255));
+ INC(x)
+ END
+ END InitCrcTab;
+
+ PROCEDURE FPrint* (VAR fp: INTEGER; val: INTEGER);
+ VAR c: INTEGER;
+ BEGIN
+(*
+ fp := SYSTEM.ROT(ORD(BITS(fp) / BITS(val)), 1) (* bad collision detection *)
+*)
+ (* CRC32, high bit first, pre & post inverted *)
+ c := ORD(BITS(fp * 256) / BITS(crc32tab[ORD(BITS(fp DIV 1000000H) / BITS(val DIV 1000000H)) MOD 256]));
+ c := ORD(BITS(c * 256) / BITS(crc32tab[ORD(BITS(c DIV 1000000H) / BITS(val DIV 10000H)) MOD 256]));
+ c := ORD(BITS(c * 256) / BITS(crc32tab[ORD(BITS(c DIV 1000000H) / BITS(val DIV 100H)) MOD 256]));
+ fp := ORD(BITS(c * 256) / BITS(crc32tab[ORD(BITS(c DIV 1000000H) / BITS(val)) MOD 256]));
+ END FPrint;
+
+ PROCEDURE FPrintSet* (VAR fp: INTEGER; set: SET);
+ BEGIN FPrint(fp, ORD(set))
+ END FPrintSet;
+
+ PROCEDURE FPrintReal* (VAR fp: INTEGER; real: SHORTREAL);
+ BEGIN FPrint(fp, SYSTEM.VAL(INTEGER, real))
+ END FPrintReal;
+
+ PROCEDURE FPrintLReal* (VAR fp: INTEGER; lr: REAL);
+ BEGIN
+ FPrint(fp, LoWord(lr)); FPrint(fp, HiWord(lr))
+ END FPrintLReal;
+
+ PROCEDURE ChkSum (VAR fp: INTEGER; val: INTEGER); (* symbolfile checksum *)
+ BEGIN
+ (* same as FPrint, 8 bit only *)
+ fp := ORD(BITS(fp * 256) / BITS(crc32tab[ORD(BITS(fp DIV 1000000H) / BITS(val)) MOD 256]))
+ END ChkSum;
+
+
+
+ (* compact format *)
+
+ PROCEDURE WriteLInt (w: Files.Writer; i: INTEGER);
+ BEGIN
+ ChkSum(checksum, i);
+ w.WriteByte(SHORT(SHORT(i MOD 256))); i := i DIV 256;
+ ChkSum(checksum, i);
+ w.WriteByte(SHORT(SHORT(i MOD 256))); i := i DIV 256;
+ ChkSum(checksum, i);
+ w.WriteByte(SHORT(SHORT(i MOD 256))); i := i DIV 256;
+ ChkSum(checksum, i);
+ w.WriteByte(SHORT(SHORT(i MOD 256)))
+ END WriteLInt;
+
+ PROCEDURE ReadLInt (r: Files.Reader; VAR i: INTEGER);
+ VAR b: BYTE; x: INTEGER;
+ BEGIN
+ r.ReadByte(b); x := b MOD 256;
+ ChkSum(checksum, b);
+ r.ReadByte(b); x := x + 100H * (b MOD 256);
+ ChkSum(checksum, b);
+ r.ReadByte(b); x := x + 10000H * (b MOD 256);
+ ChkSum(checksum, b);
+ r.ReadByte(b); i := x + 1000000H * b;
+ ChkSum(checksum, b)
+ END ReadLInt;
+
+ PROCEDURE WriteNum (w: Files.Writer; i: INTEGER);
+ BEGIN (* old format of Oberon *)
+ WHILE (i < -64) OR (i > 63) DO ChkSum(checksum, i MOD 128 - 128); w.WriteByte(SHORT(SHORT(i MOD 128 - 128))); i := i DIV 128 END;
+ ChkSum(checksum, i MOD 128);
+ w.WriteByte(SHORT(SHORT(i MOD 128)))
+ END WriteNum;
+
+ PROCEDURE ReadNum (r: Files.Reader; VAR i: INTEGER);
+ VAR b: BYTE; s, y: INTEGER;
+ BEGIN
+ s := 0; y := 0; r.ReadByte(b);
+ IF ~r.eof THEN ChkSum(checksum, b) END;
+ WHILE b < 0 DO INC(y, ASH(b + 128, s)); INC(s, 7); r.ReadByte(b); ChkSum(checksum, b) END;
+ i := ASH((b + 64) MOD 128 - 64, s) + y;
+ END ReadNum;
+
+ PROCEDURE WriteNumSet (w: Files.Writer; x: SET);
+ BEGIN
+ WriteNum(w, ORD(x))
+ END WriteNumSet;
+
+ PROCEDURE ReadNumSet (r: Files.Reader; VAR x: SET);
+ VAR i: INTEGER;
+ BEGIN
+ ReadNum(r, i); x := BITS(i)
+ END ReadNumSet;
+
+ PROCEDURE WriteReal (w: Files.Writer; x: SHORTREAL);
+ BEGIN
+ WriteLInt(w, SYSTEM.VAL(INTEGER, x))
+ END WriteReal;
+
+ PROCEDURE ReadReal (r: Files.Reader; VAR x: SHORTREAL);
+ VAR i: INTEGER;
+ BEGIN
+ ReadLInt(r, i); x := SYSTEM.VAL(SHORTREAL, i)
+ END ReadReal;
+
+ PROCEDURE WriteLReal (w: Files.Writer; x: REAL);
+ BEGIN
+ WriteLInt(w, LoWord(x)); WriteLInt(w, HiWord(x))
+ END WriteLReal;
+
+ PROCEDURE ReadLReal (r: Files.Reader; VAR x: REAL);
+ VAR h, l: INTEGER;
+ BEGIN
+ ReadLInt(r, l); ReadLInt(r, h); x := Compound(l, h)
+ END ReadLReal;
+
+
+ (* read symbol file *)
+
+ PROCEDURE SymRCh* (VAR ch: SHORTCHAR);
+ VAR b: BYTE;
+ BEGIN
+ inSym.ReadByte(b); ch := SHORT(CHR(b));
+ ChkSum(checksum, b)
+ END SymRCh;
+
+ PROCEDURE SymRInt* (): INTEGER;
+ VAR k: INTEGER;
+ BEGIN
+ ReadNum(inSym, k); RETURN k
+ END SymRInt;
+
+ PROCEDURE SymRSet* (VAR s: SET);
+ BEGIN
+ ReadNumSet(inSym, s)
+ END SymRSet;
+
+ PROCEDURE SymRReal* (VAR r: SHORTREAL);
+ BEGIN
+ ReadReal(inSym, r)
+ END SymRReal;
+
+ PROCEDURE SymRLReal* (VAR lr: REAL);
+ BEGIN
+ ReadLReal(inSym, lr)
+ END SymRLReal;
+
+ PROCEDURE eofSF* (): BOOLEAN;
+ BEGIN
+ RETURN inSym.eof
+ END eofSF;
+
+ PROCEDURE OldSym* (IN modName: ARRAY OF SHORTCHAR; VAR done: BOOLEAN);
+ VAR tag: INTEGER; d: Directory;
+
+ PROCEDURE Old (IN path: Files.Name; IN modName: ARRAY OF SHORTCHAR; legacy: BOOLEAN): Files.File;
+ VAR f: Files.File; res: INTEGER; loc: Files.Locator; dir, name: Files.Name;
+ BEGIN
+ Kernel.Utf8ToString(modName, name, res);
+ loc := Files.dir.This(path);
+ IF legacy THEN
+ Kernel.SplitName(name, dir, name);
+ Kernel.MakeFileName(name, Kernel.symType);
+ loc := loc.This(dir).This(symDir);
+ f := Files.dir.Old(loc, name, Files.shared);
+ IF (f = NIL) & (dir = "") THEN
+ loc := Files.dir.This(path).This(SYSdir).This(symDir);
+ f := Files.dir.Old(loc, name, Files.shared)
+ END
+ ELSE
+ Kernel.MakeFileName(name, Kernel.symType);
+ f := Files.dir.Old(loc, name, Files.shared)
+ END;
+ RETURN f
+ END Old;
+
+ BEGIN
+ done := FALSE;
+ IF modName = "@file" THEN
+ oldSymFile := file
+ ELSE
+ oldSymFile := Old(symPath, modName, legacy);
+ d := symList;
+ WHILE (oldSymFile = NIL) & (d # NIL) DO
+ oldSymFile := Old(d.path, modName, d.legacy);
+ d := d.next
+ END
+ END;
+ IF oldSymFile # NIL THEN
+ inSym := oldSymFile.NewReader(inSym);
+ IF inSym # NIL THEN
+ ReadLInt(inSym, tag);
+ IF tag = SFtag THEN done := TRUE ELSE err(151) END
+ END
+ END
+ END OldSym;
+
+ PROCEDURE CloseOldSym*;
+ BEGIN
+ IF oldSymFile # NIL THEN oldSymFile.Close; oldSymFile := NIL END
+ END CloseOldSym;
+
+
+ (* write symbol file *)
+
+ PROCEDURE SymWCh* (ch: SHORTCHAR);
+ BEGIN
+ ChkSum(checksum, ORD(ch));
+ outSym.WriteByte(SHORT(ORD(ch)))
+ END SymWCh;
+
+ PROCEDURE SymWInt* (i: INTEGER);
+ BEGIN
+ WriteNum(outSym, i)
+ END SymWInt;
+
+ PROCEDURE SymWSet* (s: SET);
+ BEGIN
+ WriteNumSet(outSym, s)
+ END SymWSet;
+
+ PROCEDURE SymWReal* (r: SHORTREAL);
+ BEGIN
+ WriteReal(outSym, r)
+ END SymWReal;
+
+ PROCEDURE SymWLReal* (r: REAL);
+ BEGIN
+ WriteLReal(outSym, r)
+ END SymWLReal;
+
+ PROCEDURE SymReset*;
+ BEGIN
+ outSym.SetPos(4)
+ END SymReset;
+
+ PROCEDURE NewSym* (IN modName: ARRAY OF SHORTCHAR);
+ VAR res: INTEGER; loc: Files.Locator; dir: Files.Name;
+ BEGIN
+ Kernel.Utf8ToString(modName, ObjFName, res);
+ loc := Files.dir.This(symPath);
+ IF legacy THEN
+ Kernel.SplitName(ObjFName, dir, ObjFName);
+ loc := loc.This(dir).This(symDir)
+ END;
+ symFile := Files.dir.New(loc, Files.ask);
+ IF symFile # NIL THEN
+ outSym := symFile.NewWriter(NIL);
+ WriteLInt(outSym, SFtag)
+ ELSE
+ err(153)
+ END
+ END NewSym;
+
+ PROCEDURE RegisterNewSym*;
+ VAR res: INTEGER; name: Files.Name;
+ BEGIN
+ IF symFile # NIL THEN
+ name := ObjFName$;
+ Kernel.MakeFileName(name, Kernel.symType);
+ symFile.Register(name, Kernel.symType, Files.ask, res);
+ symFile := NIL
+ END
+ END RegisterNewSym;
+
+ PROCEDURE DeleteNewSym*;
+ BEGIN
+ IF symFile # NIL THEN symFile.Close; symFile := NIL END
+ END DeleteNewSym;
+
+
+ (* write object file *)
+
+ PROCEDURE ObjW* (ch: SHORTCHAR);
+ BEGIN
+ outObj.WriteByte(SHORT(ORD(ch)))
+ END ObjW;
+
+ PROCEDURE ObjWNum* (i: INTEGER);
+ BEGIN
+ WriteNum(outObj, i)
+ END ObjWNum;
+
+ PROCEDURE ObjWInt (i: SHORTINT);
+ BEGIN
+ outObj.WriteByte(SHORT(SHORT(i MOD 256)));
+ outObj.WriteByte(SHORT(SHORT(i DIV 256)))
+ END ObjWInt;
+
+ PROCEDURE ObjWLInt* (i: INTEGER);
+ BEGIN
+ ObjWInt(SHORT(i MOD 65536));
+ ObjWInt(SHORT(i DIV 65536))
+ END ObjWLInt;
+
+ PROCEDURE ObjWBytes* (IN bytes: ARRAY OF SHORTCHAR; n: INTEGER);
+ TYPE P = POINTER TO ARRAY [untagged] 100000H OF BYTE;
+ VAR p: P;
+ BEGIN
+ p := SYSTEM.VAL(P, SYSTEM.ADR(bytes));
+ outObj.WriteBytes(p^, 0, n)
+ END ObjWBytes;
+
+ PROCEDURE ObjLen* (): INTEGER;
+ BEGIN
+ RETURN outObj.Pos()
+ END ObjLen;
+
+ PROCEDURE ObjSet* (pos: INTEGER);
+ BEGIN
+ outObj.SetPos(pos)
+ END ObjSet;
+
+ PROCEDURE NewObj* (IN modName: ARRAY OF SHORTCHAR);
+ VAR res: INTEGER; loc: Files.Locator; dir: Files.Name;
+ BEGIN
+ errpos := 0;
+ Kernel.Utf8ToString(modName, ObjFName, res);
+ loc := Files.dir.This(codePath);
+ IF legacy THEN
+ Kernel.SplitName(ObjFName, dir, ObjFName);
+ loc := loc.This(dir).This(codeDir)
+ END;
+ objFile := Files.dir.New(loc, Files.ask);
+ IF objFile # NIL THEN
+ outObj := objFile.NewWriter(NIL);
+ WriteLInt(outObj, OFtag)
+ ELSE
+ err(153)
+ END
+ END NewObj;
+
+ PROCEDURE RegisterObj*;
+ VAR res: INTEGER; name: Files.Name;
+ BEGIN
+ IF objFile # NIL THEN
+ name := ObjFName$;
+ Kernel.MakeFileName(name, Kernel.objType);
+ objFile.Register(name, Kernel.objType, Files.ask, res);
+ objFile := NIL; outObj := NIL
+ END
+ END RegisterObj;
+
+ PROCEDURE DeleteObj*;
+ BEGIN
+ IF objFile # NIL THEN objFile.Close; objFile := NIL END
+ END DeleteObj;
+
+
+ PROCEDURE InitHost;
+ VAR test: SHORTINT; lo: SHORTCHAR;
+ BEGIN
+ test := 1; SYSTEM.GET(SYSTEM.ADR(test), lo); LEHost := lo = 1X;
+ InfReal := SYSTEM.VAL(SHORTREAL, InfRealPat);
+ MinReal32 := SYSTEM.VAL(SHORTREAL, MinReal32Pat);
+ MaxReal32 := SYSTEM.VAL(SHORTREAL, MaxReal32Pat);
+ MinReal64 := Compound(MinReal64PatL, MinReal64PatH);
+ MaxReal64 := Compound(MaxReal64PatL, MaxReal64PatH)
+ END InitHost;
+
+BEGIN
+ InitCrcTab;
+ InitHost
+END DevCPM.
diff --git a/src/generic/Dev/Mod/CPP.odc b/src/generic/Dev/Mod/CPP.odc
new file mode 100644 (file)
index 0000000..16801dd
Binary files /dev/null and b/src/generic/Dev/Mod/CPP.odc differ
index 0000000..16801dd
Binary files /dev/null and b/src/generic/Dev/Mod/CPP.odc differ
diff --git a/src/generic/Dev/Mod/CPS.odc b/src/generic/Dev/Mod/CPS.odc
new file mode 100644 (file)
index 0000000..0254946
Binary files /dev/null and b/src/generic/Dev/Mod/CPS.odc differ
index 0000000..0254946
Binary files /dev/null and b/src/generic/Dev/Mod/CPS.odc differ
diff --git a/src/generic/Dev/Mod/CPT.odc b/src/generic/Dev/Mod/CPT.odc
new file mode 100644 (file)
index 0000000..a1aba75
Binary files /dev/null and b/src/generic/Dev/Mod/CPT.odc differ
index 0000000..a1aba75
Binary files /dev/null and b/src/generic/Dev/Mod/CPT.odc differ
diff --git a/src/generic/Dev/Mod/CPV486.odc b/src/generic/Dev/Mod/CPV486.odc
new file mode 100644 (file)
index 0000000..f9004c8
Binary files /dev/null and b/src/generic/Dev/Mod/CPV486.odc differ
index 0000000..f9004c8
Binary files /dev/null and b/src/generic/Dev/Mod/CPV486.odc differ
diff --git a/src/generic/Dev2/Mod/LnkBase.odc b/src/generic/Dev2/Mod/LnkBase.odc
new file mode 100644 (file)
index 0000000..08d4814
Binary files /dev/null and b/src/generic/Dev2/Mod/LnkBase.odc differ
index 0000000..08d4814
Binary files /dev/null and b/src/generic/Dev2/Mod/LnkBase.odc differ
diff --git a/src/generic/Dev2/Mod/LnkChmod.odc b/src/generic/Dev2/Mod/LnkChmod.odc
new file mode 100644 (file)
index 0000000..220b6b9
Binary files /dev/null and b/src/generic/Dev2/Mod/LnkChmod.odc differ
index 0000000..220b6b9
Binary files /dev/null and b/src/generic/Dev2/Mod/LnkChmod.odc differ
diff --git a/src/generic/Dev2/Mod/LnkLoad.odc b/src/generic/Dev2/Mod/LnkLoad.odc
new file mode 100644 (file)
index 0000000..4a2f790
Binary files /dev/null and b/src/generic/Dev2/Mod/LnkLoad.odc differ
index 0000000..4a2f790
Binary files /dev/null and b/src/generic/Dev2/Mod/LnkLoad.odc differ
diff --git a/src/generic/Dev2/Mod/LnkWriteElf.odc b/src/generic/Dev2/Mod/LnkWriteElf.odc
new file mode 100644 (file)
index 0000000..2db9dea
Binary files /dev/null and b/src/generic/Dev2/Mod/LnkWriteElf.odc differ
index 0000000..2db9dea
Binary files /dev/null and b/src/generic/Dev2/Mod/LnkWriteElf.odc differ
diff --git a/src/generic/Dev2/Mod/LnkWriteElfStatic.odc b/src/generic/Dev2/Mod/LnkWriteElfStatic.odc
new file mode 100644 (file)
index 0000000..3ca7d6d
Binary files /dev/null and b/src/generic/Dev2/Mod/LnkWriteElfStatic.odc differ
index 0000000..3ca7d6d
Binary files /dev/null and b/src/generic/Dev2/Mod/LnkWriteElfStatic.odc differ
diff --git a/src/generic/Dev2/Mod/LnkWritePe.odc b/src/generic/Dev2/Mod/LnkWritePe.odc
new file mode 100644 (file)
index 0000000..16c4dcf
Binary files /dev/null and b/src/generic/Dev2/Mod/LnkWritePe.odc differ
index 0000000..16c4dcf
Binary files /dev/null and b/src/generic/Dev2/Mod/LnkWritePe.odc differ
diff --git a/src/generic/Dsw/Mod/Compiler486Main.cp b/src/generic/Dsw/Mod/Compiler486Main.cp
--- /dev/null
@@ -0,0 +1,320 @@
+MODULE DswCompiler486Main;
+
+ IMPORT Kernel, HostFiles, Files, Console, Strings, DswDocuments,
+ DevCPM, DevCPT, DevCPB, DevCPP, DevCPE, DevCPV := DevCPV486, DevCPS,
+ DevCPH;
+
+ CONST
+ (* compiler options: *)
+ checks = 0; allchecks = 1; assert = 2; obj = 3; ref = 4; allref = 5;
+ srcpos = 6; reallib = 7; signatures = 8;
+ hint = 29; oberon = 30; errorTrap = 31;
+ defopt = {checks, assert, obj, ref, allref, srcpos, signatures};
+
+ emulong = 0;
+ defopt2 = {};
+
+ TYPE
+ Elem = POINTER TO RECORD
+ dir, name, path: Files.Name;
+ outsym, outcode: Files.Name; (* dir *)
+ insym: DevCPM.Directory;
+ found: BOOLEAN; (* COM Aware *)
+ opts, opts2: SET;
+ next: Elem
+ END;
+
+ VAR
+ u: Elem;
+
+ PROCEDURE GetPath (IN path: ARRAY OF CHAR; OUT dir, name: Files.Name);
+ VAR i, j, len: INTEGER;
+ BEGIN
+ len := LEN(path$);
+ i := len - 1;
+ WHILE (i >= 0) & (path[i] # '/') DO DEC(i) END;
+ IF i >= 0 THEN
+ FOR i := 0 TO i - 1 DO
+ dir[i] := path[i]
+ END;
+ dir[i] := 0X
+ ELSE
+ dir := ""
+ END;
+ j := i + 1; i := 0;
+ WHILE path[j] # 0X DO
+ name[i] := path[j];
+ INC(i); INC(j)
+ END;
+ name[i] := 0X
+ END GetPath;
+
+ PROCEDURE InitOptions;
+ VAR
+ i: INTEGER;
+ found: BOOLEAN;
+ insym, sym: DevCPM.Directory;
+ outsym, outcode: Files.Name;
+ p: ARRAY 256 OF CHAR;
+ h, t: Elem;
+ opts, opts2: SET;
+
+ PROCEDURE Check;
+ BEGIN
+ IF i >= Kernel.argc THEN
+ Console.WriteStr("required more parameters for ");
+ Console.WriteStr(p); Console.WriteLn;
+ Kernel.Quit(1)
+ END
+ END Check;
+
+ BEGIN
+ outsym := ""; outcode := "";
+ opts := defopt; opts2 := defopt2; found := FALSE;
+ h := NIL; t := NIL; insym := NIL;
+ i := 1;
+ WHILE i < Kernel.argc DO
+ IF Kernel.argv[i, 0] = "-" THEN
+ p := Kernel.argv[i]$;
+ INC(i);
+ IF p = "-legacy" THEN
+ DevCPM.legacy := TRUE
+ ELSIF p = "-outsym" THEN
+ Check;
+ outsym := Kernel.argv[i]$;
+ INC(i)
+ ELSIF p = "-outcode" THEN
+ Check;
+ outcode := Kernel.argv[i]$;
+ INC(i)
+ ELSIF p = "-symdir" THEN
+ Check;
+ sym := insym;
+ NEW(insym);
+ insym.path := Kernel.argv[i]$;
+ insym.legacy := FALSE;
+ insym.next := sym;
+ INC(i)
+ ELSIF p = "-legacysymdir" THEN
+ Check;
+ sym := insym;
+ NEW(insym);
+ insym.path := Kernel.argv[i]$;
+ insym.legacy := TRUE;
+ insym.next := sym;
+ INC(i)
+ ELSIF p = "-allchecks" THEN
+ INCL(opts, allchecks)
+ ELSIF p = "-no-allchecks" THEN
+ EXCL(opts, allchecks)
+ ELSIF p = "-srcpos" THEN
+ INCL(opts, srcpos)
+ ELSIF p = "-no-srcpos" THEN
+ EXCL(opts, srcpos)
+ ELSIF p = "-structref" THEN
+ INCL(opts, allref)
+ ELSIF p = "-no-structref" THEN
+ EXCL(opts, allref)
+ ELSIF p = "-ref" THEN
+ INCL(opts, ref)
+ ELSIF p = "-no-ref" THEN
+ EXCL(opts, ref)
+ ELSIF p = "-obj" THEN
+ INCL(opts, obj)
+ ELSIF p = "-no-obj" THEN
+ EXCL(opts, obj)
+ ELSIF p = "-assert" THEN
+ INCL(opts, assert)
+ ELSIF p = "-no-assert" THEN
+ EXCL(opts, assert)
+ ELSIF p = "-checks" THEN
+ INCL(opts, checks)
+ ELSIF p = "-no-checks" THEN
+ EXCL(opts, checks)
+ ELSIF p = "-hints" THEN
+ INCL(opts, hint)
+ ELSIF p = "-no-hints" THEN
+ EXCL(opts, hint)
+ ELSIF p = "-trap" THEN
+ INCL(opts, errorTrap)
+ ELSIF p = "-no-trap" THEN
+ EXCL(opts, errorTrap)
+ ELSIF p = "-oberon" THEN
+ INCL(opts, oberon)
+ ELSIF p = "-no-oberon" THEN
+ EXCL(opts, oberon)
+ ELSIF p = "-com-aware" THEN
+ found := TRUE
+ ELSIF p = "-no-com-aware" THEN
+ found := FALSE
+ ELSIF (p = "-v") OR (p = "-verbose") THEN
+ DevCPM.verbose := MIN(DevCPM.verbose + 1, 3);
+ ELSIF p = "-main" THEN
+ (* ignore *)
+ ELSIF p = "-no-main" THEN
+ (* ignore *)
+ ELSIF p = "-include0" THEN
+ (* ignore *)
+ ELSIF p = "-no-include0" THEN
+ (* ignore *)
+ ELSIF p = "-includedir" THEN
+ Check;
+ (* ignore *)
+ INC(i)
+ ELSIF p = "-long-calls" THEN
+ INCL(opts2, emulong)
+ ELSIF p = "-no-long-calls" THEN
+ EXCL(opts2, emulong)
+ ELSE
+ Console.WriteStr("unknown option ");
+ Console.WriteStr(p); Console.WriteLn;
+ Kernel.Quit(1)
+ END
+ ELSE
+ IF h = NIL THEN NEW(h); t := h
+ ELSE NEW(t.next); t := t.next
+ END;
+ t.path := Kernel.argv[i]$;
+ t.outcode := outcode;
+ t.outsym := outsym;
+ t.insym := insym;
+ t.found := found;
+ t.opts := opts;
+ t.opts2 := opts2;
+ GetPath(t.path, t.dir, t.name);
+ IF t.name = "" THEN
+ Console.WriteStr("specified path to directory"); Console.WriteLn;
+ Kernel.Quit(1)
+ END;
+ INC(i)
+ END
+ END;
+ u := h
+ END InitOptions;
+
+ PROCEDURE Module (source: POINTER TO ARRAY OF CHAR; m: Elem; OUT error: BOOLEAN);
+ VAR ext, new: BOOLEAN; p: DevCPT.Node;
+ BEGIN
+ DevCPM.Init(source);
+ DevCPM.symList := m.insym;
+ DevCPM.codePath := m.outcode;
+ DevCPM.symPath := m.outsym;
+ DevCPM.name := m.path;
+ IF m.found THEN INCL(DevCPM.options, DevCPM.comAware) END;
+ IF errorTrap IN m.opts THEN INCL(DevCPM.options, DevCPM.trap) END;
+ IF oberon IN m.opts THEN INCL(DevCPM.options, DevCPM.oberon) END;
+ DevCPT.Init(m.opts);
+ DevCPB.typSize := DevCPV.TypeSize;
+ DevCPT.processor := DevCPV.processor;
+ DevCPP.Module(p);
+ IF DevCPM.noerr THEN
+ IF DevCPT.libName # "" THEN EXCL(m.opts, obj) END;
+ DevCPV.Init(m.opts); DevCPV.Allocate; DevCPT.Export(ext, new);
+ IF DevCPM.noerr & (obj IN m.opts) THEN
+ IF emulong IN m.opts2 THEN
+ DevCPH.UseCalls(p, {DevCPH.longMop, DevCPH.longDop})
+ END;
+ DevCPV.Module(p)
+ END;
+ DevCPV.Close
+ END;
+ IF DevCPM.noerr & (new OR ext) THEN DevCPM.RegisterNewSym
+ ELSE DevCPM.DeleteNewSym
+ END;
+ DevCPT.Close;
+ error := ~DevCPM.noerr;
+ IF error THEN
+ DevCPM.InsertMarks;
+ IF DevCPM.verbose > 0 THEN DevCPM.LogWStr(" ") END;
+ IF DevCPM.errors = 1 THEN
+ DevCPM.LogWStr("one error detected")
+ ELSE
+ DevCPM.LogWNum(DevCPM.errors, 0); DevCPM.LogWStr(" errors detected")
+ END;
+ DevCPM.LogWLn
+ ELSE
+ IF hint IN m.opts THEN DevCPM.InsertMarks END
+ END;
+ DevCPM.Close;
+ p := NIL;
+ Kernel.FastCollect
+ END Module;
+
+ PROCEDURE ReadText (s: Elem): POINTER TO ARRAY OF CHAR;
+ VAR
+ i, len, res: INTEGER;
+ text: DswDocuments.Text;
+ loc: Files.Locator; f: Files.File; r: Files.Reader;
+ ssrc: POINTER TO ARRAY OF SHORTCHAR;
+ src: POINTER TO ARRAY OF CHAR;
+ x: POINTER TO ARRAY OF BYTE;
+ num: ARRAY 32 OF CHAR;
+ BEGIN
+ src := NIL;
+ loc := Files.dir.This(s.dir);
+ DswDocuments.Import(loc, s.name, text, res);
+ Strings.IntToString(res, num);
+ IF res = 0 THEN
+ src := text.t
+ ELSIF res = 2 THEN
+ f := Files.dir.Old(loc, s.name, Files.shared);
+ IF f # NIL THEN
+ len := f.Length();
+ r := f.NewReader(NIL);
+ NEW(x, len + 1);
+ r.ReadBytes(x, 0, len);
+ NEW(ssrc, len + 1);
+ FOR i := 0 TO len - 1 DO
+ ssrc[i] := SHORT(CHR(x[i]))
+ END;
+ ssrc[i] := 0X;
+ x := NIL;
+ NEW(src, len + 1);
+ Kernel.Utf8ToString(ssrc, src, res);
+ ssrc := NIL;
+ f.Close
+ END
+ ELSE
+ IF DevCPM.verbose > 0 THEN
+ Console.WriteStr("document error ");
+ Console.WriteStr(num);
+ Console.WriteLn
+ END
+ END;
+ IF src = NIL THEN
+ Console.WriteStr("unable to open file ");
+ Console.WriteStr(s.path);
+ Console.WriteLn;
+ Kernel.Quit(1)
+ END;
+ RETURN src
+ END ReadText;
+
+ PROCEDURE CompileAll;
+ VAR loc: Files.Locator; m: Elem; error: BOOLEAN; src: POINTER TO ARRAY OF CHAR;
+ BEGIN
+ m := u;
+ WHILE m # NIL DO
+ IF DevCPM.verbose > 0 THEN
+ Console.WriteStr("compiling "); Console.WriteStr(m.path); Console.WriteLn
+ END;
+ src := ReadText(m);
+ Module(src, m, error);
+ IF error THEN Kernel.Quit(1) END;
+ m := m.next
+ END
+ END CompileAll;
+
+ PROCEDURE Init;
+ BEGIN
+ IF Kernel.trapCount # 0 THEN Kernel.Quit(1) END;
+ HostFiles.SetRootDir(".");
+ InitOptions;
+ CompileAll;
+ Kernel.Quit(0)
+ END Init;
+
+BEGIN
+ Kernel.Start(Init)
+END DswCompiler486Main.
+
diff --git a/src/generic/Dsw/Mod/CompilerCPfrontMain.cp b/src/generic/Dsw/Mod/CompilerCPfrontMain.cp
--- /dev/null
@@ -0,0 +1,338 @@
+MODULE DswCompilerCPfrontMain;
+
+ IMPORT Kernel, HostFiles, Files, Console, Strings, DswDocuments,
+ DevCPM, DevCPT, DevCPB, DevCPP, DevCPE, DevCPH, DevCPV := CPfrontCPV, DevCPG := CPfrontCPG;
+
+ CONST
+ (* compiler options: *)
+ checks = 0; allchecks = 1; assert = 2; obj = 3; ref = 4; allref = 5;
+ srcpos = 6; reallib = 7; signatures = 8;
+ mainprog = 20; include0 = 21;
+ hint = 29; oberon = 30; errorTrap = 31;
+ (* defopt = {checks, assert, obj, ref, allref, srcpos, signatures}; *)
+ defopt = {checks, assert, obj};
+
+ emulong = 0;
+ defopt2 = {};
+
+ TYPE
+ Elem = POINTER TO RECORD
+ dir, name, path: Files.Name;
+ outsym, outcode: Files.Name; (* dir *)
+ insym: DevCPM.Directory;
+ found: BOOLEAN; (* COM Aware *)
+ opts, opts2: SET;
+ next: Elem
+ END;
+
+ VAR
+ u: Elem;
+
+ PROCEDURE GetPath (IN path: ARRAY OF CHAR; OUT dir, name: Files.Name);
+ VAR i, j, len: INTEGER;
+ BEGIN
+ len := LEN(path$);
+ i := len - 1;
+ WHILE (i >= 0) & (path[i] # '/') DO DEC(i) END;
+ IF i >= 0 THEN
+ FOR i := 0 TO i - 1 DO
+ dir[i] := path[i]
+ END;
+ dir[i] := 0X
+ ELSE
+ dir := ""
+ END;
+ j := i + 1; i := 0;
+ WHILE path[j] # 0X DO
+ name[i] := path[j];
+ INC(i); INC(j)
+ END;
+ name[i] := 0X
+ END GetPath;
+
+ PROCEDURE InitOptions;
+ VAR
+ i: INTEGER;
+ found: BOOLEAN;
+ insym, sym: DevCPM.Directory;
+ outsym, outcode: Files.Name;
+ p: ARRAY 256 OF CHAR;
+ h, t: Elem;
+ opts, opts2: SET;
+
+ PROCEDURE Check;
+ BEGIN
+ IF i >= Kernel.argc THEN
+ Console.WriteStr("required more parameters for ");
+ Console.WriteStr(p); Console.WriteLn;
+ Kernel.Quit(1)
+ END
+ END Check;
+
+ BEGIN
+ outsym := ""; outcode := "";
+ opts := defopt; opts2 := defopt2; found := FALSE;
+ h := NIL; t := NIL; insym := NIL;
+ i := 1;
+ WHILE i < Kernel.argc DO
+ IF Kernel.argv[i, 0] = "-" THEN
+ p := Kernel.argv[i]$;
+ INC(i);
+ IF p = "-legacy" THEN
+ DevCPM.legacy := TRUE
+ ELSIF p = "-outsym" THEN
+ Check;
+ outsym := Kernel.argv[i]$;
+ INC(i)
+ ELSIF p = "-outcode" THEN
+ Check;
+ outcode := Kernel.argv[i]$;
+ INC(i)
+ ELSIF p = "-symdir" THEN
+ Check;
+ sym := insym;
+ NEW(insym);
+ insym.path := Kernel.argv[i]$;
+ insym.legacy := FALSE;
+ insym.next := sym;
+ INC(i)
+ ELSIF p = "-legacysymdir" THEN
+ Check;
+ sym := insym;
+ NEW(insym);
+ insym.path := Kernel.argv[i]$;
+ insym.legacy := TRUE;
+ insym.next := sym;
+ INC(i)
+ ELSIF p = "-allchecks" THEN
+ INCL(opts, allchecks)
+ ELSIF p = "-no-allchecks" THEN
+ EXCL(opts, allchecks)
+ ELSIF p = "-srcpos" THEN
+ INCL(opts, srcpos)
+ ELSIF p = "-no-srcpos" THEN
+ EXCL(opts, srcpos)
+ ELSIF p = "-structref" THEN
+ INCL(opts, allref)
+ ELSIF p = "-no-structref" THEN
+ EXCL(opts, allref)
+ ELSIF p = "-ref" THEN
+ INCL(opts, ref)
+ ELSIF p = "-no-ref" THEN
+ EXCL(opts, ref)
+ ELSIF p = "-obj" THEN
+ INCL(opts, obj)
+ ELSIF p = "-no-obj" THEN
+ EXCL(opts, obj)
+ ELSIF p = "-assert" THEN
+ INCL(opts, assert)
+ ELSIF p = "-no-assert" THEN
+ EXCL(opts, assert)
+ ELSIF p = "-checks" THEN
+ INCL(opts, checks)
+ ELSIF p = "-no-checks" THEN
+ EXCL(opts, checks)
+ ELSIF p = "-hints" THEN
+ INCL(opts, hint)
+ ELSIF p = "-no-hints" THEN
+ EXCL(opts, hint)
+ ELSIF p = "-trap" THEN
+ INCL(opts, errorTrap)
+ ELSIF p = "-no-trap" THEN
+ EXCL(opts, errorTrap)
+ ELSIF p = "-oberon" THEN
+ INCL(opts, oberon)
+ ELSIF p = "-no-oberon" THEN
+ EXCL(opts, oberon)
+ ELSIF p = "-com-aware" THEN
+ found := TRUE
+ ELSIF p = "-no-com-aware" THEN
+ found := FALSE
+ ELSIF (p = "-v") OR (p = "-verbose") THEN
+ DevCPM.verbose := MIN(DevCPM.verbose + 1, 3)
+ ELSIF p = "-main" THEN
+ INCL(opts, mainprog)
+ ELSIF p = "-no-main" THEN
+ EXCL(opts, mainprog)
+ ELSIF p = "-include0" THEN
+ INCL(opts, include0)
+ ELSIF p = "-no-include0" THEN
+ EXCL(opts, include0)
+ ELSIF p = "-includedir" THEN
+ Check;
+ DevCPG.includePath := Kernel.argv[i]$;
+ INC(i)
+ ELSIF p = "-long-calls" THEN
+ INCL(opts2, emulong)
+ ELSIF p = "-no-long-calls" THEN
+ EXCL(opts2, emulong)
+ ELSE
+ Console.WriteStr("unknown option ");
+ Console.WriteStr(p); Console.WriteLn;
+ Kernel.Quit(1)
+ END
+ ELSE
+ IF h = NIL THEN NEW(h); t := h
+ ELSE NEW(t.next); t := t.next
+ END;
+ t.path := Kernel.argv[i]$;
+ t.outcode := outcode;
+ t.outsym := outsym;
+ t.insym := insym;
+ t.found := found;
+ t.opts := opts;
+ t.opts2 := opts2;
+ GetPath(t.path, t.dir, t.name);
+ IF t.name = "" THEN
+ Console.WriteStr("specified path to directory"); Console.WriteLn;
+ Kernel.Quit(1)
+ END;
+ INC(i)
+ END
+ END;
+ u := h
+ END InitOptions;
+
+ PROCEDURE Module (source: POINTER TO ARRAY OF CHAR; m: Elem; OUT error: BOOLEAN);
+ VAR ext, new: BOOLEAN; p: DevCPT.Node;
+ BEGIN
+ DevCPG.opt := {}; (* !!! *)
+ DevCPM.Init(source);
+ DevCPM.symList := m.insym;
+ DevCPM.codePath := m.outcode;
+ DevCPM.symPath := m.outsym;
+ DevCPM.name := m.path;
+ INCL(DevCPM.options, 10); (* !!! allow [ccall] *)
+ INCL(DevCPM.options, DevCPM.allSysVal); (* !!! make nodes for all SYSTEM.VAL *)
+ INCL(DevCPG.opt, DevCPG.ansi); (* !!! *)
+ IF m.found THEN INCL(DevCPM.options, DevCPM.comAware) END;
+ IF errorTrap IN m.opts THEN INCL(DevCPM.options, DevCPM.trap) END;
+ IF oberon IN m.opts THEN INCL(DevCPM.options, DevCPM.oberon) END;
+ IF mainprog IN m.opts THEN INCL(DevCPG.opt, DevCPG.mainprog) END;
+ IF include0 IN m.opts THEN INCL(DevCPG.opt, DevCPG.include0) END;
+ DevCPT.Init(m.opts);
+ (* DevCPB.typSize := DevCPV.TypeSize; *)
+ DevCPB.typSize := DevCPV.TypSize;
+ DevCPT.processor := DevCPV.processor;
+ DevCPP.Module(p);
+ IF DevCPM.noerr THEN
+ IF DevCPT.libName # "" THEN EXCL(m.opts, obj) END;
+ DevCPV.Init(m.opts); DevCPV.AdrAndSize(DevCPT.topScope); DevCPT.Export(ext, new);
+ IF DevCPM.noerr & (obj IN m.opts) THEN
+ DevCPG.OpenFiles(DevCPT.SelfName);
+ IF emulong IN m.opts2 THEN
+ DevCPH.UseCalls(p, {DevCPH.longMop, DevCPH.longDop, DevCPH.longConv, DevCPH.longOdd});
+ END;
+ DevCPV.Module(p)
+ END;
+ (* DevCPV.Close *)
+ END;
+ IF DevCPM.noerr & (DevCPG.mainprog IN DevCPG.opt) & (DevCPG.modName # "SYSTEM") THEN
+ DevCPM.DeleteNewSym;
+ IF DevCPM.verbose > 0 THEN
+ DevCPM.LogWStr(" main program"); DevCPM.LogWLn
+ END
+ ELSIF DevCPM.noerr & (new OR ext) THEN
+ DevCPM.RegisterNewSym
+ ELSE
+ DevCPM.DeleteNewSym
+ END;
+ IF obj IN m.opts THEN
+ DevCPG.CloseFiles
+ END;
+ DevCPT.Close;
+ error := ~DevCPM.noerr;
+ IF error THEN
+ DevCPM.InsertMarks;
+ IF DevCPM.verbose > 0 THEN DevCPM.LogWStr(" ") END;
+ IF DevCPM.errors = 1 THEN
+ DevCPM.LogWStr("one error detected");
+ ELSE
+ DevCPM.LogWNum(DevCPM.errors, 0); DevCPM.LogWStr(" errors detected")
+ END;
+ DevCPM.LogWLn
+ ELSE
+ IF hint IN m.opts THEN DevCPM.InsertMarks END
+ END;
+ DevCPM.Close;
+ p := NIL;
+ Kernel.FastCollect
+ END Module;
+
+ PROCEDURE ReadText (s: Elem): POINTER TO ARRAY OF CHAR;
+ VAR
+ i, len, res: INTEGER;
+ text: DswDocuments.Text;
+ loc: Files.Locator; f: Files.File; r: Files.Reader;
+ ssrc: POINTER TO ARRAY OF SHORTCHAR;
+ src: POINTER TO ARRAY OF CHAR;
+ x: POINTER TO ARRAY OF BYTE;
+ num: ARRAY 32 OF CHAR;
+ BEGIN
+ src := NIL;
+ loc := Files.dir.This(s.dir);
+ DswDocuments.Import(loc, s.name, text, res);
+ Strings.IntToString(res, num);
+ IF res = 0 THEN
+ src := text.t
+ ELSIF res = 2 THEN
+ f := Files.dir.Old(loc, s.name, Files.shared);
+ IF f # NIL THEN
+ len := f.Length();
+ r := f.NewReader(NIL);
+ NEW(x, len + 1);
+ r.ReadBytes(x, 0, len);
+ NEW(ssrc, len + 1);
+ FOR i := 0 TO len - 1 DO
+ ssrc[i] := SHORT(CHR(x[i]))
+ END;
+ ssrc[i] := 0X;
+ x := NIL;
+ NEW(src, len + 1);
+ Kernel.Utf8ToString(ssrc, src, res);
+ ssrc := NIL;
+ f.Close
+ END
+ ELSE
+ IF DevCPM.verbose > 0 THEN
+ Console.WriteStr("document error ");
+ Console.WriteStr(num);
+ Console.WriteLn
+ END
+ END;
+ IF src = NIL THEN
+ Console.WriteStr("unable to open file ");
+ Console.WriteStr(s.path);
+ Console.WriteLn;
+ Kernel.Quit(1)
+ END;
+ RETURN src
+ END ReadText;
+
+ PROCEDURE CompileAll;
+ VAR loc: Files.Locator; m: Elem; error: BOOLEAN; src: POINTER TO ARRAY OF CHAR;
+ BEGIN
+ m := u;
+ WHILE m # NIL DO
+ IF DevCPM.verbose > 0 THEN
+ Console.WriteStr("compiling "); Console.WriteStr(m.path); Console.WriteLn
+ END;
+ src := ReadText(m);
+ Module(src, m, error);
+ IF error THEN Kernel.Quit(1) END;
+ m := m.next
+ END
+ END CompileAll;
+
+ PROCEDURE Init;
+ BEGIN
+ IF Kernel.trapCount # 0 THEN Kernel.Quit(1) END;
+ HostFiles.SetRootDir(".");
+ InitOptions;
+ CompileAll;
+ Kernel.Quit(0)
+ END Init;
+
+BEGIN
+ Kernel.Start(Init)
+END DswCompilerCPfrontMain.
diff --git a/src/generic/Dsw/Mod/Debug.odc b/src/generic/Dsw/Mod/Debug.odc
new file mode 100644 (file)
index 0000000..743e205
Binary files /dev/null and b/src/generic/Dsw/Mod/Debug.odc differ
index 0000000..743e205
Binary files /dev/null and b/src/generic/Dsw/Mod/Debug.odc differ
diff --git a/src/generic/Dsw/Mod/Documents.cp b/src/generic/Dsw/Mod/Documents.cp
--- /dev/null
@@ -0,0 +1,233 @@
+MODULE DswDocuments;
+
+ IMPORT Files;
+
+ (* !!! make better store type and version checking *)
+
+ TYPE
+ Name = ARRAY 256 OF SHORTCHAR;
+
+ Store = RECORD
+ (* type: Name; *)
+ next, down, len: INTEGER;
+ pos, end: INTEGER;
+ isElem: BOOLEAN;
+ END;
+
+ Text* = POINTER TO RECORD
+ t*: POINTER TO ARRAY OF CHAR;
+ END;
+
+ PROCEDURE Import* (loc: Files.Locator; IN name: Files.Name; OUT text: Text; OUT res: INTEGER);
+ CONST
+ docTag = 6F4F4443H; docVersion = 0;
+ Step = 256;
+ VAR f: Files.File; r: Files.Reader; tag, version, chid: INTEGER; s: Store;
+
+ PROCEDURE AddChar (ch: CHAR);
+ VAR i, len: INTEGER; t: POINTER TO ARRAY OF CHAR;
+ BEGIN
+ IF text = NIL THEN
+ NEW(text); NEW(text.t, Step); chid := 0
+ END;
+ len := LEN(text.t);
+ IF chid + 1 >= len THEN
+ NEW(t, len + Step);
+ FOR i := 0 TO len - 1 DO
+ t[i] := text.t[i]
+ END;
+ text.t := t
+ END;
+ text.t[chid] := ch; INC(chid);
+ text.t[chid] := 0X;
+ END AddChar;
+
+ PROCEDURE ReadSChar (OUT x: SHORTCHAR);
+ VAR i: BYTE;
+ BEGIN
+ r.ReadByte(i);
+ x := SHORT(CHR(i MOD 256))
+ END ReadSChar;
+
+ PROCEDURE ReadInt (OUT x: INTEGER);
+ VAR i: ARRAY 4 OF BYTE;
+ BEGIN
+ r.ReadBytes(i, 0, 4);
+ x := i[0] MOD 256 + i[1] MOD 256 * 256 + i[2] MOD 256 * 65536 + i[3] MOD 256 * 16777216
+ END ReadInt;
+
+ PROCEDURE ReadBool (OUT x: BOOLEAN);
+ VAR i: SHORTCHAR;
+ BEGIN
+ ReadSChar(i);
+ x := i # 0X
+ END ReadBool;
+
+ PROCEDURE ReadStore (OUT s: Store);
+ CONST
+ storeVersion = 0X;
+ newBase = 0F0X; newExt = 0F1X; oldType = 0F2X;
+ nil = 80X; link = 81X; store = 82X; elem = 83X; newlink = 84X;
+ elemTName = "Stores.ElemDesc"; modelTName = "Models.ModelDesc"; (* from pre-1.3 *)
+ VAR
+ tag, version, ch: SHORTCHAR; i, x: INTEGER;
+ BEGIN
+ ReadSChar(tag); s.isElem := tag = elem;
+ ASSERT((tag = store) OR (tag = elem), 100);
+ ReadSChar(tag);
+ WHILE tag = newExt DO
+ REPEAT ReadSChar(ch) UNTIL ch = 0X;
+ ReadSChar(tag)
+ END;
+ IF tag = newBase THEN (* !!! get base types *)
+ REPEAT ReadSChar(ch) UNTIL ch = 0X;
+ ELSIF tag = oldType THEN
+ ReadInt(x) (* !!! get from dictionary *)
+ ELSE
+ HALT(102)
+ END;
+ ReadInt(x); (* extension hook = 00000000 *)
+ ReadInt(s.next); s.next := s.next + r.Pos();
+ ReadInt(s.down); s.down := s.down + r.Pos();
+ ReadInt(s.len); s.pos := r.Pos(); s.end := s.pos + s.len;
+ ReadSChar(version); (* version *)
+ ASSERT(version = storeVersion, 103);
+ IF s.isElem THEN
+ ReadSChar(version);
+ ASSERT(version = storeVersion, 104)
+ END
+ END ReadStore;
+
+ PROCEDURE ReadStdTextModel;
+ CONST
+ dictSize = 32;
+ noLCharStdModelVersion = 0; stdModelVersion = 1;
+ VAR
+ s: Store;
+ version, ano: BYTE;
+ org, len, dictlen, i, w, h: INTEGER;
+ R: Files.Reader;
+ x: ARRAY 2 OF BYTE;
+ ch: CHAR;
+ BEGIN
+ r.ReadByte(version);
+ IF version IN {noLCharStdModelVersion, stdModelVersion} THEN
+ ReadInt(org); org := org + r.Pos(); R := f.NewReader(NIL); R.SetPos(org);
+ r.ReadByte(ano); dictlen := 0;
+ WHILE ano # -1 DO
+ IF ano = dictlen THEN
+ ReadStore(s); r.SetPos(s.end); (* attr IS TextModels.AttributesDesc *)
+ IF dictlen < dictSize THEN (* dictattr[dictlen] := attr *) INC(dictlen) END
+ ELSE
+ (* attr := dictattr[ano] *)
+ END;
+ ReadInt(len);
+ IF len > 0 THEN (* pice *)
+ FOR i := 0 TO len - 1 DO
+ R.ReadByte(x[0]); ch := CHR(x[0] MOD 256); AddChar(ch)
+ END
+ ELSIF len < 0 THEN (* longchar pice *)
+ ASSERT(len MOD 2 = 0);
+ FOR i := 0 TO (-len) DIV 2 - 1 DO
+ R.ReadBytes(x, 0, 2); ch := CHR(x[0] MOD 256 + x[1] MOD 256 * 256); AddChar(ch)
+ END
+ ELSE (* len = 0 => embedded view *)
+ ReadInt(w); ReadInt(h); R.ReadByte(x[0]); (* viewcode!!! *) AddChar(02X);
+ ReadStore(s); r.SetPos(s.end) (* random view type *)
+ END;
+ r.ReadByte(ano)
+ END;
+ res := 0 (* ok *)
+ ELSE
+ res := 4 (* unsupported text model version *)
+ END
+ END ReadStdTextModel;
+
+ PROCEDURE ReadTextModel;
+ CONST
+ modelVersion = 0;
+ conteinerVersion = 0;
+ textModelVersion = 0;
+ VAR
+ s: Store;
+ version: BYTE;
+ BEGIN
+ ReadStore(s);
+ IF TRUE (*s.type = "TextModels.StdModelDesc"*) THEN
+ r.ReadByte(version);
+ IF version = modelVersion THEN (* Models.Model *)
+ r.ReadByte(version);
+ IF version = conteinerVersion THEN (* Containers.Container *)
+ r.ReadByte(version);
+ IF version = textModelVersion THEN (* TextModels.Model *)
+ ReadStdTextModel
+ ELSE
+ res := 4 (* unsupported text model version *)
+ END
+ ELSE
+ res := 4 (* unsupported text model version *)
+ END
+ ELSE
+ res := 4 (* unsupported text model version *)
+ END
+ ELSE
+ res := 3 (* unsupported version *)
+ END
+ END ReadTextModel;
+
+ PROCEDURE ReadDocument;
+ VAR s: Store;
+ BEGIN
+ ReadStore(s);
+ IF TRUE (*s.type = "Documents.StdDocumentDesc"*) THEN
+ r.SetPos(s.down); (* !!! *)
+ ReadStore(s);
+ IF TRUE (*s.type = "Documents.ModelDesc"*) THEN
+ r.SetPos(s.down); (* !!! *)
+ ReadStore(s);
+ IF TRUE (*s.type = "TextViews.StdViewDesc"*) THEN
+ r.SetPos(s.down); (* !!! *)
+ ReadTextModel
+ ELSE
+ res := 3 (* unsupported version *)
+ END
+ ELSE
+ res := 3 (* unsupported version *)
+ END
+ ELSE
+ res := 3 (* unsupported version *)
+ END
+ END ReadDocument;
+
+ BEGIN
+ ASSERT(loc # NIL, 20);
+ ASSERT(name # "", 21);
+ text := NIL;
+ f := Files.dir.Old(loc, name, Files.shared);
+ IF f # NIL THEN
+ IF f.Length() > 8 THEN (* !!! calculate minimal document size *)
+ r := f.NewReader(NIL);
+ ReadInt(tag);
+ IF tag = docTag THEN
+ ReadInt(version);
+ IF version = docVersion THEN
+ ReadDocument;
+ f.Close
+ ELSE
+ f.Close;
+ res := 3 (* unsupported version *)
+ END
+ ELSE
+ f.Close;
+ res := 2 (* not document *)
+ END
+ ELSE
+ f.Close;
+ res := 2 (* not document *)
+ END
+ ELSE
+ res := 1 (* unable to open *)
+ END
+ END Import;
+
+END DswDocuments.
diff --git a/src/generic/Dsw/Mod/EchoMain.cp b/src/generic/Dsw/Mod/EchoMain.cp
--- /dev/null
@@ -0,0 +1,44 @@
+MODULE DswEchoMain;
+
+ (* encoding converter test *)
+
+ IMPORT Kernel, HostLang, Console, Strings;
+
+ PROCEDURE Init;
+ CONST maxBuf = 256;
+ VAR i, j, res: INTEGER; p, x: ARRAY maxBuf OF CHAR;
+ BEGIN
+ IF Kernel.trapCount # 0 THEN Kernel.Quit(1) END;
+ i := 1;
+ WHILE i < Kernel.argc DO
+ HostLang.HostToString(Kernel.argv[i]$, p, TRUE, res);
+ Console.WriteStr(p);
+ IF res # 0 THEN
+ Console.WriteLn;
+ Console.WriteStr("Error: "); Console.WriteChar(CHR(ORD("0") + res MOD 10));
+ Console.WriteLn;
+ Kernel.Quit(1)
+ END;
+ INC(i)
+ END;
+ IF i > 1 THEN Console.WriteLn END;
+
+ i := 1;
+ WHILE i < Kernel.argc DO
+ HostLang.HostToString(Kernel.argv[i]$, p, TRUE, res);
+ j := 0;
+ WHILE p[j] # 0X DO
+ Strings.IntToStringForm(ORD(p[j]), 16, 4, "0", FALSE, x);
+ Console.WriteStr(x);
+ Console.WriteStr(" ");
+ INC(j)
+ END;
+ INC(i)
+ END;
+ IF i > 1 THEN Console.WriteLn END;
+ Kernel.Quit(0)
+ END Init;
+
+BEGIN
+ Kernel.Start(Init)
+END DswEchoMain.
diff --git a/src/generic/Dsw/Mod/Linker486Main.cp b/src/generic/Dsw/Mod/Linker486Main.cp
--- /dev/null
@@ -0,0 +1,259 @@
+MODULE DswLinker486Main;
+
+ IMPORT Kernel, HostFiles, Files, Console, Strings,
+ LB := Dev2LnkBase, Load := Dev2LnkLoad, WrPe := Dev2LnkWritePe,
+ WrElf := Dev2LnkWriteElf, WrElfS := Dev2LnkWriteElfStatic;
+
+ CONST
+ tgtElfStatic = 0; tgtElfExe = 1; tgtElfDll = 2; tgtPeExe = 3; tgtPeDll = 4;
+
+ TYPE
+ Elem = POINTER TO RECORD
+ name: ARRAY 256 OF CHAR;
+ next: Elem
+ END;
+
+ VAR
+ u: Elem;
+ inobj: LB.Directory;
+ outdir, outname: Files.Name;
+ os, interp, main, kernel: ARRAY 256 OF CHAR;
+ static, dll, sinit: BOOLEAN;
+
+ PROCEDURE GetPath (IN path: ARRAY OF CHAR; OUT dir, name: Files.Name);
+ VAR i, j, len: INTEGER;
+ BEGIN
+ len := LEN(path$);
+ i := len - 1;
+ WHILE (i >= 0) & (path[i] # '/') DO DEC(i) END;
+ IF i >= 0 THEN
+ FOR i := 0 TO i - 1 DO
+ dir[i] := path[i]
+ END;
+ dir[i] := 0X
+ ELSE
+ dir := ""
+ END;
+ j := i + 1; i := 0;
+ WHILE path[j] # 0X DO
+ name[i] := path[j];
+ INC(i); INC(j)
+ END;
+ name[i] := 0X
+ END GetPath;
+
+ PROCEDURE InitOptions;
+ VAR i: INTEGER; h, t: Elem; obj: LB.Directory; p: ARRAY 256 OF CHAR;
+
+ PROCEDURE Check;
+ BEGIN
+ IF i >= Kernel.argc THEN
+ Console.WriteStr("required more parameters for ");
+ Console.WriteStr(p); Console.WriteLn;
+ Kernel.Quit(1)
+ END
+ END Check;
+
+ BEGIN
+ i := 1;
+ WHILE i < Kernel.argc DO
+ IF Kernel.argv[i, 0] = "-" THEN
+ p := Kernel.argv[i]$;
+ INC(i);
+ IF p = "-os" THEN
+ Check;
+ Strings.ToLower(Kernel.argv[i]$, os);
+ INC(i)
+ ELSIF p = "-interp" THEN
+ Check;
+ interp := Kernel.argv[i]$;
+ INC(i)
+ ELSIF p = "-o" THEN
+ Check;
+ GetPath(Kernel.argv[i]$, outdir, outname);
+ INC(i)
+ ELSIF p = "-static" THEN
+ static := TRUE
+ ELSIF p = "-dll" THEN
+ dll := TRUE
+ ELSIF p = "-sinit" THEN
+ sinit := TRUE
+ ELSIF (p = "-m") OR (p = "-main") THEN
+ Check;
+ main := Kernel.argv[i]$;
+ INC(i)
+ ELSIF (p = "-k") OR (p = "-kernel") THEN
+ Check;
+ kernel := Kernel.argv[i]$;
+ INC(i)
+ ELSIF p = "-codedir" THEN
+ Check;
+ obj := inobj;
+ NEW(inobj);
+ inobj.path := Kernel.argv[i]$;
+ inobj.legacy := FALSE;
+ inobj.next := obj;
+ INC(i)
+ ELSIF p = "-legacycodedir" THEN
+ Check;
+ obj := inobj;
+ NEW(inobj);
+ inobj.path := Kernel.argv[i]$;
+ inobj.legacy := TRUE;
+ inobj.next := obj;
+ INC(i)
+ ELSIF p = "-trap" THEN
+ LB.trap := TRUE
+ ELSE
+ Console.WriteStr("unknown option ");
+ Console.WriteStr(p); Console.WriteLn;
+ Kernel.Quit(1)
+ END
+ ELSE
+ IF h = NIL THEN NEW(h); t := h
+ ELSE NEW(t.next); t := t.next
+ END;
+ t.name := Kernel.argv[i]$;
+ INC(i)
+ END
+ END;
+ u := h
+ END InitOptions;
+
+ PROCEDURE CheckOptions;
+ BEGIN
+ IF (os = "linux") OR (os = "freebsd") OR (os = "openbsd") THEN
+ IF dll THEN LB.Init(tgtElfDll)
+ ELSIF static THEN LB.Init(tgtElfStatic)
+ ELSE LB.Init(tgtElfExe)
+ END;
+ LB.dynaInit := ~sinit;
+ IF os = "linux" THEN
+ LB.opt.OSABI := WrElf.ELFOSABI_NONE;
+ IF interp = "" THEN LB.opt.elfInterpreter := WrElf.linuxInterpreter
+ ELSE LB.opt.elfInterpreter := SHORT(interp$)
+ END
+ ELSIF os = "freebsd" THEN
+ LB.opt.OSABI := WrElf.ELFOSABI_FREEBSD;
+ IF interp = "" THEN LB.opt.elfInterpreter := WrElf.freeBSDInterpreter
+ ELSE LB.opt.elfInterpreter := SHORT(interp$)
+ END
+ ELSIF os = "openbsd" THEN
+ LB.opt.OSABI := WrElf.ELFOSABI_NONE;
+ IF interp = "" THEN LB.opt.elfInterpreter := WrElf.openBSDInterpreter
+ ELSE LB.opt.elfInterpreter := SHORT(interp$)
+ END
+ ELSE
+ HALT(100)
+ END;
+ IF outname = "" THEN
+ Files.dir.GetFileName("a", "out", outname)
+ END
+ ELSIF os = "win32" THEN
+ IF dll THEN LB.Init(tgtPeDll)
+ ELSE LB.Init(tgtPeExe)
+ END;
+ LB.dynaInit := ~sinit;
+ IF outname = "" THEN
+ Files.dir.GetFileName("a", "exe", outname)
+ END;
+ IF static THEN
+ Console.WriteStr("-static not supported for win32"); Console.WriteLn;
+ Kernel.Quit(1)
+ END;
+ IF interp # "" THEN
+ Console.WriteStr("-interp not supported for win32"); Console.WriteLn;
+ Kernel.Quit(1)
+ END
+ ELSIF os = "" THEN
+ Console.WriteStr("os not specified"); Console.WriteLn;
+ Kernel.Quit(1)
+ ELSE
+ Console.WriteStr("unknown os "); Console.WriteStr(os); Console.WriteLn;
+ Kernel.Quit(1)
+ END;
+ IF main = "" THEN
+ Console.WriteStr("main module not specified"); Console.WriteLn;
+ Kernel.Quit(1)
+ END;
+ IF outname = "" THEN
+ Console.WriteStr("required path to output file"); Console.WriteLn;
+ Kernel.Quit(1)
+ END;
+ IF inobj = NIL THEN
+ Console.WriteStr("required path to input objects"); Console.WriteLn;
+ Kernel.Quit(1)
+ END;
+ LB.objList := inobj;
+ LB.outputPath := outdir;
+ LB.outputName := SHORT(outname$);
+ LB.KernelName := SHORT(kernel$);
+ LB.mainName := SHORT(main$);
+ IF u = NIL THEN
+ Console.WriteStr("no input specified"); Console.WriteLn;
+ Kernel.Quit(1)
+ END;
+ END CheckOptions;
+
+ PROCEDURE LinkAll;
+ VAR m: Elem; codeBase, dataBase, varsBase: INTEGER;
+ BEGIN
+ m := u;
+ WHILE m # NIL DO
+ CASE LB.target OF
+ | tgtElfStatic, tgtElfExe, tgtPeExe: Load.AddModule(m.name)
+ | tgtElfDll, tgtPeDll: Load.ExportModule(m.name)
+ END;
+ m := m.next
+ END;
+ CASE LB.target OF
+ | tgtElfStatic, tgtElfDll, tgtPeDll: (* ok *)
+ | tgtElfExe:
+ IF os = "freebsd" THEN
+ Load.ExportVariable(LB.KernelName$, "__progname");
+ Load.ExportVariable(LB.KernelName$, "environ")
+ END;
+ Load.ExportAll
+ | tgtPeExe:
+ Load.ExportAll
+ END;
+ codeBase := 0; dataBase := 0; varsBase := 0;
+ LB.BeginLinking;
+ IF LB.outPe THEN
+ WrPe.Init;
+ WrPe.GetBases(codeBase, dataBase, varsBase);
+ LB.SetAddr(codeBase, dataBase, varsBase);
+ LB.DoFixups;
+ WrPe.WriteOut
+ ELSIF LB.outElf & LB.opt.elfStatic THEN
+ WrElfS.Init;
+ WrElfS.GetBases(codeBase, dataBase, varsBase);
+ LB.SetAddr(codeBase, dataBase, varsBase);
+ LB.DoFixups;
+ WrElfS.WriteOut
+ ELSIF LB.outElf THEN
+ WrElf.Init;
+ WrElf.GetBases(codeBase, dataBase, varsBase);
+ LB.SetAddr(codeBase, dataBase, varsBase);
+ LB.DoFixups;
+ WrElf.WriteOut
+ END;
+ IF LB.error THEN
+ Console.WriteStr("link failed"); Console.WriteLn;
+ Kernel.Quit(1)
+ END
+ END LinkAll;
+
+ PROCEDURE Init;
+ BEGIN
+ IF Kernel.trapCount # 0 THEN Kernel.Quit(1) END;
+ HostFiles.SetRootDir(".");
+ InitOptions;
+ CheckOptions;
+ LinkAll;
+ Kernel.Quit(0)
+ END Init;
+
+BEGIN
+ Kernel.Start(Init)
+END DswLinker486Main.
diff --git a/src/generic/Dsw/Mod/ListMain.cp b/src/generic/Dsw/Mod/ListMain.cp
--- /dev/null
@@ -0,0 +1,48 @@
+MODULE DswListMain;
+
+ (* file list test *)
+
+ IMPORT Kernel, HostFiles, Files, Console, Strings;
+
+ PROCEDURE Init;
+ VAR i, res: INTEGER; loc: Files.Locator; f: Files.FileInfo; d: Files.LocInfo; s: ARRAY 20 OF CHAR;
+ BEGIN
+ IF Kernel.trapCount > 0 THEN Kernel.Quit(1) END;
+ HostFiles.SetRootDir(".");
+ i := 1; res := 0;
+ WHILE i < Kernel.argc DO
+ loc := Files.dir.This(Kernel.argv[i]$);
+ d := Files.dir.LocList(loc);
+ IF loc.res = 0 THEN
+ WHILE d # NIL DO
+ Console.WriteStr(d.name + "/");
+ Console.WriteLn;
+ d := d.next
+ END;
+ f := Files.dir.FileList(loc);
+ IF loc.res = 0 THEN
+ WHILE f # NIL DO
+ Console.WriteStr(f.name);
+ Console.WriteLn;
+ f := f.next
+ END
+ END
+ END;
+ IF loc.res # 0 THEN
+ Console.WriteStr(Kernel.argv[i] + ': error ');
+ Strings.IntToString(loc.res, s);
+ Console.WriteStr(s);
+ Console.WriteLn;
+ INC(res);
+ END;
+ INC(i)
+ END;
+ IF res = 0 THEN Kernel.Quit(0)
+ ELSIF res = 1 THEN Kernel.Quit(1)
+ ELSE Kernel.Quit(2)
+ END
+ END Init;
+
+BEGIN
+ Kernel.Start(Init)
+END DswListMain.
diff --git a/src/generic/Dsw/Mod/Log.odc b/src/generic/Dsw/Mod/Log.odc
new file mode 100644 (file)
index 0000000..1e08e84
Binary files /dev/null and b/src/generic/Dsw/Mod/Log.odc differ
index 0000000..1e08e84
Binary files /dev/null and b/src/generic/Dsw/Mod/Log.odc differ
diff --git a/src/generic/Dsw/Mod/LoopMain.cp b/src/generic/Dsw/Mod/LoopMain.cp
--- /dev/null
@@ -0,0 +1,45 @@
+MODULE DswLoopMain;
+
+ (* file locking test *)
+
+ IMPORT Kernel, Files, Console, Strings, Log;
+
+ VAR
+ mode: BOOLEAN;
+
+ PROCEDURE Init;
+ VAR i: INTEGER; s: ARRAY 16 OF CHAR; f: Files.File; loc: Files.Locator;
+ BEGIN
+ IF (Kernel.trapCount > 0) & (Kernel.err # 128) THEN
+ IF Kernel.err = 200 THEN Console.WriteStr("Keyboard Interrupt")
+ ELSE Console.WriteStr("Trap "); Strings.IntToString(Kernel.err, s); Console.WriteStr(s)
+ END;
+ Console.WriteLn;
+ Kernel.Quit(1)
+ END;
+ i := 1;
+ mode := Files.shared;
+ loc := Files.dir.This("");
+ WHILE i < Kernel.argc DO
+ IF Kernel.argv[i]$ = "-" THEN mode := Files.shared
+ ELSIF Kernel.argv[i]$ = "+" THEN mode := Files.exclusive
+ ELSIF Kernel.argv[i]$ = "!" THEN
+ IF f # NIL THEN f.Close; f := NIL END
+ ELSE
+ f := Files.dir.Old(loc, Kernel.argv[i]$, mode);
+ Log.Int(i); Log.String(": ");
+ IF f = NIL THEN Log.String("~open")
+ ELSE Log.String("ok")
+ END;
+ Log.Int(loc.res);
+ Log.Ln
+ END;
+ INC(i)
+ END;
+ LOOP END;
+ Kernel.Quit(0)
+ END Init;
+
+BEGIN
+ Kernel.Start(Init)
+END DswLoopMain.
diff --git a/src/generic/System/Mod/Console.odc b/src/generic/System/Mod/Console.odc
new file mode 100644 (file)
index 0000000..27cfe44
Binary files /dev/null and b/src/generic/System/Mod/Console.odc differ
index 0000000..27cfe44
Binary files /dev/null and b/src/generic/System/Mod/Console.odc differ
diff --git a/src/generic/System/Mod/Dates.odc b/src/generic/System/Mod/Dates.odc
new file mode 100644 (file)
index 0000000..db6753b
Binary files /dev/null and b/src/generic/System/Mod/Dates.odc differ
index 0000000..db6753b
Binary files /dev/null and b/src/generic/System/Mod/Dates.odc differ
diff --git a/src/generic/System/Mod/Files.odc b/src/generic/System/Mod/Files.odc
new file mode 100644 (file)
index 0000000..bb52b5c
Binary files /dev/null and b/src/generic/System/Mod/Files.odc differ
index 0000000..bb52b5c
Binary files /dev/null and b/src/generic/System/Mod/Files.odc differ
diff --git a/src/generic/System/Mod/Int.odc b/src/generic/System/Mod/Int.odc
new file mode 100644 (file)
index 0000000..9adb645
Binary files /dev/null and b/src/generic/System/Mod/Int.odc differ
index 0000000..9adb645
Binary files /dev/null and b/src/generic/System/Mod/Int.odc differ
diff --git a/src/generic/System/Mod/Integers.odc b/src/generic/System/Mod/Integers.odc
new file mode 100644 (file)
index 0000000..bd9d450
Binary files /dev/null and b/src/generic/System/Mod/Integers.odc differ
index 0000000..bd9d450
Binary files /dev/null and b/src/generic/System/Mod/Integers.odc differ
diff --git a/src/generic/System/Mod/Log.odc b/src/generic/System/Mod/Log.odc
new file mode 100644 (file)
index 0000000..6844660
Binary files /dev/null and b/src/generic/System/Mod/Log.odc differ
index 0000000..6844660
Binary files /dev/null and b/src/generic/System/Mod/Log.odc differ
diff --git a/src/generic/System/Mod/Services.odc b/src/generic/System/Mod/Services.odc
new file mode 100644 (file)
index 0000000..9a36129
Binary files /dev/null and b/src/generic/System/Mod/Services.odc differ
index 0000000..9a36129
Binary files /dev/null and b/src/generic/System/Mod/Services.odc differ
diff --git a/src/generic/System/Mod/Strings.odc b/src/generic/System/Mod/Strings.odc
new file mode 100644 (file)
index 0000000..d4aafc8
Binary files /dev/null and b/src/generic/System/Mod/Strings.odc differ
index 0000000..d4aafc8
Binary files /dev/null and b/src/generic/System/Mod/Strings.odc differ
diff --git a/src/i486/generic/System/Mod/Long.odc b/src/i486/generic/System/Mod/Long.odc
new file mode 100644 (file)
index 0000000..f50db60
Binary files /dev/null and b/src/i486/generic/System/Mod/Long.odc differ
index 0000000..f50db60
Binary files /dev/null and b/src/i486/generic/System/Mod/Long.odc differ
diff --git a/src/i486/generic/System/Mod/Math.odc b/src/i486/generic/System/Mod/Math.odc
new file mode 100644 (file)
index 0000000..8adb3e1
Binary files /dev/null and b/src/i486/generic/System/Mod/Math.odc differ
index 0000000..8adb3e1
Binary files /dev/null and b/src/i486/generic/System/Mod/Math.odc differ
diff --git a/src/i486/generic/System/Mod/SMath.odc b/src/i486/generic/System/Mod/SMath.odc
new file mode 100644 (file)
index 0000000..719a3f3
Binary files /dev/null and b/src/i486/generic/System/Mod/SMath.odc differ
index 0000000..719a3f3
Binary files /dev/null and b/src/i486/generic/System/Mod/SMath.odc differ
diff --git a/src/i486/linux/C99/Mod/dirent.cp b/src/i486/linux/C99/Mod/dirent.cp
--- /dev/null
@@ -0,0 +1,66 @@
+MODULE C99dirent ['libc.so.6'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types, C99sys_types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ TYPE
+ PDIR* = POINTER TO DIR;
+ DIR = LIMITED RECORD [untagged] END;
+
+ TYPE
+ Pstruct_dirent* = POINTER TO struct_dirent;
+ struct_dirent* = RECORD [noalign] (* 268 *)
+ d_ino*: ino_t; (* 0+4 *)
+ _____align0_____: ARRAY 7 OF BYTE;
+ d_name*: ARRAY [untagged] 256 OF SHORTCHAR; (* 11+256 *)
+ _____align1_____: ARRAY 1 OF BYTE;
+ END;
+
+ TYPE
+ ino_t* = C99sys_types.ino_t;
+
+ PROCEDURE [ccall] alphasort* (IN a, b: Pstruct_dirent): int;
+ PROCEDURE [ccall] closedir* (dirp: PDIR): int;
+ PROCEDURE [ccall] dirfd* (dirp: PDIR): int;
+ PROCEDURE [ccall] fdopendir* (fd: int): PDIR;
+ PROCEDURE [ccall] opendir* (IN name: ARRAY [untagged] OF SHORTCHAR): PDIR;
+ PROCEDURE [ccall] readdir* (dirp: PDIR): Pstruct_dirent;
+ PROCEDURE [ccall] readdir_r* (dirp: PDIR; entry: Pstruct_dirent; VAR result: Pstruct_dirent): int;
+ PROCEDURE [ccall] rewinddir* (dirp: PDIR);
+ PROCEDURE [ccall] scandir* (IN dirp: ARRAY [untagged] OF SHORTCHAR; filter: PROCEDURE [ccall] (IN d: struct_dirent): int; compar: PROCEDURE [ccall] (IN a, b: Pstruct_dirent): int): int;
+ PROCEDURE [ccall] seekdir* (dirp: PDIR; loc: long);
+ PROCEDURE [ccall] telldir* (dirp: PDIR): long;
+
+END C99dirent.
diff --git a/src/i486/linux/C99/Mod/dlfcn.cp b/src/i486/linux/C99/Mod/dlfcn.cp
--- /dev/null
@@ -0,0 +1,49 @@
+MODULE C99dlfcn ['libdl.so.2'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ CONST
+ RTLD_LAZY* = 1;
+ RTLD_NOW* = 2;
+ RTLD_GLOBAL* = 256;
+ RTLD_LOCAL* = 0;
+
+ PROCEDURE [ccall] dlclose* (handle: C99types.Pvoid): int;
+ PROCEDURE [ccall] dlerror* (): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] dlopen* (IN [nil] filename: ARRAY [untagged] OF SHORTCHAR; flags: int): C99types.Pvoid;
+ PROCEDURE [ccall] dlsym* (handle: C99types.Pvoid; IN symbol: ARRAY [untagged] OF SHORTCHAR): C99types.Pvoid;
+
+END C99dlfcn.
diff --git a/src/i486/linux/C99/Mod/errno.cp b/src/i486/linux/C99/Mod/errno.cp
--- /dev/null
@@ -0,0 +1,123 @@
+MODULE C99errno ['libc.so.6'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ CONST
+ E2BIG* = 7;
+ EACCES* = 13;
+ EADDRINUSE* = 98;
+ EADDRNOTAVAIL* = 99;
+ EAFNOSUPPORT* = 97;
+ EAGAIN* = 11;
+ EALREADY* = 114;
+ EBADF* = 9;
+ EBADMSG* = 74;
+ EBUSY* = 16;
+ ECANCELED* = 125;
+ ECHILD* = 10;
+ ECONNABORTED* = 103;
+ ECONNREFUSED* = 111;
+ ECONNRESET* = 104;
+ EDEADLK* = 35;
+ EDESTADDRREQ* = 89;
+ EDOM* = 33;
+ EDQUOT* = 122;
+ EEXIST* = 17;
+ EFAULT* = 14;
+ EFBIG* = 27;
+ EHOSTUNREACH* = 113;
+ EIDRM* = 43;
+ EILSEQ* = 84;
+ EINPROGRESS* = 115;
+ EINTR* = 4;
+ EINVAL* = 22;
+ EIO* = 5;
+ EISCONN* = 106;
+ EISDIR* = 21;
+ ELOOP* = 40;
+ EMFILE* = 24;
+ EMLINK* = 31;
+ EMSGSIZE* = 90;
+ EMULTIHOP* = 72;
+ ENAMETOOLONG* = 36;
+ ENETDOWN* = 100;
+ ENETRESET* = 102;
+ ENETUNREACH* = 101;
+ ENFILE* = 23;
+ ENOBUFS* = 105;
+ ENODATA* = 61;
+ ENODEV* = 19;
+ ENOENT* = 2;
+ ENOEXEC* = 8;
+ ENOLCK* = 37;
+ ENOLINK* = 67;
+ ENOMEM* = 12;
+ ENOMSG* = 42;
+ ENOPROTOOPT* = 92;
+ ENOSPC* = 28;
+ ENOSR* = 63;
+ ENOSTR* = 60;
+ ENOSYS* = 38;
+ ENOTCONN* = 107;
+ ENOTDIR* = 20;
+ ENOTEMPTY* = 39;
+ ENOTRECOVERABLE* = 131;
+ ENOTSOCK* = 88;
+ ENOTSUP* = 95;
+ ENOTTY* = 25;
+ ENXIO* = 6;
+ EOPNOTSUPP* = 95;
+ EOVERFLOW* = 75;
+ EOWNERDEAD* = 130;
+ EPERM* = 1;
+ EPIPE* = 32;
+ EPROTO* = 71;
+ EPROTONOSUPPORT* = 93;
+ EPROTOTYPE* = 91;
+ ERANGE* = 34;
+ EROFS* = 30;
+ ESPIPE* = 29;
+ ESRCH* = 3;
+ ESTALE* = 116;
+ ETIME* = 62;
+ ETIMEDOUT* = 110;
+ ETXTBSY* = 26;
+ EWOULDBLOCK* = 11;
+ EXDEV* = 18;
+
+ PROCEDURE [ccall] __errno_location* (): POINTER TO ARRAY [untagged] 1 OF int;
+
+END C99errno.
diff --git a/src/i486/linux/C99/Mod/fcntl.cp b/src/i486/linux/C99/Mod/fcntl.cp
--- /dev/null
@@ -0,0 +1,119 @@
+MODULE C99fcntl ['libc.so.6'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types, C99sys_types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ CONST
+ F_DUPFD* = 0;
+ F_DUPFD_CLOEXEC* = 1030;
+ F_GETFD* = 1;
+ F_SETFD* = 2;
+ F_GETFL* = 3;
+ F_SETFL* = 4;
+ F_GETLK* = 5;
+ F_SETLK* = 6;
+ F_SETLKW* = 7;
+ F_GETOWN* = 9;
+ F_SETOWN* = 8;
+
+ CONST
+ FD_CLOEXEC* = 1;
+
+ CONST
+ F_RDLCK* = 0;
+ F_UNLCK* = 2;
+ F_WRLCK* = 1;
+
+ CONST
+ SEEK_SET* = 0;
+ SEEK_CUR* = 1;
+ SEEK_END* = 2;
+
+ CONST
+ O_CLOEXEC* = 524288;
+ O_CREAT* = 64;
+ O_DIRECTORY* = 65536;
+ O_EXCL* = 128;
+ O_NOCTTY* = 256;
+ O_NOFOLLOW* = 131072;
+ O_TRUNC* = 512;
+ O_APPEND* = 1024;
+ O_DSYNC* = 4096;
+ O_NONBLOCK* = 2048;
+ O_RSYNC* = 1052672;
+ O_SYNC* = 1052672;
+ O_ACCMODE* = 3;
+ O_RDONLY* = 0;
+ O_RDWR* = 2;
+ O_WRONLY* = 1;
+
+ CONST
+ AT_FDCWD* = -100;
+ AT_EACCESS* = 512;
+ AT_SYMLINK_NOFOLLOW* = 256;
+ AT_SYMLINK_FOLLOW* = 1024;
+ AT_REMOVEDIR* = 512;
+
+ CONST
+ POSIX_FADV_DONTNEED* = 4;
+ POSIX_FADV_NOREUSE* = 5;
+ POSIX_FADV_NORMAL* = 0;
+ POSIX_FADV_RANDOM* = 1;
+ POSIX_FADV_SEQUENTIAL* = 2;
+ POSIX_FADV_WILLNEED* = 3;
+
+ TYPE
+ Pstruct_flock* = POINTER TO struct_flock;
+ struct_flock* = RECORD [noalign] (* 16 *)
+ l_type*: short; (* 0+2 *)
+ l_whence*: short; (* 2+2 *)
+ l_start*: off_t; (* 4+4 *)
+ l_len*: off_t; (* 8+4 *)
+ l_pid*: pid_t; (* 12+4 *)
+ END;
+
+ TYPE
+ mode_t* = C99sys_types.mode_t;
+ off_t* = C99sys_types.off_t;
+ pid_t* = C99sys_types.pid_t;
+
+ PROCEDURE [ccall] creat* (IN pathname: ARRAY [untagged] OF SHORTCHAR; mode: mode_t): int;
+ PROCEDURE [ccall] fcntl* (fildes, cmd, arg: int): int;
+ PROCEDURE [ccall] open* (IN pathname: ARRAY [untagged] OF SHORTCHAR; flags: int; mode: mode_t): int;
+ PROCEDURE [ccall] openat* (fddir: int; IN pathname: ARRAY [untagged] OF SHORTCHAR; flags: int; mode: mode_t): int;
+ PROCEDURE [ccall] posix_fadvise* (fd: int; offset, len: off_t; advice: int): int;
+ PROCEDURE [ccall] posix_fallocate* (fd: int; offset, len: off_t): int;
+
+END C99fcntl.
diff --git a/src/i486/linux/C99/Mod/iconv.cp b/src/i486/linux/C99/Mod/iconv.cp
--- /dev/null
@@ -0,0 +1,48 @@
+MODULE C99iconv ['libc.so.6'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types, C99sys_types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ TYPE
+ iconv_t* = INTEGER;
+
+ TYPE
+ size_t* = C99sys_types.size_t;
+
+ PROCEDURE [ccall] iconv* (cd: iconv_t; VAR [nil] inbuf: C99types.Pvoid; VAR inbytesleft: size_t; VAR [nil] outbuf: C99types.Pvoid; VAR outbytesleft: size_t): size_t;
+ PROCEDURE [ccall] iconv_open* (IN tocode, fromcode: ARRAY [untagged] OF SHORTCHAR): iconv_t;
+ PROCEDURE [ccall] iconv_close* (cd: iconv_t): int;
+
+END C99iconv.
diff --git a/src/i486/linux/C99/Mod/libgen.cp b/src/i486/linux/C99/Mod/libgen.cp
--- /dev/null
@@ -0,0 +1,41 @@
+MODULE C99libgen ['libc.so.6'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ PROCEDURE [ccall] basename* (path: POINTER TO ARRAY [untagged] OF SHORTCHAR): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] dirname* (path: POINTER TO ARRAY [untagged] OF SHORTCHAR): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+
+END C99libgen.
diff --git a/src/i486/linux/C99/Mod/locale.cp b/src/i486/linux/C99/Mod/locale.cp
--- /dev/null
@@ -0,0 +1,75 @@
+MODULE C99locale ['libc.so.6'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ TYPE
+ Pstruct_lconv* = POINTER TO struct_lconv;
+ struct_lconv = LIMITED RECORD [untagged] END;
+
+ CONST
+ LC_ALL* = 6;
+ LC_COLLATE* = 3;
+ LC_CTYPE* = 0;
+ LC_MESSAGES* = 5;
+ LC_MONETARY* = 4;
+ LC_NUMERIC* = 1;
+ LC_TIME* = 2;
+
+ CONST
+ LC_COLLATE_MASK* = 8;
+ LC_CTYPE_MASK* = 1;
+ LC_MESSAGES_MASK* = 32;
+ LC_MONETARY_MASK* = 16;
+ LC_NUMERIC_MASK* = 2;
+ LC_TIME_MASK* = 4;
+
+ CONST
+ LC_ALL_MASK* = 8127;
+
+ CONST
+ LC_GLOBAL_LOCALE* = -1;
+
+ TYPE
+ locale_t* = INTEGER;
+
+ PROCEDURE [ccall] duplocale* (locobj: locale_t): locale_t;
+ PROCEDURE [ccall] freelocale* (locobj: locale_t);
+ PROCEDURE [ccall] localeconv* (): Pstruct_lconv;
+ PROCEDURE [ccall] newlocale* (category_mask: int; IN locale: ARRAY [untagged] OF SHORTCHAR; base: locale_t): locale_t;
+ PROCEDURE [ccall] setlocale* (category: int; IN [nil] locale: ARRAY [untagged] OF SHORTCHAR): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] uselocale* (newloc: locale_t): locale_t;
+
+END C99locale.
diff --git a/src/i486/linux/C99/Mod/macro.cp b/src/i486/linux/C99/Mod/macro.cp
--- /dev/null
@@ -0,0 +1,15 @@
+MODULE C99macro;
+
+ IMPORT SYSTEM, C99errno, C99sys_stat;
+
+ PROCEDURE errno* (): C99errno.int;
+ BEGIN
+ RETURN C99errno.__errno_location()[0]
+ END errno;
+
+ PROCEDURE stat* (IN path: ARRAY [untagged] OF SHORTCHAR; VAR buf: C99sys_stat.struct_stat): C99sys_stat.int;
+ BEGIN
+ RETURN C99sys_stat.__xstat(C99sys_stat._STAT_VER, path, buf)
+ END stat;
+
+END C99macro.
diff --git a/src/i486/linux/C99/Mod/setjmp.cp b/src/i486/linux/C99/Mod/setjmp.cp
--- /dev/null
@@ -0,0 +1,49 @@
+MODULE C99setjmp ['libc.so.6'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ TYPE
+ jmp_buf* = ARRAY [untagged] 156 OF BYTE;
+ sigjmp_buf* = ARRAY [untagged] 156 OF BYTE;
+
+ PROCEDURE [ccall] _longjmp* (IN env: jmp_buf; val: int);
+ PROCEDURE [ccall] longjmp* (IN env: jmp_buf; val: int);
+ PROCEDURE [ccall] siglongjmp* (IN env: sigjmp_buf; val: int);
+ PROCEDURE [ccall] _setjmp* (VAR env: jmp_buf): int;
+ PROCEDURE [ccall] setjmp* (VAR env: jmp_buf): int;
+ PROCEDURE [ccall] sigsetjmp* ['__sigsetjmp'] (VAR env: sigjmp_buf; savesigs: int): int;
+
+END C99setjmp.
diff --git a/src/i486/linux/C99/Mod/signal.cp b/src/i486/linux/C99/Mod/signal.cp
--- /dev/null
@@ -0,0 +1,316 @@
+MODULE C99signal ['libc.so.6'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types, C99sys_types, C99time;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ CONST
+ SIG_DFL* = 0;
+ SIG_ERR* = -1;
+ SIG_IGN* = 1;
+
+ TYPE
+ pthread_t* = C99sys_types.pthread_t;
+ pthread_attr_t* = C99sys_types.pthread_attr_t;
+ size_t* = C99sys_types.size_t;
+ uid_t* = C99sys_types.uid_t;
+ pid_t* = C99sys_types.pid_t;
+
+ TYPE
+ struct_timespec* = C99time.struct_timespec;
+
+ TYPE
+ sig_atomic_t* = INTEGER;
+ sigset_t* = RECORD [noalign] _: ARRAY [untagged] 128 OF BYTE END;
+
+ TYPE
+ Pstruct_sigevent* = POINTER TO struct_sigevent;
+ struct_sigevent* = RECORD [noalign] (* 64 *)
+ sigev_value*: union_sigval; (* 0+4 *)
+ sigev_signo*: int; (* 4+4 *)
+ sigev_notify*: int; (* 8+4 *)
+ sigev_notify_function*: PROCEDURE [ccall] (x: union_sigval); (* 12+4 *)
+ _____align0_____: ARRAY 48 OF BYTE;
+ END;
+
+ CONST
+ SIGEV_NONE* = 1;
+ SIGEV_SIGNAL* = 0;
+ SIGEV_THREAD* = 2;
+
+ TYPE
+ Punion_sigval* = POINTER TO union_sigval;
+ union_sigval* = RECORD [union] (* 4 *)
+ sival_int*: int; (* 0+4 *)
+ sival_ptr*: C99types.Pvoid; (* 0+4 *)
+ END;
+
+ CONST
+ SIGRTMIN* = 34;
+ SIGRTMAX* = 64;
+ RTSIG_MAX* = 32;
+
+ CONST
+ SIGABRT* = 6;
+ SIGALRM* = 14;
+ SIGBUS* = 7;
+ SIGCHLD* = 17;
+ SIGCONT* = 18;
+ SIGFPE* = 8;
+ SIGHUP* = 1;
+ SIGILL* = 4;
+ SIGINT* = 2;
+ SIGKILL* = 9;
+ SIGPIPE* = 13;
+ SIGQUIT* = 3;
+ SIGSEGV* = 11;
+ SIGSTOP* = 19;
+ SIGTERM* = 15;
+ SIGTSTP* = 20;
+ SIGTTIN* = 21;
+ SIGTTOU* = 22;
+ SIGUSR1* = 10;
+ SIGUSR2* = 12;
+ SIGPOLL* = 29;
+ SIGPROF* = 27;
+ SIGSYS* = 31;
+ SIGTRAP* = 5;
+ SIGURG* = 23;
+ SIGVTALRM* = 26;
+ SIGXCPU* = 24;
+ SIGXFSZ* = 25;
+
+ TYPE
+ Pstruct_sigaction* = POINTER TO struct_sigaction;
+ struct_sigaction* = RECORD [noalign] (* 140 *)
+ handler*: RECORD [union] (* 4 *)
+ sa_handler*: PROCEDURE [ccall] (sig: int); (* 0+4 *)
+ sa_sigaction*: PROCEDURE [ccall] (sig: int; IN siginfo: siginfo_t; context: C99types.Pvoid); (* 0+4 *)
+ END; (* 0+4 *)
+ sa_mask*: sigset_t; (* 4+128 *)
+ sa_flags*: int; (* 132+4 *)
+ _____align0_____: ARRAY 4 OF BYTE;
+ END;
+
+ CONST
+ SIG_BLOCK* = 0;
+ SIG_UNBLOCK* = 1;
+ SIG_SETMASK* = 2;
+
+ CONST
+ SA_NOCLDSTOP* = 1;
+ SA_ONSTACK* = 134217728;
+ SA_RESETHAND* = -2147483648;
+ SA_RESTART* = 268435456;
+ SA_SIGINFO* = 4;
+ SA_NOCLDWAIT* = 2;
+ SA_NODEFER* = 1073741824;
+ SS_ONSTACK* = 1;
+ SS_DISABLE* = 2;
+ MINSIGSTKSZ* = 2048;
+ SIGSTKSZ* = 8192;
+
+ CONST
+ __NGREG* = 19;
+
+ TYPE
+ greg_t* = INTEGER;
+
+ TYPE gregset_t* = ARRAY [untagged] __NGREG OF greg_t;
+
+ TYPE
+ Pstruct__libc_fpreg* = POINTER TO struct__libc_fpreg;
+ struct__libc_fpreg* = RECORD [noalign] (* 10 *)
+ significand*: INTEGER; (* 0+8 *)
+ exponent*: unsigned_short_int; (* 8+2 *)
+ END;
+
+ TYPE
+ Pstruct__libc_fpstate* = POINTER TO struct__libc_fpstate;
+ struct__libc_fpstate* = RECORD [noalign] (* 112 *)
+ cw*: unsigned_long_int; (* 0+4 *)
+ sw*: unsigned_long_int; (* 4+4 *)
+ tag*: unsigned_long_int; (* 8+4 *)
+ ipoff*: unsigned_long_int; (* 12+4 *)
+ cssel*: unsigned_long_int; (* 16+4 *)
+ dataoff*: unsigned_long_int; (* 20+4 *)
+ datasel*: unsigned_long_int; (* 24+4 *)
+ _st*: ARRAY [untagged] 8 OF struct__libc_fpreg; (* 28+80 *)
+ status*: unsigned_long_int; (* 108+4 *)
+ END;
+
+ TYPE fpregset_t* = Pstruct__libc_fpstate;
+
+ TYPE
+ Pmcontext_t* = POINTER TO mcontext_t;
+ mcontext_t* = RECORD [noalign] (* 88 *)
+ gregs*: gregset_t; (* 0+76 *)
+ fpregs*: fpregset_t; (* 76+4 *)
+ oldmask*: unsigned_long_int; (* 80+4 *)
+ cr2*: unsigned_long_int; (* 84+4 *)
+ END;
+
+ TYPE
+ Pucontext_t* = POINTER TO ucontext_t;
+ ucontext_t* = RECORD [noalign] (* 348 *)
+ uc_flags*: unsigned_long_int; (* 0+4 *)
+ uc_link*: Pucontext_t; (* 4+4 *)
+ uc_stack*: stack_t; (* 8+12 *)
+ uc_mcontext*: mcontext_t; (* 20+88 *)
+ uc_sigmask*: sigset_t; (* 108+128 *)
+ __fpregs_mem*: struct__libc_fpstate; (* 236+112 *)
+ END;
+
+ TYPE
+ Pstack_t* = POINTER TO stack_t;
+ stack_t* = RECORD [noalign] (* 12 *)
+ ss_sp*: C99types.Pvoid; (* 0+4 *)
+ ss_flags*: int; (* 4+4 *)
+ ss_size*: size_t; (* 8+4 *)
+ END;
+
+ TYPE
+ Psiginfo_t* = POINTER TO siginfo_t;
+ siginfo_t* = RECORD [noalign] (* 128 *)
+ si_signo*: int; (* 0+4 *)
+ si_errno*: int; (* 4+4 *)
+ si_code*: int; (* 8+4 *)
+ info*: RECORD [union] (* 12 *)
+ sigill*: RECORD [noalign] (* 4 *)
+ si_addr*: C99types.Pvoid; (* 0+4 *)
+ END; (* 0+4 *)
+ sigfpe*: RECORD [noalign] (* 4 *)
+ si_addr*: C99types.Pvoid; (* 0+4 *)
+ END; (* 0+4 *)
+ sigsegv*: RECORD [noalign] (* 4 *)
+ si_addr*: C99types.Pvoid; (* 0+4 *)
+ END; (* 0+4 *)
+ sigbus*: RECORD [noalign] (* 4 *)
+ si_addr*: C99types.Pvoid; (* 0+4 *)
+ END; (* 0+4 *)
+ sigchld*: RECORD [noalign] (* 12 *)
+ si_pid*: pid_t; (* 0+4 *)
+ si_uid*: uid_t; (* 4+4 *)
+ si_status*: int; (* 8+4 *)
+ END; (* 0+12 *)
+ sigpoll*: RECORD [noalign] (* 4 *)
+ si_band*: long; (* 0+4 *)
+ END; (* 0+4 *)
+ other*: RECORD [noalign] (* 4 *)
+ si_value*: union_sigval; (* 0+4 *)
+ END; (* 8+4 *)
+ END; (* 12+12 *)
+ _____align0_____: ARRAY 104 OF BYTE;
+ END;
+
+ CONST
+ ILL_ILLOPC* = 1;
+ ILL_ILLOPN* = 2;
+ ILL_ILLADR* = 3;
+ ILL_ILLTRP* = 4;
+ ILL_PRVOPC* = 5;
+ ILL_PRVREG* = 6;
+ ILL_COPROC* = 7;
+ ILL_BADSTK* = 8;
+
+ CONST
+ FPE_INTDIV* = 1;
+ FPE_INTOVF* = 2;
+ FPE_FLTDIV* = 3;
+ FPE_FLTOVF* = 4;
+ FPE_FLTUND* = 5;
+ FPE_FLTRES* = 6;
+ FPE_FLTINV* = 7;
+ FPE_FLTSUB* = 8;
+
+ CONST
+ SEGV_MAPERR* = 1;
+ SEGV_ACCERR* = 2;
+
+ CONST
+ BUS_ADRALN* = 1;
+ BUS_ADRERR* = 2;
+ BUS_OBJERR* = 3;
+
+ CONST
+ CLD_EXITED* = 1;
+ CLD_KILLED* = 2;
+ CLD_DUMPED* = 3;
+ CLD_TRAPPED* = 4;
+ CLD_STOPPED* = 5;
+ CLD_CONTINUED* = 6;
+
+ CONST
+ POLL_IN* = 1;
+ POLL_OUT* = 2;
+ POLL_MSG* = 3;
+ POLL_ERR* = 4;
+ POLL_PRI* = 5;
+ POLL_HUP* = 6;
+
+ CONST
+ SI_USER* = 0;
+ SI_QUEUE* = -1;
+ SI_TIMER* = -2;
+ SI_ASYNCIO* = -4;
+ SI_MESGQ* = -3;
+
+ PROCEDURE [ccall] kill* (pid: pid_t; sig: int): int;
+ PROCEDURE [ccall] killpg* (pgrp, sig: int): int;
+ PROCEDURE [ccall] psiginfo* (IN pinfo: siginfo_t; IN [nil] s: ARRAY [untagged] OF SHORTCHAR);
+ PROCEDURE [ccall] psignal* (sig: int; IN [nil] s: ARRAY [untagged] OF SHORTCHAR);
+ PROCEDURE [ccall] pthread_kill* (thread: pthread_t; sig: int): int;
+ PROCEDURE [ccall] pthread_sigmask* (how: int; IN [nil] set: sigset_t; VAR [nil] oldset: sigset_t): int;
+ PROCEDURE [ccall] raise* (sig: int): int;
+ PROCEDURE [ccall] sigaction* (sig: int; IN [nil] act: struct_sigaction; VAR [nil] oact: struct_sigaction): int;
+ PROCEDURE [ccall] sigaddset* (VAR set: sigset_t; signum: int): int;
+ PROCEDURE [ccall] sigaltstack* (IN [nil] ss: stack_t; VAR [nil] oss: stack_t): int;
+ PROCEDURE [ccall] sigdelset* (VAR set: sigset_t; signum: int): int;
+ PROCEDURE [ccall] sigemptyset* (VAR set: sigset_t): int;
+ PROCEDURE [ccall] sigfillset* (VAR set: sigset_t): int;
+ PROCEDURE [ccall] sighold* (sig: int): int;
+ PROCEDURE [ccall] sigignore* (sig: int): int;
+ PROCEDURE [ccall] siginterrupt* (sig, flag: int): int;
+ PROCEDURE [ccall] sigismember* (IN set: sigset_t; signum: int): int;
+ PROCEDURE [ccall] sigpause* (sig: int): int;
+ PROCEDURE [ccall] sigpending* (VAR set: sigset_t): int;
+ PROCEDURE [ccall] sigprocmask* (how: int; IN [nil] set: sigset_t; VAR [nil] oset: sigset_t): int;
+ PROCEDURE [ccall] sigqueue* (pid: pid_t; sig: int; IN value: union_sigval): int;
+ PROCEDURE [ccall] sigrelse* (sig: int): int;
+ PROCEDURE [ccall] sigsuspend* (IN sigmask: sigset_t): int;
+ PROCEDURE [ccall] sigtimedwait* (IN set: sigset_t; VAR [nil] info: siginfo_t; IN timeout: struct_timespec): int;
+ PROCEDURE [ccall] sigwait* (IN set: sigset_t; VAR sig: int): int;
+ PROCEDURE [ccall] sigwaitinfo* (IN set: sigset_t; VAR [nil] info: siginfo_t): int;
+
+END C99signal.
diff --git a/src/i486/linux/C99/Mod/stdio.cp b/src/i486/linux/C99/Mod/stdio.cp
--- /dev/null
@@ -0,0 +1,91 @@
+MODULE C99stdio ['libc.so.6'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types, C99sys_types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ TYPE
+ PFILE* = POINTER TO FILE;
+ FILE = LIMITED RECORD [untagged] END;
+
+ TYPE
+ fpos_t* = RECORD [noalign] _: ARRAY [untagged] 12 OF BYTE END;
+
+ TYPE
+ off_t* = C99sys_types.off_t;
+ ssize_t* = C99sys_types.ssize_t;
+
+ TYPE
+ size_t* = INTEGER;
+
+ TYPE
+ va_list* = INTEGER;
+
+ CONST
+ BUFSIZ* = 8192;
+ L_ctermid* = 9;
+ L_tmpnam* = 20;
+
+ CONST
+ _IOFBF* = 0;
+ _IOLBF* = 1;
+ _IONBF* = 2;
+
+ CONST
+ SEEK_CUR* = 1;
+ SEEK_END* = 2;
+ SEEK_SET* = 0;
+
+ CONST
+ FILENAME_MAX* = 4096;
+ FOPEN_MAX* = 16;
+ TMP_MAX* = 238328;
+
+ CONST
+ EOF* = -1;
+
+ PROCEDURE [ccall] fclose* (stream: PFILE): int;
+ PROCEDURE [ccall] ferror* (stream: PFILE): int;
+ PROCEDURE [ccall] fflush* (stream: PFILE): int;
+ PROCEDURE [ccall] fopen* (IN pathname, mode: ARRAY [untagged] OF SHORTCHAR): PFILE;
+ PROCEDURE [ccall] fread* (ptr: C99types.Pvoid; size, n: size_t; stream: PFILE): size_t;
+ PROCEDURE [ccall] fseek* (stream: PFILE; offset: long; whence: int): int;
+ PROCEDURE [ccall] ftell* (stream: PFILE): long;
+ PROCEDURE [ccall] fwrite* (ptr: C99types.Pvoid; size, n: size_t; stream: PFILE): size_t;
+ PROCEDURE [ccall] feof* (stream: PFILE): int;
+ PROCEDURE [ccall] remove* (IN pathname: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] rename* (IN old, new: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] tmpfile* (): PFILE;
+
+END C99stdio.
diff --git a/src/i486/linux/C99/Mod/stdlib.cp b/src/i486/linux/C99/Mod/stdlib.cp
--- /dev/null
@@ -0,0 +1,66 @@
+MODULE C99stdlib ['libc.so.6'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ CONST
+ EXIT_FAILURE* = 1;
+ EXIT_SUCCESS* = 0;
+ RAND_MAX* = 2147483647;
+
+ CONST
+ MB_CUR_MAX* = 1;
+
+ TYPE
+ div_t* = RECORD [noalign] _: ARRAY [untagged] 8 OF BYTE END;
+ ldiv_t* = RECORD [noalign] _: ARRAY [untagged] 8 OF BYTE END;
+ lldiv_t* = RECORD [noalign] _: ARRAY [untagged] 16 OF BYTE END;
+
+ TYPE
+ size_t* = INTEGER;
+ wchar_t* = INTEGER;
+
+ PROCEDURE [ccall] _Exit* (status: int);
+ PROCEDURE [ccall] abort* ;
+ PROCEDURE [ccall] atexit* (function: PROCEDURE [ccall]): int;
+ PROCEDURE [ccall] exit* (status: int);
+ PROCEDURE [ccall] free* (ptr: C99types.Pvoid);
+ PROCEDURE [ccall] getenv* (IN name: ARRAY [untagged] OF SHORTCHAR): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] malloc* (size: size_t): C99types.Pvoid;
+ PROCEDURE [ccall] system* (IN command: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] mkstemp* (VAR template: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] realpath* (IN path: ARRAY [untagged] OF SHORTCHAR; VAR [nil] resolved_path: ARRAY [untagged] OF SHORTCHAR): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+
+END C99stdlib.
diff --git a/src/i486/linux/C99/Mod/sys_mman.cp b/src/i486/linux/C99/Mod/sys_mman.cp
--- /dev/null
@@ -0,0 +1,86 @@
+MODULE C99sys_mman ['libc.so.6'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types, C99sys_types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ CONST
+ PROT_EXEC* = 4;
+ PROT_NONE* = 0;
+ PROT_READ* = 1;
+ PROT_WRITE* = 2;
+
+ CONST
+ MAP_FIXED* = 16;
+ MAP_PRIVATE* = 2;
+ MAP_SHARED* = 1;
+
+ CONST
+ MS_ASYNC* = 1;
+ MS_INVALIDATE* = 2;
+ MS_SYNC* = 4;
+
+ CONST
+ MCL_CURRENT* = 1;
+ MCL_FUTURE* = 2;
+
+ CONST
+ MAP_FAILED* = -1;
+
+ CONST
+ POSIX_MADV_DONTNEED* = 4;
+ POSIX_MADV_NORMAL* = 0;
+ POSIX_MADV_RANDOM* = 1;
+ POSIX_MADV_SEQUENTIAL* = 2;
+ POSIX_MADV_WILLNEED* = 3;
+
+ TYPE
+ mode_t* = C99sys_types.mode_t;
+ off_t* = C99sys_types.off_t;
+ size_t* = C99sys_types.size_t;
+
+ PROCEDURE [ccall] mlock* (addr: C99types.Pvoid; len: size_t): int;
+ PROCEDURE [ccall] mlockall* (flags: int): int;
+ PROCEDURE [ccall] mmap* (addr: C99types.Pvoid; len: size_t; prot, flags, fildes: int; off: off_t): C99types.Pvoid;
+ PROCEDURE [ccall] mprotect* (addr: C99types.Pvoid; len: size_t; prot: int): int;
+ PROCEDURE [ccall] msync* (addr: C99types.Pvoid; len: size_t; flags: int): int;
+ PROCEDURE [ccall] munlock* (addr: C99types.Pvoid; len: size_t): int;
+ PROCEDURE [ccall] munlockall* (): int;
+ PROCEDURE [ccall] munmap* (addr: C99types.Pvoid; len: size_t): int;
+ PROCEDURE [ccall] posix_madvise* (addr: C99types.Pvoid; len: size_t; advice: int): int;
+ PROCEDURE [ccall] posix_mem_offset* (addr: C99types.Pvoid; len: size_t; VAR off: off_t; VAR contng_len: size_t; VAR fildes: int): int;
+ PROCEDURE [ccall] shm_open* (IN name: ARRAY [untagged] OF SHORTCHAR; oflag, mode: int): int;
+ PROCEDURE [ccall] shm_unlink* (IN name: ARRAY [untagged] OF SHORTCHAR): int;
+
+END C99sys_mman.
diff --git a/src/i486/linux/C99/Mod/sys_stat.cp b/src/i486/linux/C99/Mod/sys_stat.cp
--- /dev/null
@@ -0,0 +1,125 @@
+MODULE C99sys_stat ['libc.so.6'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types, C99time, C99sys_types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ CONST
+ S_IFMT* = 61440;
+ S_IFBLK* = 24576;
+ S_IFCHR* = 8192;
+ S_IFIFO* = 4096;
+ S_IFREG* = 32768;
+ S_IFDIR* = 16384;
+ S_IFLNK* = 40960;
+ S_IFSOCK* = 49152;
+
+ CONST
+ S_IRWXU* = 448;
+ S_IRUSR* = 256;
+ S_IWUSR* = 128;
+ S_IXUSR* = 64;
+ S_IRWXG* = 56;
+ S_IRGRP* = 32;
+ S_IWGRP* = 16;
+ S_IXGRP* = 8;
+ S_IRWXO* = 7;
+ S_IROTH* = 4;
+ S_IWOTH* = 2;
+ S_IXOTH* = 1;
+ S_ISUID* = 2048;
+ S_ISGID* = 1024;
+ S_ISVTX* = 512;
+
+ CONST
+ UTIME_NOW* = 1073741823;
+ UTIME_OMIT* = 1073741822;
+
+ TYPE
+ blkcnt_t* = C99sys_types.blkcnt_t;
+ blksize_t* = C99sys_types.blksize_t;
+ dev_t* = C99sys_types.dev_t;
+ ino_t* = C99sys_types.ino_t;
+ mode_t* = C99sys_types.mode_t;
+ nlink_t* = C99sys_types.nlink_t;
+ uid_t* = C99sys_types.uid_t;
+ gid_t* = C99sys_types.gid_t;
+ off_t* = C99sys_types.off_t;
+ time_t* = C99sys_types.time_t;
+
+ TYPE
+ struct_timespec* = C99time.struct_timespec;
+
+ TYPE
+ Pstruct_stat* = POINTER TO struct_stat;
+ struct_stat* = RECORD [noalign] (* 88 *)
+ st_dev*: dev_t; (* 0+8 *)
+ _____align0_____: ARRAY 4 OF BYTE;
+ st_ino*: ino_t; (* 12+4 *)
+ st_mode*: mode_t; (* 16+4 *)
+ st_nlink*: nlink_t; (* 20+4 *)
+ st_uid*: uid_t; (* 24+4 *)
+ st_gid*: gid_t; (* 28+4 *)
+ st_rdev*: dev_t; (* 32+8 *)
+ _____align1_____: ARRAY 4 OF BYTE;
+ st_size*: off_t; (* 44+4 *)
+ st_blksize*: blksize_t; (* 48+4 *)
+ st_blocks*: blkcnt_t; (* 52+4 *)
+ st_atim*: struct_timespec; (* 56+8 *)
+ st_mtim*: struct_timespec; (* 64+8 *)
+ st_ctim*: struct_timespec; (* 72+8 *)
+ _____align2_____: ARRAY 8 OF BYTE;
+ END;
+
+ CONST
+ _STAT_VER* = 3;
+
+ PROCEDURE [ccall] chmod* (IN path: ARRAY [untagged] OF SHORTCHAR; mode: mode_t): int;
+ PROCEDURE [ccall] fchmod* (fd: int; IN path: ARRAY [untagged] OF SHORTCHAR; mode: mode_t): int;
+ PROCEDURE [ccall] fchmodat* (fd: int; IN path: ARRAY [untagged] OF SHORTCHAR; mode: mode_t; flag: int): int;
+ PROCEDURE [ccall] fstat* (fd: int; VAR buf: struct_stat): int;
+ PROCEDURE [ccall] fstatat* (fd: int; IN path: ARRAY [untagged] OF SHORTCHAR; VAR buf: struct_stat; flag: int): int;
+ PROCEDURE [ccall] futimens* (fd: int; IN times: ARRAY [untagged] 2 OF struct_timespec): int;
+ PROCEDURE [ccall] lstat* (IN path: ARRAY [untagged] OF SHORTCHAR; VAR buf: struct_stat): int;
+ PROCEDURE [ccall] mkdir* (IN path: ARRAY [untagged] OF SHORTCHAR; mode: mode_t): int;
+ PROCEDURE [ccall] mkdirat* (fd: int; IN path: ARRAY [untagged] OF SHORTCHAR; mode: mode_t): int;
+ PROCEDURE [ccall] mkfifo* (IN pathname: ARRAY [untagged] OF SHORTCHAR; mode: mode_t): int;
+ PROCEDURE [ccall] mkfifoat* (dirfd: int; IN pathname: ARRAY [untagged] OF SHORTCHAR; mode: mode_t): int;
+ PROCEDURE [ccall] mknod* (IN path: ARRAY [untagged] OF SHORTCHAR; mode: mode_t; dev: dev_t): int;
+ PROCEDURE [ccall] mknodat* (df: int; IN path: ARRAY [untagged] OF SHORTCHAR; mode: mode_t; dev: dev_t): int;
+ PROCEDURE [ccall] __xstat* (version: int; IN path: ARRAY [untagged] OF SHORTCHAR; VAR buf: struct_stat): int;
+ PROCEDURE [ccall] umask* (mode: mode_t): mode_t;
+ PROCEDURE [ccall] utimensat* (dirfd: int; IN pathname: ARRAY [untagged] OF SHORTCHAR; IN times: ARRAY [untagged] 2 OF struct_timespec; flags: int): int;
+
+END C99sys_stat.
diff --git a/src/i486/linux/C99/Mod/sys_types.cp b/src/i486/linux/C99/Mod/sys_types.cp
--- /dev/null
@@ -0,0 +1,75 @@
+MODULE C99sys_types ['libc.so.6'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ TYPE
+ blkcnt_t* = INTEGER;
+ blksize_t* = INTEGER;
+ clock_t* = INTEGER;
+ clockid_t* = INTEGER;
+ dev_t* = LONGINT;
+ fsblkcnt_t* = INTEGER;
+ fsfilcnt_t* = INTEGER;
+ gid_t* = INTEGER;
+ id_t* = INTEGER;
+ ino_t* = INTEGER;
+ key_t* = INTEGER;
+ mode_t* = INTEGER;
+ nlink_t* = INTEGER;
+ off_t* = INTEGER;
+ pid_t* = INTEGER;
+ pthread_attr_t* = RECORD [noalign] _: ARRAY [untagged] 36 OF BYTE END;
+ pthread_barrier_t* = RECORD [noalign] _: ARRAY [untagged] 20 OF BYTE END;
+ pthread_barrierattr_t* = INTEGER;
+ pthread_cond_t* = RECORD [noalign] _: ARRAY [untagged] 48 OF BYTE END;
+ pthread_condattr_t* = INTEGER;
+ pthread_key_t* = INTEGER;
+ pthread_mutex_t* = RECORD [noalign] _: ARRAY [untagged] 24 OF BYTE END;
+ pthread_mutexattr_t* = INTEGER;
+ pthread_once_t* = INTEGER;
+ pthread_rwlock_t* = RECORD [noalign] _: ARRAY [untagged] 32 OF BYTE END;
+ pthread_rwlockattr_t* = RECORD [noalign] _: ARRAY [untagged] 8 OF BYTE END;
+ pthread_spinlock_t* = INTEGER;
+ pthread_t* = INTEGER;
+ size_t* = INTEGER;
+ ssize_t* = INTEGER;
+ suseconds_t* = INTEGER;
+ time_t* = INTEGER;
+ timer_t* = INTEGER;
+ uid_t* = INTEGER;
+
+
+END C99sys_types.
diff --git a/src/i486/linux/C99/Mod/time.cp b/src/i486/linux/C99/Mod/time.cp
--- /dev/null
@@ -0,0 +1,118 @@
+MODULE C99time ['librt.so.1'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types, C99sys_types, C99locale;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ TYPE
+ clock_t* = C99sys_types.clock_t;
+ size_t* = C99sys_types.size_t;
+ time_t* = C99sys_types.time_t;
+ clockid_t* = C99sys_types.clockid_t;
+ timer_t* = C99sys_types.timer_t;
+ pid_t* = C99sys_types.pid_t;
+
+ TYPE
+ locale_t* = C99locale.locale_t;
+
+ TYPE
+ Pstruct_tm* = POINTER TO struct_tm;
+ struct_tm* = RECORD [noalign] (* 44 *)
+ tm_sec*: int; (* 0+4 *)
+ tm_min*: int; (* 4+4 *)
+ tm_hour*: int; (* 8+4 *)
+ tm_mday*: int; (* 12+4 *)
+ tm_mon*: int; (* 16+4 *)
+ tm_year*: int; (* 20+4 *)
+ tm_wday*: int; (* 24+4 *)
+ tm_yday*: int; (* 28+4 *)
+ tm_isdst*: int; (* 32+4 *)
+ _____align0_____: ARRAY 8 OF BYTE;
+ END;
+
+ TYPE
+ Pstruct_timespec* = POINTER TO struct_timespec;
+ struct_timespec* = RECORD [noalign] (* 8 *)
+ tv_sec*: time_t; (* 0+4 *)
+ tv_nsec*: long; (* 4+4 *)
+ END;
+
+ TYPE
+ Pstruct_itimerspec* = POINTER TO struct_itimerspec;
+ struct_itimerspec* = RECORD [noalign] (* 16 *)
+ it_interval*: struct_timespec; (* 0+8 *)
+ it_value*: struct_timespec; (* 8+8 *)
+ END;
+
+ CONST
+ CLOCKS_PER_SEC* = 1000000;
+
+ CONST
+ CLOCK_MONOTONIC* = 1;
+ CLOCK_PROCESS_CPUTIME_ID* = 2;
+ CLOCK_REALTIME* = 0;
+ CLOCK_THREAD_CPUTIME_ID* = 3;
+
+ CONST
+ TIMER_ABSTIME* = 1;
+
+ PROCEDURE [ccall] asctime* (IN tm: struct_tm): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] asctime_r* (IN tm: struct_tm; buf: POINTER TO ARRAY [untagged] OF SHORTCHAR): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] clock* (): clock_t;
+ PROCEDURE [ccall] clock_getcpuclockid* (pid: pid_t; VAR clock_id: clockid_t): int;
+ PROCEDURE [ccall] clock_getres* (clk_id: clockid_t; VAR res: struct_timespec): int;
+ PROCEDURE [ccall] clock_gettime* (clk_id: clockid_t; VAR res: struct_timespec): int;
+ PROCEDURE [ccall] clock_nanosleep* (clock_id: clockid_t; falgs: int; IN [nil] rqtp: struct_timespec; VAR [nil] rmtp: struct_timespec): int;
+ PROCEDURE [ccall] clock_settime* (clk_id: clockid_t; IN res: struct_timespec): int;
+ PROCEDURE [ccall] ctime* (VAR timep: time_t): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] ctime_r* (VAR timep: time_t; buf: POINTER TO ARRAY [untagged] OF SHORTCHAR): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] difftime* (time0, time1: time_t): double;
+ PROCEDURE [ccall] getdate* (IN string: ARRAY [untagged] OF SHORTCHAR): Pstruct_tm;
+ PROCEDURE [ccall] gmtime* (VAR timep: time_t): Pstruct_tm;
+ PROCEDURE [ccall] gmtime_r* (VAR timep: time_t; VAR result: struct_tm): Pstruct_tm;
+ PROCEDURE [ccall] localtime* (VAR timep: time_t): Pstruct_tm;
+ PROCEDURE [ccall] localtime_r* (VAR timep: time_t; VAR result: struct_tm): Pstruct_tm;
+ PROCEDURE [ccall] mktime* (VAR tm: struct_tm): time_t;
+ PROCEDURE [ccall] nanosleep* (IN [nil] rqtp: struct_timespec; VAR [nil] rmtp: struct_timespec): int;
+ PROCEDURE [ccall] strftime* (VAR s: ARRAY [untagged] OF SHORTCHAR; max: size_t; IN format: ARRAY [untagged] OF SHORTCHAR; IN tm: struct_tm): size_t;
+ PROCEDURE [ccall] strftime_l* (VAR s: ARRAY [untagged] OF SHORTCHAR; max: size_t; IN format: ARRAY [untagged] OF SHORTCHAR; IN tm: struct_tm; locale: locale_t): size_t;
+ PROCEDURE [ccall] strptime* (IN s, format: ARRAY [untagged] OF SHORTCHAR; VAR tm: struct_tm): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] time* (VAR [nil] tloc: time_t): time_t;
+ PROCEDURE [ccall] timer_delete* (timerid: timer_t): int;
+ PROCEDURE [ccall] timer_getoverrun* (timerid: timer_t): int;
+ PROCEDURE [ccall] timer_gettime* (timerid: timer_t; VAR value: struct_itimerspec): int;
+ PROCEDURE [ccall] timer_settime* (timerid: timer_t; flags: int; IN value: struct_itimerspec; VAR [nil] ovalue: struct_itimerspec): int;
+ PROCEDURE [ccall] tzset* ;
+
+END C99time.
diff --git a/src/i486/linux/C99/Mod/types.cp b/src/i486/linux/C99/Mod/types.cp
--- /dev/null
@@ -0,0 +1,40 @@
+MODULE C99types;
+
+ (* generated by genposix.sh, do not modify *)
+
+IMPORT SYSTEM;
+
+ TYPE
+ char* = BYTE;
+ signed_char* = BYTE;
+ unsigned_char* = BYTE;
+ short* = SHORTINT;
+ short_int* = SHORTINT;
+ signed_short* = SHORTINT;
+ signed_short_int* = SHORTINT;
+ unsigned_short* = SHORTINT;
+ unsigned_short_int* = SHORTINT;
+ int* = INTEGER;
+ signed* = INTEGER;
+ signed_int* = INTEGER;
+ unsigned* = INTEGER;
+ unsigned_int* = INTEGER;
+ long* = INTEGER;
+ long_int* = INTEGER;
+ signed_long* = INTEGER;
+ signed_long_int* = INTEGER;
+ unsigned_long* = INTEGER;
+ unsigned_long_int* = INTEGER;
+ long_long* = LONGINT;
+ long_long_int* = LONGINT;
+ signed_long_long* = LONGINT;
+ signed_long_long_int* = LONGINT;
+ unsigned_long_long* = LONGINT;
+ unsigned_long_long_int* = LONGINT;
+ float* = SHORTREAL;
+ double* = REAL;
+ long_double* = RECORD [noalign] _: ARRAY [untagged] 12 OF BYTE END;
+ Pvoid* = INTEGER;
+
+
+END C99types.
diff --git a/src/i486/linux/C99/Mod/unistd.cp b/src/i486/linux/C99/Mod/unistd.cp
--- /dev/null
@@ -0,0 +1,430 @@
+MODULE C99unistd ['libc.so.6'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types, C99sys_types;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ CONST
+ _POSIX_VERSION* = 200809;
+ _POSIX2_VERSION* = 200809;
+ _XOPEN_VERSION* = 700;
+
+ CONST
+ _POSIX_ADVISORY_INFO* = 200809;
+ _POSIX_ASYNCHRONOUS_IO* = 200809;
+ _POSIX_BARRIERS* = 200809;
+ _POSIX_CHOWN_RESTRICTED* = 0;
+ _POSIX_CLOCK_SELECTION* = 200809;
+ _POSIX_CPUTIME* = 0;
+ _POSIX_FSYNC* = 200809;
+ _POSIX_IPV6* = 200809;
+ _POSIX_JOB_CONTROL* = 1;
+ _POSIX_MAPPED_FILES* = 200809;
+ _POSIX_MEMLOCK* = 200809;
+ _POSIX_MEMLOCK_RANGE* = 200809;
+ _POSIX_MEMORY_PROTECTION* = 200809;
+ _POSIX_MESSAGE_PASSING* = 200809;
+ _POSIX_MONOTONIC_CLOCK* = 0;
+ _POSIX_NO_TRUNC* = 1;
+ _POSIX_PRIORITIZED_IO* = 200809;
+ _POSIX_PRIORITY_SCHEDULING* = 200809;
+ _POSIX_RAW_SOCKETS* = 200809;
+ _POSIX_READER_WRITER_LOCKS* = 200809;
+ _POSIX_REALTIME_SIGNALS* = 200809;
+ _POSIX_REGEXP* = 1;
+ _POSIX_SAVED_IDS* = 1;
+ _POSIX_SEMAPHORES* = 200809;
+ _POSIX_SHARED_MEMORY_OBJECTS* = 200809;
+ _POSIX_SHELL* = 1;
+ _POSIX_SPAWN* = 200809;
+ _POSIX_SPIN_LOCKS* = 200809;
+ _POSIX_SPORADIC_SERVER* = -1;
+ _POSIX_SYNCHRONIZED_IO* = 200809;
+ _POSIX_THREAD_ATTR_STACKADDR* = 200809;
+ _POSIX_THREAD_ATTR_STACKSIZE* = 200809;
+ _POSIX_THREAD_CPUTIME* = 0;
+ _POSIX_THREAD_PRIO_INHERIT* = 200809;
+ _POSIX_THREAD_PRIO_PROTECT* = 200809;
+ _POSIX_THREAD_PRIORITY_SCHEDULING* = 200809;
+ _POSIX_THREAD_PROCESS_SHARED* = 200809;
+ _POSIX_THREAD_ROBUST_PRIO_INHERIT* = 200809;
+ _POSIX_THREAD_ROBUST_PRIO_PROTECT* = -1;
+ _POSIX_THREAD_SAFE_FUNCTIONS* = 200809;
+ _POSIX_THREAD_SPORADIC_SERVER* = -1;
+ _POSIX_THREADS* = 200809;
+ _POSIX_TIMEOUTS* = 200809;
+ _POSIX_TIMERS* = 200809;
+ _POSIX_TRACE* = -1;
+ _POSIX_TRACE_EVENT_FILTER* = -1;
+ _POSIX_TRACE_INHERIT* = -1;
+ _POSIX_TRACE_LOG* = -1;
+ _POSIX_TYPED_MEMORY_OBJECTS* = -1;
+ _POSIX_V6_ILP32_OFF32* = 1;
+ _POSIX_V6_ILP32_OFFBIG* = 1;
+ _POSIX_V6_LP64_OFF64* = -1;
+ _POSIX_V6_LPBIG_OFFBIG* = -1;
+ _POSIX_V7_ILP32_OFF32* = 1;
+ _POSIX_V7_ILP32_OFFBIG* = 1;
+ _POSIX_V7_LP64_OFF64* = -1;
+ _POSIX_V7_LPBIG_OFFBIG* = -1;
+ _POSIX2_C_BIND* = 200809;
+ _POSIX2_C_DEV* = 200809;
+ _POSIX2_CHAR_TERM* = 200809;
+ _POSIX2_FORT_DEV* = -1;
+ _POSIX2_FORT_RUN* = -1;
+ _POSIX2_LOCALEDEF* = 200809;
+ _POSIX2_PBS* = -1;
+ _POSIX2_PBS_ACCOUNTING* = -1;
+ _POSIX2_PBS_CHECKPOINT* = -1;
+ _POSIX2_PBS_LOCATE* = -1;
+ _POSIX2_PBS_MESSAGE* = -1;
+ _POSIX2_PBS_TRACK* = -1;
+ _POSIX2_SW_DEV* = 200809;
+ _POSIX2_UPE* = -1;
+ _XOPEN_CRYPT* = 1;
+ _XOPEN_ENH_I18N* = 1;
+ _XOPEN_REALTIME* = 1;
+ _XOPEN_REALTIME_THREADS* = 1;
+ _XOPEN_SHM* = 1;
+ _XOPEN_STREAMS* = -1;
+ _XOPEN_UNIX* = 1;
+ _XOPEN_UUCP* = -1;
+
+ CONST
+ _POSIX_ASYNC_IO* = 1;
+ _POSIX_PRIO_IO* = -1;
+ _POSIX_SYNC_IO* = -1;
+ _POSIX_TIMESTAMP_RESOLUTION* = -1;
+ _POSIX2_SYMLINKS* = -1;
+
+ CONST
+ F_OK* = 0;
+ R_OK* = 4;
+ W_OK* = 2;
+ X_OK* = 1;
+
+ CONST
+ _CS_PATH* = 0;
+ _CS_POSIX_V7_ILP32_OFF32_CFLAGS* = 1132;
+ _CS_POSIX_V7_ILP32_OFF32_LDFLAGS* = 1133;
+ _CS_POSIX_V7_ILP32_OFF32_LIBS* = 1134;
+ _CS_POSIX_V7_ILP32_OFFBIG_CFLAGS* = 1136;
+ _CS_POSIX_V7_ILP32_OFFBIG_LDFLAGS* = 1137;
+ _CS_POSIX_V7_ILP32_OFFBIG_LIBS* = 1138;
+ _CS_POSIX_V7_LP64_OFF64_CFLAGS* = 1140;
+ _CS_POSIX_V7_LP64_OFF64_LDFLAGS* = 1141;
+ _CS_POSIX_V7_LP64_OFF64_LIBS* = 1142;
+ _CS_POSIX_V7_LPBIG_OFFBIG_CFLAGS* = 1144;
+ _CS_POSIX_V7_LPBIG_OFFBIG_LDFLAGS* = 1145;
+ _CS_POSIX_V7_LPBIG_OFFBIG_LIBS* = 1146;
+ _CS_POSIX_V7_THREADS_CFLAGS* = -1;
+ _CS_POSIX_V7_THREADS_LDFLAGS* = -1;
+ _CS_POSIX_V7_WIDTH_RESTRICTED_ENVS* = 5;
+ _CS_V7_ENV* = 1149;
+ _CS_POSIX_V6_ILP32_OFF32_CFLAGS* = 1116;
+ _CS_POSIX_V6_ILP32_OFF32_LDFLAGS* = 1117;
+ _CS_POSIX_V6_ILP32_OFF32_LIBS* = 1118;
+ _CS_POSIX_V6_ILP32_OFFBIG_CFLAGS* = 1120;
+ _CS_POSIX_V6_ILP32_OFFBIG_LDFLAGS* = 1121;
+ _CS_POSIX_V6_ILP32_OFFBIG_LIBS* = 1122;
+ _CS_POSIX_V6_LP64_OFF64_CFLAGS* = 1124;
+ _CS_POSIX_V6_LP64_OFF64_LDFLAGS* = 1125;
+ _CS_POSIX_V6_LP64_OFF64_LIBS* = 1126;
+ _CS_POSIX_V6_LPBIG_OFFBIG_CFLAGS* = 1128;
+ _CS_POSIX_V6_LPBIG_OFFBIG_LDFLAGS* = 1129;
+ _CS_POSIX_V6_LPBIG_OFFBIG_LIBS* = 1130;
+ _CS_POSIX_V6_WIDTH_RESTRICTED_ENVS* = 1;
+ _CS_V6_ENV* = 1148;
+
+ CONST
+ SEEK_CUR* = 1;
+ SEEK_END* = 2;
+ SEEK_SET* = 0;
+
+ CONST
+ F_LOCK* = 1;
+ F_TEST* = 3;
+ F_TLOCK* = 2;
+ F_ULOCK* = 0;
+
+ CONST
+ _PC_2_SYMLINKS* = 20;
+ _PC_ALLOC_SIZE_MIN* = 18;
+ _PC_ASYNC_IO* = 10;
+ _PC_CHOWN_RESTRICTED* = 6;
+ _PC_FILESIZEBITS* = 13;
+ _PC_LINK_MAX* = 0;
+ _PC_MAX_CANON* = 1;
+ _PC_MAX_INPUT* = 2;
+ _PC_NAME_MAX* = 3;
+ _PC_NO_TRUNC* = 7;
+ _PC_PATH_MAX* = 4;
+ _PC_PIPE_BUF* = 5;
+ _PC_PRIO_IO* = 11;
+ _PC_REC_INCR_XFER_SIZE* = 14;
+ _PC_REC_MAX_XFER_SIZE* = 15;
+ _PC_REC_MIN_XFER_SIZE* = 16;
+ _PC_REC_XFER_ALIGN* = 17;
+ _PC_SYMLINK_MAX* = 19;
+ _PC_SYNC_IO* = 9;
+ _PC_TIMESTAMP_RESOLUTION* = -1;
+ _PC_VDISABLE* = 8;
+
+ CONST
+ _SC_2_C_BIND* = 47;
+ _SC_2_C_DEV* = 48;
+ _SC_2_CHAR_TERM* = 95;
+ _SC_2_FORT_DEV* = 49;
+ _SC_2_FORT_RUN* = 50;
+ _SC_2_LOCALEDEF* = 52;
+ _SC_2_PBS* = 168;
+ _SC_2_PBS_ACCOUNTING* = 169;
+ _SC_2_PBS_CHECKPOINT* = 175;
+ _SC_2_PBS_LOCATE* = 170;
+ _SC_2_PBS_MESSAGE* = 171;
+ _SC_2_PBS_TRACK* = 172;
+ _SC_2_SW_DEV* = 51;
+ _SC_2_UPE* = 97;
+ _SC_2_VERSION* = 46;
+ _SC_ADVISORY_INFO* = 132;
+ _SC_AIO_LISTIO_MAX* = 23;
+ _SC_AIO_MAX* = 24;
+ _SC_AIO_PRIO_DELTA_MAX* = 25;
+ _SC_ARG_MAX* = 0;
+ _SC_ASYNCHRONOUS_IO* = 12;
+ _SC_ATEXIT_MAX* = 87;
+ _SC_BARRIERS* = 133;
+ _SC_BC_BASE_MAX* = 36;
+ _SC_BC_DIM_MAX* = 37;
+ _SC_BC_SCALE_MAX* = 38;
+ _SC_BC_STRING_MAX* = 39;
+ _SC_CHILD_MAX* = 1;
+ _SC_CLK_TCK* = 2;
+ _SC_CLOCK_SELECTION* = 137;
+ _SC_COLL_WEIGHTS_MAX* = 40;
+ _SC_CPUTIME* = 138;
+ _SC_DELAYTIMER_MAX* = 26;
+ _SC_EXPR_NEST_MAX* = 42;
+ _SC_FSYNC* = 15;
+ _SC_GETGR_R_SIZE_MAX* = 69;
+ _SC_GETPW_R_SIZE_MAX* = 70;
+ _SC_HOST_NAME_MAX* = 180;
+ _SC_IOV_MAX* = 60;
+ _SC_IPV6* = 235;
+ _SC_JOB_CONTROL* = 7;
+ _SC_LINE_MAX* = 43;
+ _SC_LOGIN_NAME_MAX* = 71;
+ _SC_MAPPED_FILES* = 16;
+ _SC_MEMLOCK* = 17;
+ _SC_MEMLOCK_RANGE* = 18;
+ _SC_MEMORY_PROTECTION* = 19;
+ _SC_MESSAGE_PASSING* = 20;
+ _SC_MONOTONIC_CLOCK* = 149;
+ _SC_MQ_OPEN_MAX* = 27;
+ _SC_MQ_PRIO_MAX* = 28;
+ _SC_NGROUPS_MAX* = 3;
+ _SC_OPEN_MAX* = 4;
+ _SC_PAGE_SIZE* = 30;
+ _SC_PAGESIZE* = 30;
+ _SC_PRIORITIZED_IO* = 13;
+ _SC_PRIORITY_SCHEDULING* = 10;
+ _SC_RAW_SOCKETS* = 236;
+ _SC_RE_DUP_MAX* = 44;
+ _SC_READER_WRITER_LOCKS* = 153;
+ _SC_REALTIME_SIGNALS* = 9;
+ _SC_REGEXP* = 155;
+ _SC_RTSIG_MAX* = 31;
+ _SC_SAVED_IDS* = 8;
+ _SC_SEM_NSEMS_MAX* = 32;
+ _SC_SEM_VALUE_MAX* = 33;
+ _SC_SEMAPHORES* = 21;
+ _SC_SHARED_MEMORY_OBJECTS* = 22;
+ _SC_SHELL* = 157;
+ _SC_SIGQUEUE_MAX* = 34;
+ _SC_SPAWN* = 159;
+ _SC_SPIN_LOCKS* = 154;
+ _SC_SPORADIC_SERVER* = 160;
+ _SC_SS_REPL_MAX* = 241;
+ _SC_STREAM_MAX* = 5;
+ _SC_SYMLOOP_MAX* = 173;
+ _SC_SYNCHRONIZED_IO* = 14;
+ _SC_THREAD_ATTR_STACKADDR* = 77;
+ _SC_THREAD_ATTR_STACKSIZE* = 78;
+ _SC_THREAD_CPUTIME* = 139;
+ _SC_THREAD_DESTRUCTOR_ITERATIONS* = 73;
+ _SC_THREAD_KEYS_MAX* = 74;
+ _SC_THREAD_PRIO_INHERIT* = 80;
+ _SC_THREAD_PRIO_PROTECT* = 81;
+ _SC_THREAD_PRIORITY_SCHEDULING* = 79;
+ _SC_THREAD_PROCESS_SHARED* = 82;
+ _SC_THREAD_ROBUST_PRIO_INHERIT* = 247;
+ _SC_THREAD_ROBUST_PRIO_PROTECT* = 248;
+ _SC_THREAD_SAFE_FUNCTIONS* = 68;
+ _SC_THREAD_SPORADIC_SERVER* = 161;
+ _SC_THREAD_STACK_MIN* = 75;
+ _SC_THREAD_THREADS_MAX* = 76;
+ _SC_THREADS* = 67;
+ _SC_TIMEOUTS* = 164;
+ _SC_TIMER_MAX* = 35;
+ _SC_TIMERS* = 11;
+ _SC_TRACE* = 181;
+ _SC_TRACE_EVENT_FILTER* = 182;
+ _SC_TRACE_EVENT_NAME_MAX* = 242;
+ _SC_TRACE_INHERIT* = 183;
+ _SC_TRACE_LOG* = 184;
+ _SC_TRACE_NAME_MAX* = 243;
+ _SC_TRACE_SYS_MAX* = 244;
+ _SC_TRACE_USER_EVENT_MAX* = 245;
+ _SC_TTY_NAME_MAX* = 72;
+ _SC_TYPED_MEMORY_OBJECTS* = 165;
+ _SC_TZNAME_MAX* = 6;
+ _SC_V7_ILP32_OFF32* = 237;
+ _SC_V7_ILP32_OFFBIG* = 238;
+ _SC_V7_LP64_OFF64* = 239;
+ _SC_V7_LPBIG_OFFBIG* = 240;
+ _SC_V6_ILP32_OFF32* = 176;
+ _SC_V6_ILP32_OFFBIG* = 177;
+ _SC_V6_LP64_OFF64* = 178;
+ _SC_V6_LPBIG_OFFBIG* = 179;
+ _SC_VERSION* = 29;
+ _SC_XOPEN_CRYPT* = 92;
+ _SC_XOPEN_ENH_I18N* = 93;
+ _SC_XOPEN_REALTIME* = 130;
+ _SC_XOPEN_REALTIME_THREADS* = 131;
+ _SC_XOPEN_SHM* = 94;
+ _SC_XOPEN_STREAMS* = 246;
+ _SC_XOPEN_UNIX* = 91;
+ _SC_XOPEN_UUCP* = -1;
+ _SC_XOPEN_VERSION* = 89;
+
+ CONST
+ STDERR_FILENO* = 2;
+ STDIN_FILENO* = 0;
+ STDOUT_FILENO* = 1;
+
+ CONST
+ _POSIX_VDISABLE* = 0;
+
+ TYPE
+ size_t* = C99sys_types.size_t;
+ ssize_t* = C99sys_types.ssize_t;
+ uid_t* = C99sys_types.uid_t;
+ gid_t* = C99sys_types.gid_t;
+ off_t* = C99sys_types.off_t;
+ pid_t* = C99sys_types.pid_t;
+
+ TYPE
+ intptr_t* = INTEGER;
+
+ PROCEDURE [ccall] access* (IN path: ARRAY [untagged] OF SHORTCHAR; amode: int): int;
+ PROCEDURE [ccall] alarm* (seconds: unsigned): unsigned;
+ PROCEDURE [ccall] chdir* (IN path: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] chown* (IN path: ARRAY [untagged] OF SHORTCHAR; owner: uid_t; group: gid_t): int;
+ PROCEDURE [ccall] close* (fd: int): int;
+ PROCEDURE [ccall] confstr* (name: int; VAR buf: ARRAY [untagged] OF SHORTCHAR; len: size_t);
+ PROCEDURE [ccall] crypt* (IN key, salt: ARRAY [untagged] OF SHORTCHAR);
+ PROCEDURE [ccall] dup* (oldfd: int): int;
+ PROCEDURE [ccall] dup2* (oldfd, newfd: int): int;
+ PROCEDURE [ccall] _exit* (status: int);
+ PROCEDURE [ccall] encrypt* (VAR block: ARRAY [untagged] 64 OF SHORTCHAR; edflag: int);
+ PROCEDURE [ccall] execv* (IN path: ARRAY [untagged] OF SHORTCHAR; IN argv: ARRAY [untagged] OF POINTER TO ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] execve* (IN path: ARRAY [untagged] OF SHORTCHAR; IN argv, envp: ARRAY [untagged] OF POINTER TO ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] execvp* (IN file: ARRAY [untagged] OF SHORTCHAR; IN argv, envp: ARRAY [untagged] OF POINTER TO ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] faccessat* (fd: int; IN path: ARRAY [untagged] OF SHORTCHAR; amode, flag: int): int;
+ PROCEDURE [ccall] fchdir* (fildes: int): int;
+ PROCEDURE [ccall] fchown* (fildes: int; owner: uid_t; group: gid_t): int;
+ PROCEDURE [ccall] fchownat* (fd: int; IN path: ARRAY [untagged] OF SHORTCHAR; owner: uid_t; group: gid_t; flag: int): int;
+ PROCEDURE [ccall] fdatasync* (fildes: int): int;
+ PROCEDURE [ccall] fexecve* (fd: int; IN argv, envp: ARRAY [untagged] OF POINTER TO ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] fork* (): pid_t;
+ PROCEDURE [ccall] fpathconf* (fd, name: int): long;
+ PROCEDURE [ccall] fsync* (fildes: int): int;
+ PROCEDURE [ccall] ftruncate* (fildes: int; length: off_t): int;
+ PROCEDURE [ccall] getcwd* (VAR [nil] buf: ARRAY [untagged] OF SHORTCHAR; size: size_t): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] getegid* (): gid_t;
+ PROCEDURE [ccall] geteuid* (): uid_t;
+ PROCEDURE [ccall] getgid* (): gid_t;
+ PROCEDURE [ccall] getgroups* (gidsetsize: int; VAR grouplist: ARRAY [untagged] OF gid_t): int;
+ PROCEDURE [ccall] gethostid* (): long;
+ PROCEDURE [ccall] gethostname* (VAR name: ARRAY [untagged] OF SHORTCHAR; namelen: size_t): int;
+ PROCEDURE [ccall] getlogin* (): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] getlogin_r* (VAR buf: ARRAY [untagged] OF SHORTCHAR; bufsize: size_t): int;
+ PROCEDURE [ccall] getopt* (argc: int; IN argv: ARRAY [untagged] OF POINTER TO ARRAY [untagged] OF SHORTCHAR; IN optstring: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] getpgid* (pid: pid_t): pid_t;
+ PROCEDURE [ccall] getpgrp* (): pid_t;
+ PROCEDURE [ccall] getpid* (): pid_t;
+ PROCEDURE [ccall] getppid* (): pid_t;
+ PROCEDURE [ccall] getsid* (): pid_t;
+ PROCEDURE [ccall] getuid* (): uid_t;
+ PROCEDURE [ccall] isatty* (fd: int): int;
+ PROCEDURE [ccall] lchown* (IN path: ARRAY [untagged] OF SHORTCHAR; owner: uid_t; group: gid_t): int;
+ PROCEDURE [ccall] link* (IN path1, path2: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] linkat* (fd1: int; IN path1: ARRAY [untagged] OF SHORTCHAR; fd2: int; IN path2: ARRAY [untagged] OF SHORTCHAR; flag: int): int;
+ PROCEDURE [ccall] lockf* (fd, cmd: int; len: off_t): int;
+ PROCEDURE [ccall] lseek* (fildes: int; offset: off_t; whence: int): off_t;
+ PROCEDURE [ccall] nice* (incr: int): int;
+ PROCEDURE [ccall] pathconf* (IN path: ARRAY [untagged] OF SHORTCHAR; name: int): long;
+ PROCEDURE [ccall] pause* (): int;
+ PROCEDURE [ccall] pipe* (VAR fildes: ARRAY [untagged] 2 OF int): int;
+ PROCEDURE [ccall] pread* (fildes: int; buf: C99types.Pvoid; nbyte: size_t; offset: off_t): ssize_t;
+ PROCEDURE [ccall] pwrite* (fildes: int; buf: C99types.Pvoid; nbyte: size_t; offset: off_t): ssize_t;
+ PROCEDURE [ccall] read* (fildes: int; buf: C99types.Pvoid; nbyte: size_t): ssize_t;
+ PROCEDURE [ccall] readlink* (IN path: ARRAY [untagged] OF SHORTCHAR; VAR buf: ARRAY [untagged] OF SHORTCHAR; bufsize: size_t): ssize_t;
+ PROCEDURE [ccall] readlinkat* (fd: int; IN path: ARRAY [untagged] OF SHORTCHAR; VAR buf: ARRAY [untagged] OF SHORTCHAR; bufsize: size_t): ssize_t;
+ PROCEDURE [ccall] rmdir* (IN path: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] setegid* (gid: gid_t): int;
+ PROCEDURE [ccall] seteuid* (uid: uid_t): int;
+ PROCEDURE [ccall] setgid* (gid: gid_t): int;
+ PROCEDURE [ccall] setpgid* (pid, pgid: pid_t): int;
+ PROCEDURE [ccall] setpgrp* (): pid_t;
+ PROCEDURE [ccall] setregid* (rgid, egid: pid_t): int;
+ PROCEDURE [ccall] setreuid* (ruid, euid: uid_t): int;
+ PROCEDURE [ccall] setsid* (): pid_t;
+ PROCEDURE [ccall] setuid* (uid: uid_t): int;
+ PROCEDURE [ccall] sleep* (seconds: unsigned): unsigned;
+ PROCEDURE [ccall] swab* (from, to: C99types.Pvoid; n: ssize_t);
+ PROCEDURE [ccall] symlink* (IN path1, path2: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] symlinkat* (IN path1: ARRAY [untagged] OF SHORTCHAR; fd: int; IN path2: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] sync* ;
+ PROCEDURE [ccall] sysconf* (name: int): long;
+ PROCEDURE [ccall] tcgetpgrp* (fd: int): pid_t;
+ PROCEDURE [ccall] tcsetpgrp* (fd: int; pgrp: pid_t): int;
+ PROCEDURE [ccall] truncate* (IN path: ARRAY [untagged] OF SHORTCHAR; length: off_t): int;
+ PROCEDURE [ccall] ttyname* (fd: int): POINTER TO ARRAY [untagged] OF SHORTCHAR;
+ PROCEDURE [ccall] ttyname_r* (fd: int; VAR buf: ARRAY [untagged] OF SHORTCHAR; buflen: size_t): int;
+ PROCEDURE [ccall] unlink* (IN path: ARRAY [untagged] OF SHORTCHAR): int;
+ PROCEDURE [ccall] unlinkat* (fd: int; IN path: ARRAY [untagged] OF SHORTCHAR; flag: int): int;
+ PROCEDURE [ccall] write* (fildes: int; buf: C99types.Pvoid; nbyte: size_t): int;
+
+END C99unistd.
diff --git a/src/i486/linux/C99/Mod/wctype.cp b/src/i486/linux/C99/Mod/wctype.cp
--- /dev/null
@@ -0,0 +1,58 @@
+MODULE C99wctype ['libc.so.6'];
+
+ (* generated by genposix.sh, do not modify *)
+
+ IMPORT SYSTEM, C99types, C99locale;
+
+ TYPE
+ char* = C99types.char;
+ signed_char* = C99types.signed_char;
+ unsigned_char* = C99types.unsigned_char;
+ short* = C99types.short;
+ short_int* = C99types.short_int;
+ signed_short* = C99types.signed_short;
+ signed_short_int* = C99types.signed_short_int;
+ unsigned_short* = C99types.unsigned_short;
+ unsigned_short_int* = C99types.unsigned_short_int;
+ int* = C99types.int;
+ signed* = C99types.signed;
+ signed_int* = C99types.signed_int;
+ unsigned* = C99types.unsigned;
+ unsigned_int* = C99types.unsigned_int;
+ long* = C99types.long;
+ long_int* = C99types.long_int;
+ signed_long* = C99types.signed_long;
+ signed_long_int* = C99types.signed_long_int;
+ unsigned_long* = C99types.unsigned_long;
+ unsigned_long_int* = C99types.unsigned_long_int;
+ long_long* = C99types.long_long;
+ long_long_int* = C99types.long_long_int;
+ signed_long_long* = C99types.signed_long_long;
+ signed_long_long_int* = C99types.signed_long_long_int;
+ unsigned_long_long* = C99types.unsigned_long_long;
+ unsigned_long_long_int* = C99types.unsigned_long_long_int;
+ float* = C99types.float;
+ double* = C99types.double;
+ long_double* = C99types.long_double;
+
+ TYPE
+ wint_t* = INTEGER;
+ wctype_t* = INTEGER;
+
+ TYPE
+ wctrans_t* = INTEGER;
+
+ TYPE
+ locale_t* = C99locale.locale_t;
+
+ CONST
+ WEOF* = -1;
+
+ PROCEDURE [ccall] iswalpha* (wc: wint_t): int;
+ PROCEDURE [ccall] iswdigit* (wc: wint_t): int;
+ PROCEDURE [ccall] iswlower* (wc: wint_t): int;
+ PROCEDURE [ccall] iswupper* (wc: wint_t): int;
+ PROCEDURE [ccall] towlower* (wc: wint_t): wint_t;
+ PROCEDURE [ccall] towupper* (wc: wint_t): wint_t;
+
+END C99wctype.
diff --git a/src/i486/linux/System/Mod/Kernel.cp b/src/i486/linux/System/Mod/Kernel.cp
--- /dev/null
@@ -0,0 +1,1708 @@
+MODULE Kernel;
+
+ IMPORT S := SYSTEM, stdlib := C99stdlib, stdio := C99stdio,
+ time := C99time, wctype := C99wctype, sysmman := C99sys_mman,
+ dlfcn := C99dlfcn, types := C99types, fcntl := C99fcntl,
+ unistd := C99unistd, signal := C99signal, setjmp := C99setjmp;
+
+ (* init fpu? *)
+ (* add signal blocking to avoid race conditions in Try/Trap/TrapHandler *)
+ (* add BeepHook for Beep *)
+ (* implement Call using libffi *)
+
+ CONST
+ nameLen* = 256;
+
+ littleEndian* = TRUE;
+ timeResolution* = 1000; (* ticks per second *)
+
+ processor* = 1; (* generic c *)
+
+ objType* = "ocf"; (* file types *)
+ symType* = "osf";
+ docType* = "odc";
+
+ (* loader constants *)
+ done* = 0;
+ fileNotFound* = 1;
+ syntaxError* = 2;
+ objNotFound* = 3;
+ illegalFPrint* = 4;
+ cyclicImport* = 5;
+ noMem* = 6;
+ commNotFound* = 7;
+ commSyntaxError* = 8;
+ moduleNotFound* = 9;
+
+ any = 1000000;
+
+ CX = 1;
+ SP = 4; (* register number of stack pointer *)
+ FP = 5; (* register number of frame pointer *)
+ ML = 3; (* register which holds the module list at program start *)
+
+ strictStackSweep = FALSE;
+ N = 128 DIV 16; (* free lists *)
+
+ (* kernel flags in module desc *)
+ init = 16; dyn = 17; dll = 24; iptrs = 30;
+
+ (* meta interface consts *)
+ mConst = 1; mTyp = 2; mVar = 3; mProc = 4; mField = 5;
+
+ TYPE
+ Name* = ARRAY nameLen OF CHAR;
+ Utf8Name* = ARRAY nameLen OF SHORTCHAR;
+ Command* = PROCEDURE;
+
+ Module* = POINTER TO RECORD [untagged]
+ next-: Module;
+ opts-: SET; (* 0..15: compiler opts, 16..31: kernel flags *)
+ refcnt-: INTEGER; (* <0: module invalidated *)
+ compTime-, loadTime-: ARRAY 6 OF SHORTINT;
+ ext-: INTEGER; (* currently not used *)
+ term-: Command; (* terminator *)
+ nofimps-, nofptrs-: INTEGER;
+ csize-, dsize-, rsize-: INTEGER;
+ code-, data-, refs-: INTEGER;
+ procBase-, varBase-: INTEGER; (* meta base addresses *)
+ names-: POINTER TO ARRAY [untagged] OF SHORTCHAR; (* names[0] = 0X *)
+ ptrs-: POINTER TO ARRAY [untagged] OF INTEGER;
+ imports-: POINTER TO ARRAY [untagged] OF Module;
+ export-: Directory; (* exported objects (name sorted) *)
+ name-: Utf8Name
+ END;
+
+ Type* = POINTER TO RECORD [untagged]
+ (* record: ptr to method n at offset - 4 * (n+1) *)
+ size-: INTEGER; (* record: size, array: #elem, dyn array: 0, proc: sigfp *)
+ mod-: Module;
+ id-: INTEGER; (* name idx * 256 + lev * 16 + attr * 4 + form *)
+ base-: ARRAY 16 OF Type; (* signature if form = ProcTyp *)
+ fields-: Directory; (* new fields (declaration order) *)
+ ptroffs-: ARRAY any OF INTEGER (* array of any length *)
+ END;
+
+ Object* = POINTER TO ObjDesc;
+
+ ObjDesc* = RECORD [untagged]
+ fprint-: INTEGER;
+ offs-: INTEGER; (* pvfprint for record types *)
+ id-: INTEGER; (* name idx * 256 + vis * 16 + mode *)
+ struct-: Type (* id of basic type or pointer to typedesc/signature *)
+ END;
+
+ Directory* = POINTER TO RECORD [untagged]
+ num-: INTEGER; (* number of entries *)
+ obj-: ARRAY any OF ObjDesc (* array of any length *)
+ END;
+
+ Signature* = POINTER TO RECORD [untagged]
+ retStruct-: Type; (* id of basic type or pointer to typedesc or 0 *)
+ num-: INTEGER; (* number of parameters *)
+ par-: ARRAY any OF RECORD [untagged] (* parameters *)
+ id-: INTEGER; (* name idx * 256 + kind *)
+ struct-: Type (* id of basic type or pointer to typedesc *)
+ END
+ END;
+
+ Handler* = PROCEDURE;
+
+ Reducer* = POINTER TO ABSTRACT RECORD
+ next: Reducer
+ END;
+
+ Identifier* = ABSTRACT RECORD
+ typ*: INTEGER;
+ obj-: ANYPTR
+ END;
+
+ TrapCleaner* = POINTER TO ABSTRACT RECORD
+ next: TrapCleaner
+ END;
+
+ TryHandler* = PROCEDURE (a, b, c: INTEGER);
+
+ (* meta extension suport *)
+
+ ItemExt* = POINTER TO ABSTRACT RECORD END;
+
+ ItemAttr* = RECORD
+ obj*, vis*, typ*, adr*: INTEGER;
+ mod*: Module;
+ desc*: Type;
+ ptr*: S.PTR;
+ ext*: ItemExt
+ END;
+
+ Hook* = POINTER TO ABSTRACT RECORD END;
+
+ LoaderHook* = POINTER TO ABSTRACT RECORD (Hook)
+ res*: INTEGER;
+ importing*, imported*, object*: ARRAY 256 OF CHAR
+ END;
+
+ Block = POINTER TO RECORD [untagged]
+ tag: Type;
+ last: INTEGER; (* arrays: last element *)
+ actual: INTEGER; (* arrays: used during mark phase *)
+ first: INTEGER (* arrays: first element *)
+ END;
+
+ FreeBlock = POINTER TO FreeDesc;
+
+ FreeDesc = RECORD [untagged]
+ tag: Type; (* f.tag = ADR(f.size) *)
+ size: INTEGER;
+ next: FreeBlock
+ END;
+
+ Cluster = POINTER TO RECORD [untagged]
+ size: INTEGER; (* total size *)
+ next: Cluster;
+ max: INTEGER (* exe: reserved size, dll: original address *)
+ (* start of first block *)
+ END;
+
+ FList = POINTER TO RECORD
+ next: FList;
+ blk: Block;
+ iptr, aiptr: BOOLEAN
+ END;
+
+ CList = POINTER TO RECORD
+ next: CList;
+ do: Command;
+ trapped: BOOLEAN
+ END;
+
+
+ PtrType = RECORD v: S.PTR END; (* used for array of pointer *)
+ Char8Type = RECORD v: SHORTCHAR END;
+ Char16Type = RECORD v: CHAR END;
+ Int8Type = RECORD v: BYTE END;
+ Int16Type = RECORD v: SHORTINT END;
+ Int32Type = RECORD v: INTEGER END;
+ Int64Type = RECORD v: LONGINT END;
+ BoolType = RECORD v: BOOLEAN END;
+ SetType = RECORD v: SET END;
+ Real32Type = RECORD v: SHORTREAL END;
+ Real64Type = RECORD v: REAL END;
+ ProcType = RECORD v: PROCEDURE END;
+ UPtrType = RECORD v: INTEGER END;
+ StrPtr = POINTER TO ARRAY [untagged] OF SHORTCHAR;
+
+ ArrStrPtr = POINTER TO ARRAY [untagged] OF StrPtr;
+
+ ADDRESS* = types.Pvoid;
+
+ VAR
+ baseStack: INTEGER;
+ root: Cluster;
+ modList-: Module;
+ trapCount-: INTEGER;
+ err-, pc-, sp-, fp-, stack-, val-: INTEGER;
+
+ isTry, testRead: BOOLEAN;
+ startEnv: setjmp.sigjmp_buf;
+ tryEnv, readEnv: setjmp.jmp_buf;
+
+ argc-: INTEGER;
+ argv-: ArrStrPtr;
+ pagesize: unistd.long;
+
+ free: ARRAY N OF FreeBlock; (* free list *)
+ sentinelBlock: FreeDesc;
+ sentinel: FreeBlock;
+ candidates: ARRAY 1024 OF INTEGER;
+ nofcand: INTEGER;
+ allocated: INTEGER; (* bytes allocated on BlackBox heap *)
+ total: INTEGER; (* current total size of BlackBox heap *)
+ used: INTEGER; (* bytes allocated on system heap *)
+ finalizers: FList;
+ hotFinalizers: FList;
+ cleaners: CList;
+ reducers: Reducer;
+ trapStack: TrapCleaner;
+ actual: Module; (* valid during module initialization *)
+
+ trapViewer, trapChecker: Handler;
+ trapped, guarded, secondTrap: BOOLEAN;
+ interrupted: BOOLEAN;
+ static, inDll, terminating: BOOLEAN;
+ restart: Command;
+
+ loader: LoaderHook;
+ loadres: INTEGER;
+
+ wouldFinalize: BOOLEAN;
+
+ watcher*: PROCEDURE (event: INTEGER); (* for debugging *)
+
+ PROCEDURE Erase (adr, words: INTEGER);
+ BEGIN
+ ASSERT(words >= 0, 20);
+ WHILE words > 0 DO
+ S.PUT(adr, 0);
+ INC(adr, 4);
+ DEC(words)
+ END
+ END Erase;
+
+
+ PROCEDURE (VAR id: Identifier) Identified* (): BOOLEAN, NEW, ABSTRACT;
+ PROCEDURE (r: Reducer) Reduce* (full: BOOLEAN), NEW, ABSTRACT;
+ PROCEDURE (c: TrapCleaner) Cleanup*, NEW, EMPTY;
+
+ (* meta extension suport *)
+
+ PROCEDURE (e: ItemExt) Lookup* (name: ARRAY OF CHAR; VAR i: ANYREC), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) Index* (index: INTEGER; VAR elem: ANYREC), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) Deref* (VAR ref: ANYREC), NEW, ABSTRACT;
+
+ PROCEDURE (e: ItemExt) Valid* (): BOOLEAN, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) Size* (): INTEGER, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) BaseTyp* (): INTEGER, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) Len* (): INTEGER, NEW, ABSTRACT;
+
+ PROCEDURE (e: ItemExt) Call* (OUT ok: BOOLEAN), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) BoolVal* (): BOOLEAN, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutBoolVal* (x: BOOLEAN), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) CharVal* (): CHAR, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutCharVal* (x: CHAR), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) IntVal* (): INTEGER, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutIntVal* (x: INTEGER), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) LongVal* (): LONGINT, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutLongVal* (x: LONGINT), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) RealVal* (): REAL, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutRealVal* (x: REAL), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) SetVal* (): SET, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutSetVal* (x: SET), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PtrVal* (): ANYPTR, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutPtrVal* (x: ANYPTR), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) GetSStringVal* (OUT x: ARRAY OF SHORTCHAR;
+ OUT ok: BOOLEAN), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutSStringVal* (IN x: ARRAY OF SHORTCHAR;
+ OUT ok: BOOLEAN), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) GetStringVal* (OUT x: ARRAY OF CHAR; OUT ok: BOOLEAN), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutStringVal* (IN x: ARRAY OF CHAR; OUT ok: BOOLEAN), NEW, ABSTRACT;
+
+ (* -------------------- miscellaneous tools -------------------- *)
+
+ PROCEDURE IsUpper* (ch: CHAR): BOOLEAN;
+ BEGIN
+ RETURN wctype.iswupper(ORD(ch)) # 0
+ END IsUpper;
+
+ PROCEDURE Upper* (ch: CHAR): CHAR;
+ BEGIN
+ RETURN CHR(wctype.towupper(ORD(ch)))
+ END Upper;
+
+ PROCEDURE IsLower* (ch: CHAR): BOOLEAN;
+ BEGIN
+ RETURN wctype.iswlower(ORD(ch)) # 0
+ END IsLower;
+
+ PROCEDURE Lower* (ch: CHAR): CHAR;
+ BEGIN
+ RETURN CHR(wctype.towlower(ORD(ch)))
+ END Lower;
+
+ PROCEDURE IsAlpha* (ch: CHAR): BOOLEAN;
+ BEGIN
+ RETURN wctype.iswalpha(ORD(ch)) # 0
+ END IsAlpha;
+
+ PROCEDURE Utf8ToString* (IN in: ARRAY OF SHORTCHAR; OUT out: ARRAY OF CHAR; OUT res: INTEGER);
+ VAR i, j, val, max: INTEGER; ch: SHORTCHAR;
+
+ PROCEDURE FormatError();
+ BEGIN out := in$; res := 2 (*format error*)
+ END FormatError;
+
+ BEGIN
+ ch := in[0]; i := 1; j := 0; max := LEN(out) - 1;
+ WHILE (ch # 0X) & (j < max) DO
+ IF ch < 80X THEN
+ out[j] := ch; INC(j)
+ ELSIF ch < 0E0X THEN
+ val := ORD(ch) - 192;
+ IF val < 0 THEN FormatError; RETURN END ;
+ ch := in[i]; INC(i); val := val * 64 + ORD(ch) - 128;
+ IF (ch < 80X) OR (ch >= 0E0X) THEN FormatError; RETURN END ;
+ out[j] := CHR(val); INC(j)
+ ELSIF ch < 0F0X THEN
+ val := ORD(ch) - 224;
+ ch := in[i]; INC(i); val := val * 64 + ORD(ch) - 128;
+ IF (ch < 80X) OR (ch >= 0E0X) THEN FormatError; RETURN END ;
+ ch := in[i]; INC(i); val := val * 64 + ORD(ch) - 128;
+ IF (ch < 80X) OR (ch >= 0E0X) THEN FormatError; RETURN END ;
+ out[j] := CHR(val); INC(j)
+ ELSE
+ FormatError; RETURN
+ END ;
+ ch := in[i]; INC(i)
+ END;
+ out[j] := 0X;
+ IF ch = 0X THEN res := 0 (*ok*) ELSE res := 1 (*truncated*) END
+ END Utf8ToString;
+
+ PROCEDURE StringToUtf8* (IN in: ARRAY OF CHAR; OUT out: ARRAY OF SHORTCHAR; OUT res: INTEGER);
+ VAR i, j, val, max: INTEGER;
+ BEGIN
+ i := 0; j := 0; max := LEN(out) - 3;
+ WHILE (in[i] # 0X) & (j < max) DO
+ val := ORD(in[i]); INC(i);
+ IF val < 128 THEN
+ out[j] := SHORT(CHR(val)); INC(j)
+ ELSIF val < 2048 THEN
+ out[j] := SHORT(CHR(val DIV 64 + 192)); INC(j);
+ out[j] := SHORT(CHR(val MOD 64 + 128)); INC(j)
+ ELSE
+ out[j] := SHORT(CHR(val DIV 4096 + 224)); INC(j);
+ out[j] := SHORT(CHR(val DIV 64 MOD 64 + 128)); INC(j);
+ out[j] := SHORT(CHR(val MOD 64 + 128)); INC(j)
+ END;
+ END;
+ out[j] := 0X;
+ IF in[i] = 0X THEN res := 0 (*ok*) ELSE res := 1 (*truncated*) END
+ END StringToUtf8;
+
+ PROCEDURE SplitName* (name: ARRAY OF CHAR; VAR head, tail: ARRAY OF CHAR);
+ (* portable *)
+ VAR i, j: INTEGER; ch, lch: CHAR;
+ BEGIN
+ i := 0; ch := name[0];
+ IF ch # 0X THEN
+ REPEAT
+ head[i] := ch; lch := ch; INC(i); ch := name[i]
+ UNTIL (ch = 0X) OR (ch = ".") OR IsUpper(ch) & ~IsUpper(lch);
+ IF ch = "." THEN i := 0; ch := name[0] END;
+ head[i] := 0X; j := 0;
+ WHILE ch # 0X DO tail[j] := ch; INC(i); INC(j); ch := name[i] END;
+ tail[j] := 0X;
+ IF tail = "" THEN tail := head$; head := "" END
+ ELSE head := ""; tail := ""
+ END
+ END SplitName;
+
+ PROCEDURE MakeFileName* (VAR name: ARRAY OF CHAR; type: ARRAY OF CHAR);
+ VAR i, j: INTEGER; ext: ARRAY 8 OF CHAR; ch: CHAR;
+ BEGIN
+ i := 0;
+ WHILE (name[i] # 0X) & (name[i] # ".") DO INC(i) END;
+ IF name[i] = "." THEN
+ IF name[i + 1] = 0X THEN name[i] := 0X END
+ ELSE
+ IF type = "" THEN ext := docType ELSE ext := type$ END;
+ IF i < LEN(name) - LEN(ext$) - 1 THEN
+ name[i] := "."; INC(i); j := 0; ch := ext[0];
+ WHILE ch # 0X DO
+ name[i] := Lower(ch); INC(i); INC(j); ch := ext[j]
+ END;
+ name[i] := 0X
+ END
+ END
+ END MakeFileName;
+
+ PROCEDURE Time* (): LONGINT;
+ VAR res: time.int; tp: time.struct_timespec;
+ BEGIN
+ ASSERT(timeResolution >= 1);
+ ASSERT(timeResolution <= 1000000000);
+ res := time.clock_gettime(time.CLOCK_MONOTONIC, tp);
+ ASSERT(res = 0, 100);
+ RETURN tp.tv_sec * LONG(timeResolution) + tp.tv_nsec DIV LONG(1000000000 DIV timeResolution)
+ END Time;
+
+ PROCEDURE Beep*;
+ (* !!! *)
+ END Beep;
+
+ PROCEDURE SearchProcVar* (var: INTEGER; VAR m: Module; VAR adr: INTEGER);
+ BEGIN
+ adr := var; m := NIL;
+ IF var # 0 THEN
+ m := modList;
+ WHILE (m # NIL) & ((var < m.code) OR (var >= m.code + m.csize)) DO m := m.next END;
+ IF m # NIL THEN DEC(adr, m.code) END
+ END
+ END SearchProcVar;
+
+ (* -------------------- system memory management --------------------- *)
+
+ PROCEDURE AllocMem (size: sysmman.size_t; VAR max: sysmman.size_t): ADDRESS;
+ VAR fd, flags, res: fcntl.int; ptr: ADDRESS;
+ BEGIN
+ max := (size + pagesize - 1) DIV pagesize * pagesize;
+ fd := fcntl.open("/dev/zero", fcntl.O_RDWR, 0);
+ IF fd # -1 THEN
+ flags := sysmman.PROT_READ + sysmman.PROT_WRITE;
+ ptr := sysmman.mmap(0, max, flags, sysmman.MAP_PRIVATE, fd, 0);
+ IF ptr = sysmman.MAP_FAILED THEN ptr := 0 END;
+ res := unistd.close(fd);
+ ASSERT(res = 0, 100)
+ ELSE
+ ptr := 0
+ END;
+ RETURN ptr
+ END AllocMem;
+
+ PROCEDURE FreeMem (adr: ADDRESS; size: sysmman.size_t);
+ VAR res: types.int;
+ BEGIN
+ size := (size + pagesize - 1) DIV pagesize * pagesize;
+ res := sysmman.munmap(adr, size);
+ ASSERT(res = 0, 100)
+ END FreeMem;
+
+ PROCEDURE AllocHeapMem (size: INTEGER; VAR c: Cluster);
+ CONST N = 65536; (* cluster size for dll *)
+ VAR adr, allocated: INTEGER;
+ BEGIN
+ INC(size, 16);
+ ASSERT(size > 0, 100); adr := 0;
+ IF size < N THEN adr := stdlib.malloc(N) END;
+ IF adr = 0 THEN adr := stdlib.malloc(size); allocated := size ELSE allocated := N END;
+ IF adr = 0 THEN c := NIL
+ ELSE
+ c := S.VAL(Cluster, (adr + 15) DIV 16 * 16); c.max := adr;
+ c.size := allocated - (S.VAL(INTEGER, c) - adr);
+ INC(used, c.size); INC(total, c.size)
+ END;
+ ASSERT((adr = 0) OR (adr MOD 16 = 0) & (c.size >= size), 101);
+ (* post: (c = NIL) OR (c MOD 16 = 0) & (c.size >= size) *)
+ END AllocHeapMem;
+
+ PROCEDURE FreeHeapMem (c: Cluster);
+ BEGIN
+ DEC(used, c.size); DEC(total, c.size);
+ stdlib.free(S.VAL(ADDRESS, c.max))
+ END FreeHeapMem;
+
+ PROCEDURE HeapFull (size: INTEGER): BOOLEAN;
+ BEGIN
+ RETURN TRUE
+ END HeapFull;
+
+ PROCEDURE AllocModMem* (descSize, modSize: INTEGER; VAR descAdr, modAdr: INTEGER);
+ BEGIN
+ descAdr := 0; modAdr := 0;
+ descAdr := AllocMem(descSize, descSize);
+ IF descAdr # 0 THEN
+ modAdr := AllocMem(modSize, modSize);
+ IF modAdr = 0 THEN
+ FreeMem(descAdr, descSize)
+ ELSE
+ INC(used, descSize + modSize)
+ END
+ END
+ END AllocModMem;
+
+ PROCEDURE DeallocModMem* (descSize, modSize, descAdr, modAdr: INTEGER);
+ BEGIN
+ FreeMem(descAdr, descSize);
+ FreeMem(modAdr, modSize);
+ DEC(used, descSize + modSize)
+ END DeallocModMem;
+
+ PROCEDURE InvalModMem (modSize, modAdr: INTEGER);
+ BEGIN
+ FreeMem(modAdr, modSize)
+ END InvalModMem;
+
+ PROCEDURE IsReadable* (from, to: INTEGER): BOOLEAN;
+ VAR i: INTEGER; x: BYTE; res: setjmp.int;
+ BEGIN
+ testRead := TRUE;
+ res := setjmp.setjmp(readEnv);
+ IF res = 0 THEN
+ IF from <= to THEN
+ FOR i := from TO to - 1 DO
+ S.GET(i, x)
+ END
+ ELSE
+ FOR i := to - 1 TO from BY -1 DO
+ S.GET(i, x)
+ END
+ END;
+ END;
+ testRead := FALSE;
+ RETURN res = 0
+ END IsReadable;
+
+ (* --------------------- NEW implementation (portable) -------------------- *)
+
+ PROCEDURE^ NewBlock (size: INTEGER): Block;
+
+ PROCEDURE NewRec* (typ: INTEGER): INTEGER; (* implementation of NEW(ptr) *)
+ VAR size, adr: INTEGER; b: Block; tag: Type; l: FList;
+ BEGIN
+ IF ~ODD(typ) THEN
+ tag := S.VAL(Type, typ);
+ b := NewBlock(tag.size);
+ IF b # NIL THEN
+ b.tag := tag;
+ S.GET(typ - 4, size);
+ IF size # 0 THEN (* record uses a finalizer *)
+ l := S.VAL(FList, S.ADR(b.last)); (* anchor new object! *)
+ l := S.VAL(FList, NewRec(S.TYP(FList))); (* NEW(l) *)
+ l.blk := b; l.next := finalizers; finalizers := l
+ END;
+ adr := S.ADR(b.last)
+ ELSE
+ adr := 0
+ END
+ ELSE
+ HALT(100) (* COM interface pointers not supported *)
+ END;
+ RETURN adr
+ END NewRec;
+
+ PROCEDURE NewArr* (eltyp, nofelem, nofdim: INTEGER): INTEGER; (* impl. of NEW(ptr, dim0, dim1, ...) *)
+ VAR b: Block; size, headSize: INTEGER; t: Type;
+ BEGIN
+ CASE eltyp OF
+ | -1: HALT(100) (* COM interface pointers not supported *)
+ | 0: eltyp := S.ADR(PtrType)
+ | 1: eltyp := S.ADR(Char8Type)
+ | 2: eltyp := S.ADR(Int16Type)
+ | 3: eltyp := S.ADR(Int8Type)
+ | 4: eltyp := S.ADR(Int32Type)
+ | 5: eltyp := S.ADR(BoolType)
+ | 6: eltyp := S.ADR(SetType)
+ | 7: eltyp := S.ADR(Real32Type)
+ | 8: eltyp := S.ADR(Real64Type)
+ | 9: eltyp := S.ADR(Char16Type)
+ | 10: eltyp := S.ADR(Int64Type)
+ | 11: eltyp := S.ADR(ProcType)
+ | 12: HALT(101) (* COM interface pointers not supported *)
+ ELSE
+ ASSERT(~ODD(eltyp), 102) (* COM interface pointers not supported *)
+ END;
+ t := S.VAL(Type, eltyp);
+ headSize := 4 * nofdim + 12;
+ size := headSize + nofelem * t.size;
+ b := NewBlock(size);
+ IF b # NIL THEN
+ b.tag := S.VAL(Type, eltyp + 2); (* tag + array mark *)
+ b.last := S.ADR(b.last) + size - t.size; (* pointer to last elem *)
+ b.first := S.ADR(b.last) + headSize; (* pointer to first elem *)
+ RETURN S.ADR(b.last)
+ ELSE
+ RETURN 0
+ END;
+ END NewArr;
+
+ (* -------------------- handler installation (portable) --------------------- *)
+
+ PROCEDURE ThisFinObj* (VAR id: Identifier): ANYPTR;
+ VAR l: FList;
+ BEGIN
+ ASSERT(id.typ # 0, 100);
+ l := finalizers;
+ WHILE l # NIL DO
+ IF S.VAL(INTEGER, l.blk.tag) = id.typ THEN
+ id.obj := S.VAL(ANYPTR, S.ADR(l.blk.last));
+ IF id.Identified() THEN RETURN id.obj END
+ END;
+ l := l.next
+ END;
+ RETURN NIL
+ END ThisFinObj;
+
+ PROCEDURE InstallReducer* (r: Reducer);
+ BEGIN
+ r.next := reducers; reducers := r
+ END InstallReducer;
+
+ PROCEDURE InstallTrapViewer* (h: Handler);
+ BEGIN
+ trapViewer := h
+ END InstallTrapViewer;
+
+ PROCEDURE InstallTrapChecker* (h: Handler);
+ BEGIN
+ trapChecker := h
+ END InstallTrapChecker;
+
+ PROCEDURE PushTrapCleaner* (c: TrapCleaner);
+ VAR t: TrapCleaner;
+ BEGIN
+ t := trapStack; WHILE (t # NIL) & (t # c) DO t := t.next END;
+ ASSERT(t = NIL, 20);
+ c.next := trapStack; trapStack := c
+ END PushTrapCleaner;
+
+ PROCEDURE PopTrapCleaner* (c: TrapCleaner);
+ VAR t: TrapCleaner;
+ BEGIN
+ t := NIL;
+ WHILE (trapStack # NIL) & (t # c) DO
+ t := trapStack; trapStack := trapStack.next
+ END
+ END PopTrapCleaner;
+
+ PROCEDURE InstallCleaner* (p: Command);
+ VAR c: CList;
+ BEGIN
+ c := S.VAL(CList, NewRec(S.TYP(CList))); (* NEW(c) *)
+ c.do := p; c.trapped := FALSE; c.next := cleaners; cleaners := c
+ END InstallCleaner;
+
+ PROCEDURE RemoveCleaner* (p: Command);
+ VAR c0, c: CList;
+ BEGIN
+ c := cleaners; c0 := NIL;
+ WHILE (c # NIL) & (c.do # p) DO c0 := c; c := c.next END;
+ IF c # NIL THEN
+ IF c0 = NIL THEN cleaners := cleaners.next ELSE c0.next := c.next END
+ END
+ END RemoveCleaner;
+
+ PROCEDURE Cleanup*;
+ VAR c, c0: CList;
+ BEGIN
+ c := cleaners; c0 := NIL;
+ WHILE c # NIL DO
+ IF ~c.trapped THEN
+ c.trapped := TRUE; c.do; c.trapped := FALSE; c0 := c
+ ELSE
+ IF c0 = NIL THEN cleaners := cleaners.next
+ ELSE c0.next := c.next
+ END
+ END;
+ c := c.next
+ END
+ END Cleanup;
+
+ (* -------------------- meta information (portable) --------------------- *)
+
+ PROCEDURE (h: LoaderHook) ThisMod* (IN name: ARRAY OF CHAR): Module, NEW, ABSTRACT;
+
+ PROCEDURE SetLoaderHook*(h: LoaderHook);
+ BEGIN
+ loader := h
+ END SetLoaderHook;
+
+ PROCEDURE InitModule (mod: Module); (* initialize linked modules *)
+ VAR body: Command;
+ BEGIN
+ IF ~(dyn IN mod.opts) & (mod.next # NIL) & ~(init IN mod.next.opts) THEN InitModule(mod.next) END;
+ IF ~(init IN mod.opts) THEN
+ body := S.VAL(Command, mod.code);
+ INCL(mod.opts, init);
+ actual := mod;
+ body(); actual := NIL
+ END
+ END InitModule;
+
+ PROCEDURE ThisLoadedMod* (IN name: ARRAY OF CHAR): Module; (* loaded modules only *)
+ VAR m: Module; res: INTEGER; n: Utf8Name;
+ BEGIN
+ StringToUtf8(name, n, res); ASSERT(res = 0);
+ loadres := done;
+ m := modList;
+ WHILE (m # NIL) & ((m.name # n) OR (m.refcnt < 0)) DO m := m.next END;
+ IF (m # NIL) & ~(init IN m.opts) THEN InitModule(m) END;
+ IF m = NIL THEN loadres := moduleNotFound END;
+ RETURN m
+ END ThisLoadedMod;
+
+ PROCEDURE ThisMod* (IN name: ARRAY OF CHAR): Module;
+ BEGIN
+ IF loader # NIL THEN
+ loader.res := done;
+ RETURN loader.ThisMod(name)
+ ELSE
+ RETURN ThisLoadedMod(name)
+ END
+ END ThisMod;
+
+ PROCEDURE LoadMod* (IN name: ARRAY OF CHAR);
+ VAR m: Module;
+ BEGIN
+ m := ThisMod(name)
+ END LoadMod;
+
+ PROCEDURE GetLoaderResult* (OUT res: INTEGER; OUT importing, imported, object: ARRAY OF CHAR);
+ BEGIN
+ IF loader # NIL THEN
+ res := loader.res;
+ importing := loader.importing$;
+ imported := loader.imported$;
+ object := loader.object$
+ ELSE
+ res := loadres;
+ importing := "";
+ imported := "";
+ object := ""
+ END
+ END GetLoaderResult;
+
+ PROCEDURE ThisObject* (mod: Module; IN name: ARRAY OF CHAR): Object;
+ VAR l, r, m, res: INTEGER; p: StrPtr; n: Utf8Name;
+ BEGIN
+ StringToUtf8(name, n, res); ASSERT(res = 0);
+ l := 0; r := mod.export.num;
+ WHILE l < r DO (* binary search *)
+ m := (l + r) DIV 2;
+ p := S.VAL(StrPtr, S.ADR(mod.names[mod.export.obj[m].id DIV 256]));
+ IF p^ = n THEN RETURN S.VAL(Object, S.ADR(mod.export.obj[m])) END;
+ IF p^ < n THEN l := m + 1 ELSE r := m END
+ END;
+ RETURN NIL
+ END ThisObject;
+
+ PROCEDURE ThisDesc* (mod: Module; fprint: INTEGER): Object;
+ VAR i, n: INTEGER;
+ BEGIN
+ i := 0; n := mod.export.num;
+ WHILE (i < n) & (mod.export.obj[i].id DIV 256 = 0) DO
+ IF mod.export.obj[i].offs = fprint THEN RETURN S.VAL(Object, S.ADR(mod.export.obj[i])) END;
+ INC(i)
+ END;
+ RETURN NIL
+ END ThisDesc;
+
+ PROCEDURE ThisField* (rec: Type; IN name: ARRAY OF CHAR): Object;
+ VAR n, res: INTEGER; p: StrPtr; obj: Object; m: Module; nn: Utf8Name;
+ BEGIN
+ StringToUtf8(name, nn, res); ASSERT(res = 0);
+ m := rec.mod;
+ obj := S.VAL(Object, S.ADR(rec.fields.obj[0])); n := rec.fields.num;
+ WHILE n > 0 DO
+ p := S.VAL(StrPtr, S.ADR(m.names[obj.id DIV 256]));
+ IF p^ = nn THEN RETURN obj END;
+ DEC(n); INC(S.VAL(INTEGER, obj), 16)
+ END;
+ RETURN NIL
+ END ThisField;
+
+ PROCEDURE ThisCommand* (mod: Module; IN name: ARRAY OF CHAR): Command;
+ VAR x: Object; sig: Signature;
+ BEGIN
+ x := ThisObject(mod, name);
+ IF (x # NIL) & (x.id MOD 16 = mProc) THEN
+ sig := S.VAL(Signature, x.struct);
+ IF (sig.retStruct = NIL) & (sig.num = 0) THEN RETURN S.VAL(Command, mod.procBase + x.offs) END
+ END;
+ RETURN NIL
+ END ThisCommand;
+
+ PROCEDURE ThisType* (mod: Module; IN name: ARRAY OF CHAR): Type;
+ VAR x: Object;
+ BEGIN
+ x := ThisObject(mod, name);
+ IF (x # NIL) & (x.id MOD 16 = mTyp) & (S.VAL(INTEGER, x.struct) DIV 256 # 0) THEN
+ RETURN x.struct
+ ELSE
+ RETURN NIL
+ END
+ END ThisType;
+
+ PROCEDURE TypeOf* (IN rec: ANYREC): Type;
+ BEGIN
+ RETURN S.VAL(Type, S.TYP(rec))
+ END TypeOf;
+
+ PROCEDURE LevelOf* (t: Type): SHORTINT;
+ BEGIN
+ RETURN SHORT(t.id DIV 16 MOD 16)
+ END LevelOf;
+
+ PROCEDURE NewObj* (VAR o: S.PTR; t: Type);
+ VAR i: INTEGER;
+ BEGIN
+ IF t.size = -1 THEN o := NIL
+ ELSE
+ i := 0; WHILE t.ptroffs[i] >= 0 DO INC(i) END;
+ IF t.ptroffs[i+1] >= 0 THEN INC(S.VAL(INTEGER, t)) END; (* with interface pointers *)
+ o := S.VAL(S.PTR, NewRec(S.VAL(INTEGER, t))) (* generic NEW *)
+ END
+ END NewObj;
+
+ PROCEDURE GetModName* (mod: Module; OUT name: Name);
+ VAR res: INTEGER;
+ BEGIN
+ Utf8ToString(mod.name, name, res); ASSERT(res = 0)
+ END GetModName;
+
+ PROCEDURE GetObjName* (mod: Module; obj: Object; OUT name: Name);
+ VAR p: StrPtr; res: INTEGER;
+ BEGIN
+ p := S.VAL(StrPtr, S.ADR(mod.names[obj.id DIV 256]));
+ Utf8ToString(p^$, name, res); ASSERT(res = 0)
+ END GetObjName;
+
+ PROCEDURE GetTypeName* (t: Type; OUT name: Name);
+ VAR p: StrPtr; res: INTEGER;
+ BEGIN
+ p := S.VAL(StrPtr, S.ADR(t.mod.names[t.id DIV 256]));
+ Utf8ToString(p^$, name, res); ASSERT(res = 0)
+ END GetTypeName;
+
+ PROCEDURE RegisterMod* (mod: Module);
+ VAR i: INTEGER; epoch: time.time_t; tm: time.struct_tm; ptm: time.Pstruct_tm;
+ BEGIN
+ mod.next := modList; modList := mod; mod.refcnt := 0; INCL(mod.opts, dyn); i := 0;
+ WHILE i < mod.nofimps DO
+ IF mod.imports[i] # NIL THEN INC(mod.imports[i].refcnt) END;
+ INC(i)
+ END;
+ epoch := time.time(NIL);
+ ptm := time.localtime_r(epoch, tm);
+ IF ptm # NIL THEN
+ mod.loadTime[0] := SHORT(tm.tm_year + 1900);
+ mod.loadTime[1] := SHORT(tm.tm_mon + 1);
+ mod.loadTime[2] := SHORT(tm.tm_mday);
+ mod.loadTime[3] := SHORT(tm.tm_hour);
+ mod.loadTime[4] := SHORT(tm.tm_min);
+ mod.loadTime[5] := SHORT(tm.tm_sec)
+ ELSE
+ mod.loadTime[0] := 0;
+ mod.loadTime[1] := 0;
+ mod.loadTime[2] := 0;
+ mod.loadTime[3] := 0;
+ mod.loadTime[4] := 0;
+ mod.loadTime[5] := 0
+ END;
+ IF ~(init IN mod.opts) THEN InitModule(mod) END
+ END RegisterMod;
+
+ PROCEDURE^ Collect*;
+
+ PROCEDURE UnloadMod* (mod: Module);
+ VAR i: INTEGER; t: Command;
+ BEGIN
+ IF mod.refcnt = 0 THEN
+ t := mod.term; mod.term := NIL;
+ IF t # NIL THEN t() END; (* terminate module *)
+ i := 0;
+ WHILE i < mod.nofptrs DO (* release global pointers *)
+ S.PUT(mod.varBase + mod.ptrs[i], 0); INC(i)
+ END;
+ Collect; (* call finalizers *)
+ i := 0;
+ WHILE i < mod.nofimps DO (* release imported modules *)
+ IF mod.imports[i] # NIL THEN DEC(mod.imports[i].refcnt) END;
+ INC(i)
+ END;
+ mod.refcnt := -1;
+ IF dyn IN mod.opts THEN (* release memory *)
+ InvalModMem(mod.data + mod.dsize - mod.refs, mod.refs)
+ END
+ END
+ END UnloadMod;
+
+ (* -------------------- dynamic procedure call --------------------- *)
+
+ PROCEDURE Call* (adr: INTEGER; sig: Signature; IN par: ARRAY OF INTEGER; n: INTEGER): LONGINT;
+ BEGIN
+ HALT(126); (* !!! *)
+ RETURN 0
+ END Call;
+
+ (* -------------------- reference information (portable) --------------------- *)
+
+ PROCEDURE RefCh (VAR ref: INTEGER; OUT ch: SHORTCHAR);
+ BEGIN
+ S.GET(ref, ch); INC(ref)
+ END RefCh;
+
+ PROCEDURE RefNum (VAR ref: INTEGER; OUT x: INTEGER);
+ VAR s, n: INTEGER; ch: SHORTCHAR;
+ BEGIN
+ s := 0; n := 0; RefCh(ref, ch);
+ WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); RefCh(ref, ch) END;
+ x := n + ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s)
+ END RefNum;
+
+ PROCEDURE RefName (VAR ref: INTEGER; OUT n: Utf8Name);
+ VAR i: INTEGER; ch: SHORTCHAR;
+ BEGIN
+ i := 0; RefCh(ref, ch);
+ WHILE ch # 0X DO n[i] := ch; INC(i); RefCh(ref, ch) END;
+ n[i] := 0X
+ END RefName;
+
+ PROCEDURE GetRefProc* (VAR ref: INTEGER; OUT adr: INTEGER; OUT name: Utf8Name);
+ VAR ch: SHORTCHAR;
+ BEGIN
+ S.GET(ref, ch);
+ WHILE ch >= 0FDX DO (* skip variables *)
+ INC(ref); RefCh(ref, ch);
+ IF ch = 10X THEN INC(ref, 4) END;
+ RefNum(ref, adr); RefName(ref, name); S.GET(ref, ch)
+ END;
+ WHILE (ch > 0X) & (ch < 0FCX) DO (* skip source refs *)
+ INC(ref); RefNum(ref, adr); S.GET(ref, ch)
+ END;
+ IF ch = 0FCX THEN INC(ref); RefNum(ref, adr); RefName(ref, name)
+ ELSE adr := 0
+ END
+ END GetRefProc;
+
+ PROCEDURE GetRefVar* (VAR ref: INTEGER; OUT mode, form: SHORTCHAR; OUT desc: Type; OUT adr: INTEGER; OUT name: Utf8Name);
+ BEGIN
+ S.GET(ref, mode); desc := NIL;
+ IF mode >= 0FDX THEN
+ mode := SHORT(CHR(ORD(mode) - 0FCH));
+ INC(ref); RefCh(ref, form);
+ IF form = 10X THEN
+ S.GET(ref, desc); INC(ref, 4); form := SHORT(CHR(16 + desc.id MOD 4))
+ END;
+ RefNum(ref, adr); RefName(ref, name)
+ ELSE
+ mode := 0X; form := 0X; adr := 0
+ END
+ END GetRefVar;
+
+ PROCEDURE SourcePos* (mod: Module; codePos: INTEGER): INTEGER;
+ VAR ref, pos, ad, d: INTEGER; ch: SHORTCHAR; name: Utf8Name;
+ BEGIN
+ IF mod # NIL THEN (* mf, 12.02.04 *)
+ ref := mod.refs; pos := 0; ad := 0; S.GET(ref, ch);
+ WHILE ch # 0X DO
+ WHILE (ch > 0X) & (ch < 0FCX) DO (* srcref: {dAdr,dPos} *)
+ INC(ad, ORD(ch)); INC(ref); RefNum(ref, d);
+ IF ad > codePos THEN RETURN pos END;
+ INC(pos, d); S.GET(ref, ch)
+ END;
+ IF ch = 0FCX THEN (* proc: 0FCX,Adr,Name *)
+ INC(ref); RefNum(ref, d); RefName(ref, name); S.GET(ref, ch);
+ IF (d > codePos) & (pos > 0) THEN RETURN pos END
+ END;
+ WHILE ch >= 0FDX DO (* skip variables: Mode, Form, adr, Name *)
+ INC(ref); RefCh(ref, ch);
+ IF ch = 10X THEN INC(ref, 4) END;
+ RefNum(ref, d); RefName(ref, name); S.GET(ref, ch)
+ END
+ END;
+ END;
+ RETURN -1
+ END SourcePos;
+
+ PROCEDURE LoadDll* (IN name: ARRAY OF CHAR; VAR ok: BOOLEAN);
+ VAR h: ADDRESS; file: Utf8Name; res: INTEGER;
+ BEGIN
+ StringToUtf8(name, file, res);
+ IF res = 0 THEN
+ h := dlfcn.dlopen(file, dlfcn.RTLD_LAZY + dlfcn.RTLD_GLOBAL);
+ ok := h # 0
+ ELSE
+ ok := FALSE
+ END
+ END LoadDll;
+
+ PROCEDURE ThisDllObj* (mode, fprint: INTEGER; IN dll, name: ARRAY OF CHAR): INTEGER;
+ VAR h, p: ADDRESS; file, sym: Utf8Name; res: INTEGER; err: dlfcn.int;
+ BEGIN
+ StringToUtf8(dll, file, res);
+ IF res = 0 THEN
+ h := dlfcn.dlopen(file, dlfcn.RTLD_LAZY + dlfcn.RTLD_GLOBAL);
+ IF h # 0 THEN
+ StringToUtf8(name, sym, res);
+ IF res = 0 THEN
+ p := dlfcn.dlsym(h, sym)
+ ELSE
+ p := 0
+ END;
+ err := dlfcn.dlclose(h);
+ ASSERT(err = 0, 100)
+ ELSE
+ p := 0
+ END
+ ELSE
+ p := 0
+ END;
+ RETURN p
+ END ThisDllObj;
+
+ (* -------------------- garbage collector (portable) --------------------- *)
+
+ PROCEDURE Mark (this: Block);
+ VAR father, son: Block; tag: Type; flag, offset, actual: INTEGER;
+ BEGIN
+ IF ~ODD(S.VAL(INTEGER, this.tag)) THEN
+ father := NIL;
+ LOOP
+ INC(S.VAL(INTEGER, this.tag));
+ flag := S.VAL(INTEGER, this.tag) MOD 4;
+ tag := S.VAL(Type, S.VAL(INTEGER, this.tag) - flag);
+ IF flag >= 2 THEN actual := this.first; this.actual := actual
+ ELSE actual := S.ADR(this.last)
+ END;
+ LOOP
+ offset := tag.ptroffs[0];
+ IF offset < 0 THEN
+ INC(S.VAL(INTEGER, tag), offset + 4); (* restore tag *)
+ IF (flag >= 2) & (actual < this.last) & (offset < -4) THEN (* next array element *)
+ INC(actual, tag.size); this.actual := actual
+ ELSE (* up *)
+ this.tag := S.VAL(Type, S.VAL(INTEGER, tag) + flag);
+ IF father = NIL THEN RETURN END;
+ son := this; this := father;
+ flag := S.VAL(INTEGER, this.tag) MOD 4;
+ tag := S.VAL(Type, S.VAL(INTEGER, this.tag) - flag);
+ offset := tag.ptroffs[0];
+ IF flag >= 2 THEN actual := this.actual ELSE actual := S.ADR(this.last) END;
+ S.GET(actual + offset, father); S.PUT(actual + offset, S.ADR(son.last));
+ INC(S.VAL(INTEGER, tag), 4)
+ END
+ ELSE
+ S.GET(actual + offset, son);
+ IF son # NIL THEN
+ DEC(S.VAL(INTEGER, son), 4);
+ IF ~ODD(S.VAL(INTEGER, son.tag)) THEN (* down *)
+ this.tag := S.VAL(Type, S.VAL(INTEGER, tag) + flag);
+ S.PUT(actual + offset, father); father := this; this := son;
+ EXIT
+ END
+ END;
+ INC(S.VAL(INTEGER, tag), 4)
+ END
+ END
+ END
+ END
+ END Mark;
+
+ PROCEDURE MarkGlobals;
+ VAR m: Module; i, p: INTEGER;
+ BEGIN
+ m := modList;
+ WHILE m # NIL DO
+ IF m.refcnt >= 0 THEN
+ i := 0;
+ WHILE i < m.nofptrs DO
+ S.GET(m.varBase + m.ptrs[i], p); INC(i);
+ IF p # 0 THEN Mark(S.VAL(Block, p - 4)) END
+ END
+ END;
+ m := m.next
+ END
+ END MarkGlobals;
+
+ PROCEDURE Next (b: Block): Block; (* next block in same cluster *)
+ VAR size: INTEGER;
+ BEGIN
+ S.GET(S.VAL(INTEGER, b.tag) DIV 4 * 4, size);
+ IF ODD(S.VAL(INTEGER, b.tag) DIV 2) THEN INC(size, b.last - S.ADR(b.last)) END;
+ RETURN S.VAL(Block, S.VAL(INTEGER, b) + (size + 19) DIV 16 * 16)
+ END Next;
+
+ PROCEDURE CheckCandidates;
+ (* pre: nofcand > 0 *)
+ VAR i, j, h, p, end: INTEGER; c: Cluster; blk, next: Block;
+ BEGIN
+ (* sort candidates (shellsort) *)
+ h := 1; REPEAT h := h*3 + 1 UNTIL h > nofcand;
+ REPEAT h := h DIV 3; i := h;
+ WHILE i < nofcand DO p := candidates[i]; j := i;
+ WHILE (j >= h) & (candidates[j-h] > p) DO
+ candidates[j] := candidates[j-h]; j := j-h
+ END;
+ candidates[j] := p; INC(i)
+ END
+ UNTIL h = 1;
+ (* sweep *)
+ c := root; i := 0;
+ WHILE c # NIL DO
+ blk := S.VAL(Block, S.VAL(INTEGER, c) + 12);
+ end := S.VAL(INTEGER, blk) + (c.size - 12) DIV 16 * 16;
+ WHILE candidates[i] < S.VAL(INTEGER, blk) DO
+ INC(i);
+ IF i = nofcand THEN RETURN END
+ END;
+ WHILE S.VAL(INTEGER, blk) < end DO
+ next := Next(blk);
+ IF candidates[i] < S.VAL(INTEGER, next) THEN
+ IF (S.VAL(INTEGER, blk.tag) # S.ADR(blk.last)) (* not a free block *)
+ & (~strictStackSweep OR (candidates[i] = S.ADR(blk.last))) THEN
+ Mark(blk)
+ END;
+ REPEAT
+ INC(i);
+ IF i = nofcand THEN RETURN END
+ UNTIL candidates[i] >= S.VAL(INTEGER, next)
+ END;
+ IF (S.VAL(INTEGER, blk.tag) MOD 4 = 0) & (S.VAL(INTEGER, blk.tag) # S.ADR(blk.last))
+ & (blk.tag.base[0] = NIL) & (blk.actual > 0) THEN (* referenced interface record *)
+ Mark(blk)
+ END;
+ blk := next
+ END;
+ c := c.next
+ END
+ END CheckCandidates;
+
+ PROCEDURE MarkLocals;
+ VAR sp, p, min, max: INTEGER; c: Cluster;
+ BEGIN
+ sp := S.ADR(sp); nofcand := 0; c := root;
+ WHILE c.next # NIL DO c := c.next END;
+ min := S.VAL(INTEGER, root); max := S.VAL(INTEGER, c) + c.size;
+ WHILE sp < baseStack DO
+ S.GET(sp, p);
+ IF (p > min) & (p < max) & (~strictStackSweep OR (p MOD 16 = 0)) THEN
+ candidates[nofcand] := p; INC(nofcand);
+ IF nofcand = LEN(candidates) - 1 THEN CheckCandidates; nofcand := 0 END
+ END;
+ INC(sp, 4)
+ END;
+ candidates[nofcand] := max; INC(nofcand); (* ensure complete scan for interface mark*)
+ IF nofcand > 0 THEN CheckCandidates END
+ END MarkLocals;
+
+ PROCEDURE MarkFinObj;
+ VAR f: FList;
+ BEGIN
+ wouldFinalize := FALSE;
+ f := finalizers;
+ WHILE f # NIL DO
+ IF ~ODD(S.VAL(INTEGER, f.blk.tag)) THEN wouldFinalize := TRUE END;
+ Mark(f.blk);
+ f := f.next
+ END;
+ f := hotFinalizers;
+ WHILE f # NIL DO IF ~ODD(S.VAL(INTEGER, f.blk.tag)) THEN wouldFinalize := TRUE END;
+ Mark(f.blk);
+ f := f.next
+ END
+ END MarkFinObj;
+
+ PROCEDURE CheckFinalizers;
+ VAR f, g, h, k: FList;
+ BEGIN
+ f := finalizers; g := NIL;
+ IF hotFinalizers = NIL THEN k := NIL
+ ELSE
+ k := hotFinalizers;
+ WHILE k.next # NIL DO k := k.next END
+ END;
+ WHILE f # NIL DO
+ h := f; f := f.next;
+ IF ~ODD(S.VAL(INTEGER, h.blk.tag)) THEN
+ IF g = NIL THEN finalizers := f ELSE g.next := f END;
+ IF k = NIL THEN hotFinalizers := h ELSE k.next := h END;
+ k := h; h.next := NIL
+ ELSE g := h
+ END
+ END;
+ h := hotFinalizers;
+ WHILE h # NIL DO Mark(h.blk); h := h.next END
+ END CheckFinalizers;
+
+ PROCEDURE ExecFinalizer (a, b, c: INTEGER);
+ VAR f: FList; fin: PROCEDURE(this: ANYPTR);
+ BEGIN
+ f := S.VAL(FList, a);
+ S.GET(S.VAL(INTEGER, f.blk.tag) - 4, fin); (* method 0 *)
+ IF (fin # NIL) & (f.blk.tag.mod.refcnt >= 0) THEN fin(S.VAL(ANYPTR, S.ADR(f.blk.last))) END;
+ END ExecFinalizer;
+
+ PROCEDURE^ Try* (h: TryHandler; a, b, c: INTEGER); (* COMPILER DEPENDENT *)
+
+ PROCEDURE CallFinalizers;
+ VAR f: FList;
+ BEGIN
+ WHILE hotFinalizers # NIL DO
+ f := hotFinalizers; hotFinalizers := hotFinalizers.next;
+ Try(ExecFinalizer, S.VAL(INTEGER, f), 0, 0)
+ END;
+ wouldFinalize := FALSE
+ END CallFinalizers;
+
+ PROCEDURE Insert (blk: FreeBlock; size: INTEGER); (* insert block in free list *)
+ VAR i: INTEGER;
+ BEGIN
+ blk.size := size - 4; blk.tag := S.VAL(Type, S.ADR(blk.size));
+ i := MIN(N - 1, (blk.size DIV 16));
+ blk.next := free[i]; free[i] := blk
+ END Insert;
+
+ PROCEDURE Sweep (dealloc: BOOLEAN);
+ VAR cluster, last, c: Cluster; blk, next: Block; fblk, b, t: FreeBlock; end, i: INTEGER;
+ BEGIN
+ cluster := root; last := NIL; allocated := 0;
+ i := N;
+ REPEAT DEC(i); free[i] := sentinel UNTIL i = 0;
+ WHILE cluster # NIL DO
+ blk := S.VAL(Block, S.VAL(INTEGER, cluster) + 12);
+ end := S.VAL(INTEGER, blk) + (cluster.size - 12) DIV 16 * 16;
+ fblk := NIL;
+ WHILE S.VAL(INTEGER, blk) < end DO
+ next := Next(blk);
+ IF ODD(S.VAL(INTEGER, blk.tag)) THEN
+ IF fblk # NIL THEN
+ Insert(fblk, S.VAL(INTEGER, blk) - S.VAL(INTEGER, fblk));
+ fblk := NIL
+ END;
+ DEC(S.VAL(INTEGER, blk.tag)); (* unmark *)
+ INC(allocated, S.VAL(INTEGER, next) - S.VAL(INTEGER, blk))
+ ELSIF fblk = NIL THEN
+ fblk := S.VAL(FreeBlock, blk)
+ END;
+ blk := next
+ END;
+ IF dealloc & (S.VAL(INTEGER, fblk) = S.VAL(INTEGER, cluster) + 12) THEN (* deallocate cluster *)
+ c := cluster; cluster := cluster.next;
+ IF last = NIL THEN root := cluster ELSE last.next := cluster END;
+ FreeHeapMem(c)
+ ELSE
+ IF fblk # NIL THEN Insert(fblk, end - S.VAL(INTEGER, fblk)) END;
+ last := cluster; cluster := cluster.next
+ END
+ END;
+ (* reverse free list *)
+ i := N;
+ REPEAT
+ DEC(i);
+ b := free[i]; fblk := sentinel;
+ WHILE b # sentinel DO t := b; b := t.next; t.next := fblk; fblk := t END;
+ free[i] := fblk
+ UNTIL i = 0
+ END Sweep;
+
+ PROCEDURE Collect*;
+ BEGIN
+ IF root # NIL THEN
+ CallFinalizers; (* trap cleanup *)
+ MarkGlobals;
+ MarkLocals;
+ CheckFinalizers;
+ Sweep(TRUE);
+ CallFinalizers
+ END
+ END Collect;
+
+ PROCEDURE FastCollect*;
+ BEGIN
+ IF root # NIL THEN
+ MarkGlobals;
+ MarkLocals;
+ MarkFinObj;
+ Sweep(FALSE)
+ END
+ END FastCollect;
+
+ PROCEDURE WouldFinalize* (): BOOLEAN;
+ BEGIN
+ RETURN wouldFinalize
+ END WouldFinalize;
+
+ (* --------------------- memory allocation (portable) -------------------- *)
+
+ PROCEDURE OldBlock (size: INTEGER): FreeBlock; (* size MOD 16 = 0 *)
+ VAR b, l: FreeBlock; s, i: INTEGER;
+ BEGIN
+ s := size - 4;
+ i := MIN(N - 1, s DIV 16);
+ WHILE (i # N - 1) & (free[i] = sentinel) DO INC(i) END;
+ b := free[i]; l := NIL;
+ WHILE b.size < s DO l := b; b := b.next END;
+ IF b # sentinel THEN
+ IF l = NIL THEN free[i] := b.next ELSE l.next := b.next END
+ ELSE b := NIL
+ END;
+ RETURN b
+ END OldBlock;
+
+ PROCEDURE LastBlock (limit: INTEGER): FreeBlock; (* size MOD 16 = 0 *)
+ VAR b, l: FreeBlock; s, i: INTEGER;
+ BEGIN
+ s := limit - 4;
+ i := 0;
+ REPEAT
+ b := free[i]; l := NIL;
+ WHILE (b # sentinel) & (S.VAL(INTEGER, b) + b.size # s) DO l := b; b := b.next END;
+ IF b # sentinel THEN
+ IF l = NIL THEN free[i] := b.next ELSE l.next := b.next END
+ ELSE b := NIL
+ END;
+ INC(i)
+ UNTIL (b # NIL) OR (i = N);
+ RETURN b
+ END LastBlock;
+
+ PROCEDURE NewBlock (size: INTEGER): Block;
+ VAR tsize, a, s: INTEGER; b: FreeBlock; new, c: Cluster; r: Reducer;
+ BEGIN
+ ASSERT(size >= 0, 20);
+ IF size > MAX(INTEGER) - 19 THEN RETURN NIL END;
+ tsize := (size + 19) DIV 16 * 16;
+ b := OldBlock(tsize); (* 1) search for free block *)
+ IF b = NIL THEN
+ FastCollect; b := OldBlock(tsize); (* 2) collect *)
+ IF b = NIL THEN
+ Collect; b := OldBlock(tsize); (* 2a) fully collect *)
+ END;
+ IF b = NIL THEN
+ AllocHeapMem(tsize + 12, new); (* 3) allocate new cluster *)
+ IF new # NIL THEN
+ IF (root = NIL) OR (S.VAL(INTEGER, new) < S.VAL(INTEGER, root)) THEN
+ new.next := root; root := new
+ ELSE
+ c := root;
+ WHILE (c.next # NIL) & (S.VAL(INTEGER, new) > S.VAL(INTEGER, c.next)) DO c := c.next END;
+ new.next := c.next; c.next := new
+ END;
+ b := S.VAL(FreeBlock, S.VAL(INTEGER, new) + 12);
+ b.size := (new.size - 12) DIV 16 * 16 - 4
+ ELSE
+ RETURN NIL (* 4) give up *)
+ END
+ END
+ END;
+ (* b # NIL *)
+ a := b.size + 4 - tsize;
+ IF a > 0 THEN Insert(S.VAL(FreeBlock, S.VAL(INTEGER, b) + tsize), a) END;
+ IF size > 0 THEN Erase(S.ADR(b.size), (size + 3) DIV 4) END;
+ INC(allocated, tsize);
+ RETURN S.VAL(Block, b)
+ END NewBlock;
+
+ PROCEDURE Allocated* (): INTEGER;
+ BEGIN
+ RETURN allocated
+ END Allocated;
+
+ PROCEDURE Used* (): INTEGER;
+ BEGIN
+ RETURN used
+ END Used;
+
+ PROCEDURE Root* (): INTEGER;
+ BEGIN
+ RETURN S.VAL(INTEGER, root)
+ END Root;
+
+ (* -------------------- Trap Handling --------------------- *)
+
+ PROCEDURE Start* (code: Command);
+ VAR res: setjmp.int;
+ BEGIN
+ restart := code;
+ S.GETREG(SP, baseStack);
+ res := setjmp.sigsetjmp(startEnv, 1);
+ restart
+ END Start;
+
+ PROCEDURE Quit* (exitCode: INTEGER);
+ VAR m: Module; term: Command; t: BOOLEAN;
+ BEGIN
+ trapViewer := NIL; trapChecker := NIL; restart := NIL;
+ t := terminating; terminating := TRUE; m := modList;
+ WHILE m # NIL DO (* call terminators *)
+ IF ~static OR ~t THEN
+ term := m.term; m.term := NIL;
+ IF term # NIL THEN term() END
+ END;
+ m := m.next
+ END;
+ CallFinalizers;
+ hotFinalizers := finalizers; finalizers := NIL;
+ CallFinalizers;
+ stdlib.exit(exitCode)
+ END Quit;
+
+ PROCEDURE FatalError* (id: INTEGER; str: ARRAY OF CHAR);
+ VAR res: stdio.int; title: ARRAY 16 OF CHAR; text: ARRAY 256 OF SHORTCHAR;
+ BEGIN
+ title := "Error xy";
+ title[6] := CHR(id DIV 10 + ORD("0"));
+ title[7] := CHR(id MOD 10 + ORD("0"));
+ res := unistd.write(2, S.ADR(title), 8);
+ stdlib.abort
+ END FatalError;
+
+ PROCEDURE DefaultTrapViewer;
+ VAR out: ARRAY 2048 OF SHORTCHAR; a, b, c, len, ref, end: INTEGER; mod: Module;
+ modName, name: Name; n: Utf8Name; res: unistd.int;
+
+ PROCEDURE WriteString (IN s: ARRAY OF SHORTCHAR);
+ VAR i: INTEGER;
+ BEGIN
+ i := 0;
+ WHILE (len < LEN(out) - 1) & (s[i] # 0X) DO out[len] := s[i]; INC(i); INC(len) END
+ END WriteString;
+
+ PROCEDURE WriteHex (x, n: INTEGER);
+ VAR i, y: INTEGER;
+ BEGIN
+ IF len + n < LEN(out) THEN
+ i := len + n - 1;
+ WHILE i >= len DO
+ y := x MOD 16; x := x DIV 16;
+ IF y > 9 THEN y := y + (ORD("A") - ORD("0") - 10) END;
+ out[i] := SHORT(CHR(y + ORD("0"))); DEC(i)
+ END;
+ INC(len, n)
+ END
+ END WriteHex;
+
+ PROCEDURE WriteLn;
+ BEGIN
+ IF len < LEN(out) - 1 THEN out[len] := 0AX; INC(len) END
+ END WriteLn;
+
+ BEGIN
+ len := 0;
+ WriteString("====== ");
+ IF err = 129 THEN WriteString("invalid with")
+ ELSIF err = 130 THEN WriteString("invalid case")
+ ELSIF err = 131 THEN WriteString("function without return")
+ ELSIF err = 132 THEN WriteString("type guard")
+ ELSIF err = 133 THEN WriteString("implied type guard")
+ ELSIF err = 134 THEN WriteString("value out of range")
+ ELSIF err = 135 THEN WriteString("index out of range")
+ ELSIF err = 136 THEN WriteString("string too long")
+ ELSIF err = 137 THEN WriteString("stack overflow")
+ ELSIF err = 138 THEN WriteString("integer overflow")
+ ELSIF err = 139 THEN WriteString("division by zero")
+ ELSIF err = 140 THEN WriteString("infinite real result")
+ ELSIF err = 141 THEN WriteString("real underflow")
+ ELSIF err = 142 THEN WriteString("real overflow")
+ ELSIF err = 143 THEN WriteString("undefined real result")
+ ELSIF err = 144 THEN WriteString("not a number")
+ ELSIF err = 200 THEN WriteString("keyboard interrupt")
+ ELSIF err = 201 THEN WriteString("NIL dereference")
+ ELSIF err = 202 THEN WriteString("illegal instruction: ");
+ WriteHex(val, 4)
+ ELSIF err = 203 THEN WriteString("illegal memory read [ad = ");
+ WriteHex(val, 8); WriteString("]")
+ ELSIF err = 204 THEN WriteString("illegal memory write [ad = ");
+ WriteHex(val, 8); WriteString("]")
+ ELSIF err = 205 THEN WriteString("illegal execution [ad = ");
+ WriteHex(val, 8); WriteString("]")
+ ELSIF err = 257 THEN WriteString("out of memory")
+ ELSIF err = 10001H THEN WriteString("bus error")
+ ELSIF err = 10002H THEN WriteString("address error")
+ ELSIF err = 10007H THEN WriteString("fpu error")
+ ELSIF err < 0 THEN WriteString("exception #"); WriteHex(-err, 2)
+ ELSE err := err DIV 100 * 256 + err DIV 10 MOD 10 * 16 + err MOD 10;
+ WriteString("trap #"); WriteHex(err, 3)
+ END;
+ WriteString(" ======");
+ a := pc; b := fp; c := 12;
+ REPEAT
+ WriteLn; WriteString("- ");
+ mod := modList;
+ WHILE (mod # NIL) & ((a < mod.code) OR (a >= mod.code + mod.csize)) DO mod := mod.next END;
+ IF mod # NIL THEN
+ DEC(a, mod.code);
+ IF mod.refcnt >= 0 THEN
+ GetModName(mod, modName); WriteString(SHORT(modName)); ref := mod.refs;
+ REPEAT GetRefProc(ref, end, n) UNTIL (end = 0) OR (a < end);
+ IF a < end THEN
+ Utf8ToString(n, name, res); WriteString("."); WriteString(SHORT(name))
+ END
+ ELSE
+ GetModName(mod, modName); WriteString("("); WriteString(SHORT(modName)); WriteString(")")
+ END;
+ WriteString(" ")
+ END;
+ WriteString("(pc="); WriteHex(a, 8);
+ WriteString(", fp="); WriteHex(b, 8); WriteString(")");
+ IF (b >= sp) & (b < stack) THEN
+ S.GET(b+4, a); (* stacked pc *)
+ S.GET(b, b); (* dynamic link *)
+ DEC(c)
+ ELSE c := 0
+ END
+ UNTIL c = 0;
+ out[len] := 0X;
+ res := unistd.write(2, S.ADR(out), len)
+ END DefaultTrapViewer;
+
+ PROCEDURE TrapCleanup;
+ VAR t: TrapCleaner;
+ BEGIN
+ WHILE trapStack # NIL DO
+ t := trapStack; trapStack := trapStack.next; t.Cleanup
+ END;
+ IF (trapChecker # NIL) & (err # 128) THEN trapChecker END
+ END TrapCleanup;
+
+ PROCEDURE SetTrapGuard* (on: BOOLEAN);
+ BEGIN
+ guarded := on
+ END SetTrapGuard;
+
+ PROCEDURE Try* (h: TryHandler; a, b, c: INTEGER);
+ VAR oldIsTry: BOOLEAN; oldTryEnv: setjmp.jmp_buf; res: setjmp.int;
+ BEGIN
+ oldIsTry := isTry; oldTryEnv := tryEnv;
+ isTry := TRUE;
+ res := setjmp._setjmp(tryEnv);
+ IF res = 0 THEN h(a, b, c) END;
+ isTry := oldIsTry; tryEnv := oldTryEnv
+ END Try;
+
+ PROCEDURE Trap* (n: INTEGER);
+ BEGIN
+ IF trapped THEN
+ DefaultTrapViewer;
+ IF ~secondTrap THEN trapped := FALSE; secondTrap := TRUE END
+ END;
+ IF n >= 0 THEN err := n
+ ELSE err := -n + 128
+ END;
+ pc := 0; sp := 0; fp := 0; stack := 0; val := 0;
+ S.GETREG(SP, sp); S.GETREG(FP, fp);
+ INC(trapCount);
+ (* !!! InitFPU *)
+ TrapCleanup;
+ IF isTry THEN
+ setjmp._longjmp(tryEnv, 1)
+ END;
+ IF err = 128 THEN (* do nothing *)
+ ELSIF (trapViewer # NIL) & (restart # NIL) & ~trapped & ~guarded THEN
+ trapped := TRUE; trapViewer()
+ ELSE DefaultTrapViewer
+ END;
+ trapped := FALSE; secondTrap := FALSE;
+ IF restart # NIL THEN
+ setjmp.siglongjmp(startEnv, 1)
+ END;
+ stdlib.abort
+ END Trap;
+
+ PROCEDURE [ccall] TrapHandler (signo: signal.int; IN info: signal.siginfo_t; context: ADDRESS);
+ VAR res: signal.int; uc: signal.Pucontext_t;
+ BEGIN
+ IF testRead THEN
+ setjmp.longjmp(readEnv, 1)
+ END;
+ IF trapped THEN
+ DefaultTrapViewer;
+ IF ~secondTrap THEN trapped := FALSE; secondTrap := TRUE END
+ END;
+ err := -signo;
+ uc := S.VAL(signal.Pucontext_t, context);
+ pc := uc.uc_mcontext.gregs[14]; (* %eip *)
+ sp := uc.uc_mcontext.gregs[7]; (* %esp *)
+ fp := uc.uc_mcontext.gregs[6]; (* %ebp *)
+ stack := baseStack;
+ val := info.info.sigsegv.si_addr;
+ CASE signo OF
+ | signal.SIGFPE:
+ val := info.si_code;
+ pc := info.info.sigfpe.si_addr;
+ CASE info.si_code OF
+ | signal.FPE_INTDIV: err := 139 (* division by zero *)
+ | signal.FPE_INTOVF: err := 138 (* integer overflow *)
+ | signal.FPE_FLTDIV: err := 140 (* fpu: division by zero *)
+ | signal.FPE_FLTOVF: err := 142 (* fpu: overflow *)
+ | signal.FPE_FLTUND: err := 141 (* fpu: underflow *)
+ (* !!! | signal.FPE_FLTRES: err := ??? (* fpu: *) *)
+ | signal.FPE_FLTINV: err := 143 (* val := opcode *) (* fpu: invalid op *)
+ (* !!! | signal.FPE_FLTSUB: err := ??? (* fpu: *) *)
+ ELSE (* unknown *)
+ END
+ | signal.SIGINT:
+ val := info.si_code;
+ err := 200 (* keyboard interrupt *)
+ | signal.SIGSEGV:
+ val := info.info.sigsegv.si_addr;
+ err := 203 (* illigal read *)
+ | signal.SIGBUS:
+ val := info.info.sigbus.si_addr;
+ err := 10001H (* bus error *)
+ | signal.SIGILL:
+ pc := info.info.sigill.si_addr;
+ err := 202; (* illigal instruction *)
+ IF IsReadable(pc, pc + 4) THEN
+ S.GET(pc, val);
+ IF val MOD 100H = 8DH THEN (* lea reg,reg *)
+ IF val DIV 100H MOD 100H = 0F0H THEN
+ err := val DIV 10000H MOD 100H (* trap *)
+ ELSIF val DIV 1000H MOD 10H = 0EH THEN
+ err := 128 + val DIV 100H MOD 10H (* run time error *)
+ END
+ END
+ END
+ ELSE (* unknown *)
+ END;
+ INC(trapCount);
+ (* !!! InitFPU *)
+ TrapCleanup;
+ IF isTry THEN
+ setjmp._longjmp(tryEnv, 1)
+ END;
+ IF err = 128 THEN (* do nothing *)
+ ELSIF (trapViewer # NIL) & (restart # NIL) & ~trapped & ~guarded THEN
+ trapped := TRUE; trapViewer()
+ ELSE DefaultTrapViewer
+ END;
+ trapped := FALSE; secondTrap := FALSE;
+ IF restart # NIL THEN
+ setjmp.siglongjmp(startEnv, 1)
+ END;
+ stdlib.abort
+ END TrapHandler;
+
+ (* -------------------- Initialization --------------------- *)
+
+ PROCEDURE InstallTrap (signo: signal.int);
+ VAR act: signal.struct_sigaction; res: signal.int;
+ BEGIN
+ act.handler.sa_handler := NIL;
+ res := signal.sigemptyset(act.sa_mask);
+ act.sa_flags := signal.SA_NODEFER + signal.SA_SIGINFO;
+ act.handler.sa_sigaction := TrapHandler;
+ res := signal.sigaction(signo, act, NIL);
+ END InstallTrap;
+
+ PROCEDURE InstallTrapVectors;
+ BEGIN
+ InstallTrap(signal.SIGFPE);
+ InstallTrap(signal.SIGINT);
+ InstallTrap(signal.SIGSEGV);
+ InstallTrap(signal.SIGBUS);
+ InstallTrap(signal.SIGILL)
+ END InstallTrapVectors;
+
+ PROCEDURE RemoveTrapVectors;
+ END RemoveTrapVectors;
+
+ PROCEDURE Init;
+ VAR i: INTEGER;
+ BEGIN
+ pagesize := unistd.sysconf(unistd._SC_PAGESIZE);
+
+ (* init heap *)
+ allocated := 0; total := 0; used := 0;
+ sentinelBlock.size := MAX(INTEGER);
+ sentinel := S.ADR(sentinelBlock);
+ i := N;
+ REPEAT DEC(i); free[i] := sentinel UNTIL i = 0;
+
+ IF ~inDll THEN
+ InstallTrapVectors
+ END;
+
+ (* !!! InitFPU *)
+ IF ~static THEN
+ InitModule(modList);
+ IF ~inDll THEN Quit(1) END
+ END
+ END Init;
+
+BEGIN
+ IF modList = NIL THEN (* only once *)
+ S.GETREG(SP, baseStack);
+ S.GET(baseStack + 16, argc);
+ argv := S.VAL(ArrStrPtr, baseStack + 20);
+ S.GETREG(ML, modList); (* linker loads module list to BX *)
+ static := init IN modList.opts;
+ inDll := dll IN modList.opts;
+ Init
+ END
+CLOSE
+ IF ~terminating THEN
+ terminating := TRUE;
+ Quit(0)
+ END
+END Kernel.
diff --git a/src/i486/posix/System/Mod/Kernel.cp b/src/i486/posix/System/Mod/Kernel.cp
--- /dev/null
@@ -0,0 +1,1696 @@
+MODULE Kernel;
+
+ IMPORT S := SYSTEM, stdlib := C99stdlib, stdio := C99stdio,
+ time := C99time, wctype := C99wctype, sysmman := C99sys_mman,
+ dlfcn := C99dlfcn, types := C99types, fcntl := C99fcntl,
+ unistd := C99unistd, signal := C99signal, setjmp := C99setjmp;
+
+ (* init fpu? *)
+ (* add signal blocking to avoid race conditions in Try/Trap/TrapHandler *)
+ (* add BeepHook for Beep *)
+ (* implement Call using libffi *)
+
+ CONST
+ nameLen* = 256;
+
+ littleEndian* = TRUE;
+ timeResolution* = 1000; (* ticks per second *)
+
+ processor* = 1; (* generic c *)
+
+ objType* = "ocf"; (* file types *)
+ symType* = "osf";
+ docType* = "odc";
+
+ (* loader constants *)
+ done* = 0;
+ fileNotFound* = 1;
+ syntaxError* = 2;
+ objNotFound* = 3;
+ illegalFPrint* = 4;
+ cyclicImport* = 5;
+ noMem* = 6;
+ commNotFound* = 7;
+ commSyntaxError* = 8;
+ moduleNotFound* = 9;
+
+ any = 1000000;
+
+ CX = 1;
+ SP = 4; (* register number of stack pointer *)
+ FP = 5; (* register number of frame pointer *)
+ ML = 3; (* register which holds the module list at program start *)
+
+ strictStackSweep = FALSE;
+ N = 128 DIV 16; (* free lists *)
+
+ (* kernel flags in module desc *)
+ init = 16; dyn = 17; dll = 24; iptrs = 30;
+
+ (* meta interface consts *)
+ mConst = 1; mTyp = 2; mVar = 3; mProc = 4; mField = 5;
+
+ TYPE
+ Name* = ARRAY nameLen OF CHAR;
+ Utf8Name* = ARRAY nameLen OF SHORTCHAR;
+ Command* = PROCEDURE;
+
+ Module* = POINTER TO RECORD [untagged]
+ next-: Module;
+ opts-: SET; (* 0..15: compiler opts, 16..31: kernel flags *)
+ refcnt-: INTEGER; (* <0: module invalidated *)
+ compTime-, loadTime-: ARRAY 6 OF SHORTINT;
+ ext-: INTEGER; (* currently not used *)
+ term-: Command; (* terminator *)
+ nofimps-, nofptrs-: INTEGER;
+ csize-, dsize-, rsize-: INTEGER;
+ code-, data-, refs-: INTEGER;
+ procBase-, varBase-: INTEGER; (* meta base addresses *)
+ names-: POINTER TO ARRAY [untagged] OF SHORTCHAR; (* names[0] = 0X *)
+ ptrs-: POINTER TO ARRAY [untagged] OF INTEGER;
+ imports-: POINTER TO ARRAY [untagged] OF Module;
+ export-: Directory; (* exported objects (name sorted) *)
+ name-: Utf8Name
+ END;
+
+ Type* = POINTER TO RECORD [untagged]
+ (* record: ptr to method n at offset - 4 * (n+1) *)
+ size-: INTEGER; (* record: size, array: #elem, dyn array: 0, proc: sigfp *)
+ mod-: Module;
+ id-: INTEGER; (* name idx * 256 + lev * 16 + attr * 4 + form *)
+ base-: ARRAY 16 OF Type; (* signature if form = ProcTyp *)
+ fields-: Directory; (* new fields (declaration order) *)
+ ptroffs-: ARRAY any OF INTEGER (* array of any length *)
+ END;
+
+ Object* = POINTER TO ObjDesc;
+
+ ObjDesc* = RECORD [untagged]
+ fprint-: INTEGER;
+ offs-: INTEGER; (* pvfprint for record types *)
+ id-: INTEGER; (* name idx * 256 + vis * 16 + mode *)
+ struct-: Type (* id of basic type or pointer to typedesc/signature *)
+ END;
+
+ Directory* = POINTER TO RECORD [untagged]
+ num-: INTEGER; (* number of entries *)
+ obj-: ARRAY any OF ObjDesc (* array of any length *)
+ END;
+
+ Signature* = POINTER TO RECORD [untagged]
+ retStruct-: Type; (* id of basic type or pointer to typedesc or 0 *)
+ num-: INTEGER; (* number of parameters *)
+ par-: ARRAY any OF RECORD [untagged] (* parameters *)
+ id-: INTEGER; (* name idx * 256 + kind *)
+ struct-: Type (* id of basic type or pointer to typedesc *)
+ END
+ END;
+
+ Handler* = PROCEDURE;
+
+ Reducer* = POINTER TO ABSTRACT RECORD
+ next: Reducer
+ END;
+
+ Identifier* = ABSTRACT RECORD
+ typ*: INTEGER;
+ obj-: ANYPTR
+ END;
+
+ TrapCleaner* = POINTER TO ABSTRACT RECORD
+ next: TrapCleaner
+ END;
+
+ TryHandler* = PROCEDURE (a, b, c: INTEGER);
+
+ (* meta extension suport *)
+
+ ItemExt* = POINTER TO ABSTRACT RECORD END;
+
+ ItemAttr* = RECORD
+ obj*, vis*, typ*, adr*: INTEGER;
+ mod*: Module;
+ desc*: Type;
+ ptr*: S.PTR;
+ ext*: ItemExt
+ END;
+
+ Hook* = POINTER TO ABSTRACT RECORD END;
+
+ LoaderHook* = POINTER TO ABSTRACT RECORD (Hook)
+ res*: INTEGER;
+ importing*, imported*, object*: ARRAY 256 OF CHAR
+ END;
+
+ Block = POINTER TO RECORD [untagged]
+ tag: Type;
+ last: INTEGER; (* arrays: last element *)
+ actual: INTEGER; (* arrays: used during mark phase *)
+ first: INTEGER (* arrays: first element *)
+ END;
+
+ FreeBlock = POINTER TO FreeDesc;
+
+ FreeDesc = RECORD [untagged]
+ tag: Type; (* f.tag = ADR(f.size) *)
+ size: INTEGER;
+ next: FreeBlock
+ END;
+
+ Cluster = POINTER TO RECORD [untagged]
+ size: INTEGER; (* total size *)
+ next: Cluster;
+ max: INTEGER (* exe: reserved size, dll: original address *)
+ (* start of first block *)
+ END;
+
+ FList = POINTER TO RECORD
+ next: FList;
+ blk: Block;
+ iptr, aiptr: BOOLEAN
+ END;
+
+ CList = POINTER TO RECORD
+ next: CList;
+ do: Command;
+ trapped: BOOLEAN
+ END;
+
+
+ PtrType = RECORD v: S.PTR END; (* used for array of pointer *)
+ Char8Type = RECORD v: SHORTCHAR END;
+ Char16Type = RECORD v: CHAR END;
+ Int8Type = RECORD v: BYTE END;
+ Int16Type = RECORD v: SHORTINT END;
+ Int32Type = RECORD v: INTEGER END;
+ Int64Type = RECORD v: LONGINT END;
+ BoolType = RECORD v: BOOLEAN END;
+ SetType = RECORD v: SET END;
+ Real32Type = RECORD v: SHORTREAL END;
+ Real64Type = RECORD v: REAL END;
+ ProcType = RECORD v: PROCEDURE END;
+ UPtrType = RECORD v: INTEGER END;
+ StrPtr = POINTER TO ARRAY [untagged] OF SHORTCHAR;
+
+ ArrStrPtr = POINTER TO ARRAY [untagged] OF StrPtr;
+
+ ADDRESS* = types.Pvoid;
+
+ VAR
+ baseStack: INTEGER;
+ root: Cluster;
+ modList-: Module;
+ trapCount-: INTEGER;
+ err-, pc-, sp-, fp-, stack-, val-: INTEGER;
+
+ isTry: BOOLEAN;
+ startEnv: setjmp.sigjmp_buf;
+ tryEnv: setjmp.jmp_buf;
+
+ argc-: INTEGER;
+ argv-: ArrStrPtr;
+ pagesize: unistd.long;
+
+ free: ARRAY N OF FreeBlock; (* free list *)
+ sentinelBlock: FreeDesc;
+ sentinel: FreeBlock;
+ candidates: ARRAY 1024 OF INTEGER;
+ nofcand: INTEGER;
+ allocated: INTEGER; (* bytes allocated on BlackBox heap *)
+ total: INTEGER; (* current total size of BlackBox heap *)
+ used: INTEGER; (* bytes allocated on system heap *)
+ finalizers: FList;
+ hotFinalizers: FList;
+ cleaners: CList;
+ reducers: Reducer;
+ trapStack: TrapCleaner;
+ actual: Module; (* valid during module initialization *)
+
+ trapViewer, trapChecker: Handler;
+ trapped, guarded, secondTrap: BOOLEAN;
+ interrupted: BOOLEAN;
+ static, inDll, terminating: BOOLEAN;
+ restart: Command;
+
+ loader: LoaderHook;
+ loadres: INTEGER;
+
+ wouldFinalize: BOOLEAN;
+
+ watcher*: PROCEDURE (event: INTEGER); (* for debugging *)
+
+ PROCEDURE Erase (adr, words: INTEGER);
+ BEGIN
+ ASSERT(words >= 0, 20);
+ WHILE words > 0 DO
+ S.PUT(adr, 0);
+ INC(adr, 4);
+ DEC(words)
+ END
+ END Erase;
+
+
+ PROCEDURE (VAR id: Identifier) Identified* (): BOOLEAN, NEW, ABSTRACT;
+ PROCEDURE (r: Reducer) Reduce* (full: BOOLEAN), NEW, ABSTRACT;
+ PROCEDURE (c: TrapCleaner) Cleanup*, NEW, EMPTY;
+
+ (* meta extension suport *)
+
+ PROCEDURE (e: ItemExt) Lookup* (name: ARRAY OF CHAR; VAR i: ANYREC), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) Index* (index: INTEGER; VAR elem: ANYREC), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) Deref* (VAR ref: ANYREC), NEW, ABSTRACT;
+
+ PROCEDURE (e: ItemExt) Valid* (): BOOLEAN, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) Size* (): INTEGER, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) BaseTyp* (): INTEGER, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) Len* (): INTEGER, NEW, ABSTRACT;
+
+ PROCEDURE (e: ItemExt) Call* (OUT ok: BOOLEAN), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) BoolVal* (): BOOLEAN, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutBoolVal* (x: BOOLEAN), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) CharVal* (): CHAR, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutCharVal* (x: CHAR), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) IntVal* (): INTEGER, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutIntVal* (x: INTEGER), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) LongVal* (): LONGINT, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutLongVal* (x: LONGINT), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) RealVal* (): REAL, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutRealVal* (x: REAL), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) SetVal* (): SET, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutSetVal* (x: SET), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PtrVal* (): ANYPTR, NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutPtrVal* (x: ANYPTR), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) GetSStringVal* (OUT x: ARRAY OF SHORTCHAR;
+ OUT ok: BOOLEAN), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutSStringVal* (IN x: ARRAY OF SHORTCHAR;
+ OUT ok: BOOLEAN), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) GetStringVal* (OUT x: ARRAY OF CHAR; OUT ok: BOOLEAN), NEW, ABSTRACT;
+ PROCEDURE (e: ItemExt) PutStringVal* (IN x: ARRAY OF CHAR; OUT ok: BOOLEAN), NEW, ABSTRACT;
+
+ (* -------------------- miscellaneous tools -------------------- *)
+
+ PROCEDURE IsUpper* (ch: CHAR): BOOLEAN;
+ BEGIN
+ RETURN wctype.iswupper(ORD(ch)) # 0
+ END IsUpper;
+
+ PROCEDURE Upper* (ch: CHAR): CHAR;
+ BEGIN
+ RETURN CHR(wctype.towupper(ORD(ch)))
+ END Upper;
+
+ PROCEDURE IsLower* (ch: CHAR): BOOLEAN;
+ BEGIN
+ RETURN wctype.iswlower(ORD(ch)) # 0
+ END IsLower;
+
+ PROCEDURE Lower* (ch: CHAR): CHAR;
+ BEGIN
+ RETURN CHR(wctype.towlower(ORD(ch)))
+ END Lower;
+
+ PROCEDURE IsAlpha* (ch: CHAR): BOOLEAN;
+ BEGIN
+ RETURN wctype.iswalpha(ORD(ch)) # 0
+ END IsAlpha;
+
+ PROCEDURE Utf8ToString* (IN in: ARRAY OF SHORTCHAR; OUT out: ARRAY OF CHAR; OUT res: INTEGER);
+ VAR i, j, val, max: INTEGER; ch: SHORTCHAR;
+
+ PROCEDURE FormatError();
+ BEGIN out := in$; res := 2 (*format error*)
+ END FormatError;
+
+ BEGIN
+ ch := in[0]; i := 1; j := 0; max := LEN(out) - 1;
+ WHILE (ch # 0X) & (j < max) DO
+ IF ch < 80X THEN
+ out[j] := ch; INC(j)
+ ELSIF ch < 0E0X THEN
+ val := ORD(ch) - 192;
+ IF val < 0 THEN FormatError; RETURN END ;
+ ch := in[i]; INC(i); val := val * 64 + ORD(ch) - 128;
+ IF (ch < 80X) OR (ch >= 0E0X) THEN FormatError; RETURN END ;
+ out[j] := CHR(val); INC(j)
+ ELSIF ch < 0F0X THEN
+ val := ORD(ch) - 224;
+ ch := in[i]; INC(i); val := val * 64 + ORD(ch) - 128;
+ IF (ch < 80X) OR (ch >= 0E0X) THEN FormatError; RETURN END ;
+ ch := in[i]; INC(i); val := val * 64 + ORD(ch) - 128;
+ IF (ch < 80X) OR (ch >= 0E0X) THEN FormatError; RETURN END ;
+ out[j] := CHR(val); INC(j)
+ ELSE
+ FormatError; RETURN
+ END ;
+ ch := in[i]; INC(i)
+ END;
+ out[j] := 0X;
+ IF ch = 0X THEN res := 0 (*ok*) ELSE res := 1 (*truncated*) END
+ END Utf8ToString;
+
+ PROCEDURE StringToUtf8* (IN in: ARRAY OF CHAR; OUT out: ARRAY OF SHORTCHAR; OUT res: INTEGER);
+ VAR i, j, val, max: INTEGER;
+ BEGIN
+ i := 0; j := 0; max := LEN(out) - 3;
+ WHILE (in[i] # 0X) & (j < max) DO
+ val := ORD(in[i]); INC(i);
+ IF val < 128 THEN
+ out[j] := SHORT(CHR(val)); INC(j)
+ ELSIF val < 2048 THEN
+ out[j] := SHORT(CHR(val DIV 64 + 192)); INC(j);
+ out[j] := SHORT(CHR(val MOD 64 + 128)); INC(j)
+ ELSE
+ out[j] := SHORT(CHR(val DIV 4096 + 224)); INC(j);
+ out[j] := SHORT(CHR(val DIV 64 MOD 64 + 128)); INC(j);
+ out[j] := SHORT(CHR(val MOD 64 + 128)); INC(j)
+ END;
+ END;
+ out[j] := 0X;
+ IF in[i] = 0X THEN res := 0 (*ok*) ELSE res := 1 (*truncated*) END
+ END StringToUtf8;
+
+ PROCEDURE SplitName* (name: ARRAY OF CHAR; VAR head, tail: ARRAY OF CHAR);
+ (* portable *)
+ VAR i, j: INTEGER; ch, lch: CHAR;
+ BEGIN
+ i := 0; ch := name[0];
+ IF ch # 0X THEN
+ REPEAT
+ head[i] := ch; lch := ch; INC(i); ch := name[i]
+ UNTIL (ch = 0X) OR (ch = ".") OR IsUpper(ch) & ~IsUpper(lch);
+ IF ch = "." THEN i := 0; ch := name[0] END;
+ head[i] := 0X; j := 0;
+ WHILE ch # 0X DO tail[j] := ch; INC(i); INC(j); ch := name[i] END;
+ tail[j] := 0X;
+ IF tail = "" THEN tail := head$; head := "" END
+ ELSE head := ""; tail := ""
+ END
+ END SplitName;
+
+ PROCEDURE MakeFileName* (VAR name: ARRAY OF CHAR; type: ARRAY OF CHAR);
+ VAR i, j: INTEGER; ext: ARRAY 8 OF CHAR; ch: CHAR;
+ BEGIN
+ i := 0;
+ WHILE (name[i] # 0X) & (name[i] # ".") DO INC(i) END;
+ IF name[i] = "." THEN
+ IF name[i + 1] = 0X THEN name[i] := 0X END
+ ELSE
+ IF type = "" THEN ext := docType ELSE ext := type$ END;
+ IF i < LEN(name) - LEN(ext$) - 1 THEN
+ name[i] := "."; INC(i); j := 0; ch := ext[0];
+ WHILE ch # 0X DO
+ name[i] := Lower(ch); INC(i); INC(j); ch := ext[j]
+ END;
+ name[i] := 0X
+ END
+ END
+ END MakeFileName;
+
+ PROCEDURE Time* (): LONGINT;
+ VAR res: time.int; tp: time.struct_timespec;
+ BEGIN
+ ASSERT(timeResolution >= 1);
+ ASSERT(timeResolution <= 1000000000);
+ res := time.clock_gettime(time.CLOCK_MONOTONIC, tp);
+ ASSERT(res = 0, 100);
+ RETURN tp.tv_sec * LONG(timeResolution) + tp.tv_nsec DIV LONG(1000000000 DIV timeResolution)
+ END Time;
+
+ PROCEDURE Beep*;
+ (* !!! *)
+ END Beep;
+
+ PROCEDURE SearchProcVar* (var: INTEGER; VAR m: Module; VAR adr: INTEGER);
+ BEGIN
+ adr := var; m := NIL;
+ IF var # 0 THEN
+ m := modList;
+ WHILE (m # NIL) & ((var < m.code) OR (var >= m.code + m.csize)) DO m := m.next END;
+ IF m # NIL THEN DEC(adr, m.code) END
+ END
+ END SearchProcVar;
+
+ (* -------------------- system memory management --------------------- *)
+
+ PROCEDURE AllocMem (size: sysmman.size_t; VAR max: sysmman.size_t): ADDRESS;
+ VAR fd, flags, res: fcntl.int; ptr: ADDRESS;
+ BEGIN
+ max := (size + pagesize - 1) DIV pagesize * pagesize;
+ fd := fcntl.open("/dev/zero", fcntl.O_RDWR, 0);
+ IF fd # -1 THEN
+ flags := sysmman.PROT_READ + sysmman.PROT_WRITE;
+ ptr := sysmman.mmap(0, max, flags, sysmman.MAP_PRIVATE, fd, 0);
+ IF ptr = sysmman.MAP_FAILED THEN ptr := 0 END;
+ res := unistd.close(fd);
+ ASSERT(res = 0, 100)
+ ELSE
+ ptr := 0
+ END;
+ RETURN ptr
+ END AllocMem;
+
+ PROCEDURE FreeMem (adr: ADDRESS; size: sysmman.size_t);
+ VAR res: types.int;
+ BEGIN
+ size := (size + pagesize - 1) DIV pagesize * pagesize;
+ res := sysmman.munmap(adr, size);
+ ASSERT(res = 0, 100)
+ END FreeMem;
+
+ PROCEDURE AllocHeapMem (size: INTEGER; VAR c: Cluster);
+ CONST N = 65536; (* cluster size for dll *)
+ VAR adr, allocated: INTEGER;
+ BEGIN
+ INC(size, 16);
+ ASSERT(size > 0, 100); adr := 0;
+ IF size < N THEN adr := stdlib.malloc(N) END;
+ IF adr = 0 THEN adr := stdlib.malloc(size); allocated := size ELSE allocated := N END;
+ IF adr = 0 THEN c := NIL
+ ELSE
+ c := S.VAL(Cluster, (adr + 15) DIV 16 * 16); c.max := adr;
+ c.size := allocated - (S.VAL(INTEGER, c) - adr);
+ INC(used, c.size); INC(total, c.size)
+ END;
+ ASSERT((adr = 0) OR (adr MOD 16 = 0) & (c.size >= size), 101);
+ (* post: (c = NIL) OR (c MOD 16 = 0) & (c.size >= size) *)
+ END AllocHeapMem;
+
+ PROCEDURE FreeHeapMem (c: Cluster);
+ BEGIN
+ DEC(used, c.size); DEC(total, c.size);
+ stdlib.free(S.VAL(ADDRESS, c.max))
+ END FreeHeapMem;
+
+ PROCEDURE HeapFull (size: INTEGER): BOOLEAN;
+ BEGIN
+ RETURN TRUE
+ END HeapFull;
+
+ PROCEDURE AllocModMem* (descSize, modSize: INTEGER; VAR descAdr, modAdr: INTEGER);
+ BEGIN
+ descAdr := 0; modAdr := 0;
+ descAdr := AllocMem(descSize, descSize);
+ IF descAdr # 0 THEN
+ modAdr := AllocMem(modSize, modSize);
+ IF modAdr = 0 THEN
+ FreeMem(descAdr, descSize)
+ ELSE
+ INC(used, descSize + modSize)
+ END
+ END
+ END AllocModMem;
+
+ PROCEDURE DeallocModMem* (descSize, modSize, descAdr, modAdr: INTEGER);
+ BEGIN
+ FreeMem(descAdr, descSize);
+ FreeMem(modAdr, modSize);
+ DEC(used, descSize + modSize)
+ END DeallocModMem;
+
+ PROCEDURE InvalModMem (modSize, modAdr: INTEGER);
+ BEGIN
+ FreeMem(modAdr, modSize)
+ END InvalModMem;
+
+ PROCEDURE TryRead (from, to, c: INTEGER);
+ VAR i: INTEGER; x: BYTE;
+ BEGIN
+ IF from <= to THEN
+ FOR i := from TO to DO
+ S.GET(i, x)
+ END
+ ELSE
+ FOR i := to TO from BY -1 DO
+ S.GET(i, x)
+ END
+ END;
+ END TryRead;
+
+ PROCEDURE^ Try* (h: TryHandler; a, b, c: INTEGER);
+
+ PROCEDURE IsReadable* (from, to: INTEGER): BOOLEAN;
+ VAR i: INTEGER;
+ BEGIN
+ i := trapCount;
+ Try(TryRead, from, to, 0);
+ RETURN trapCount = i
+ END IsReadable;
+
+ (* --------------------- NEW implementation (portable) -------------------- *)
+
+ PROCEDURE^ NewBlock (size: INTEGER): Block;
+
+ PROCEDURE NewRec* (typ: INTEGER): INTEGER; (* implementation of NEW(ptr) *)
+ VAR size, adr: INTEGER; b: Block; tag: Type; l: FList;
+ BEGIN
+ IF ~ODD(typ) THEN
+ tag := S.VAL(Type, typ);
+ b := NewBlock(tag.size);
+ IF b # NIL THEN
+ b.tag := tag;
+ S.GET(typ - 4, size);
+ IF size # 0 THEN (* record uses a finalizer *)
+ l := S.VAL(FList, S.ADR(b.last)); (* anchor new object! *)
+ l := S.VAL(FList, NewRec(S.TYP(FList))); (* NEW(l) *)
+ l.blk := b; l.next := finalizers; finalizers := l
+ END;
+ adr := S.ADR(b.last)
+ ELSE
+ adr := 0
+ END
+ ELSE
+ HALT(100) (* COM interface pointers not supported *)
+ END;
+ RETURN adr
+ END NewRec;
+
+ PROCEDURE NewArr* (eltyp, nofelem, nofdim: INTEGER): INTEGER; (* impl. of NEW(ptr, dim0, dim1, ...) *)
+ VAR b: Block; size, headSize: INTEGER; t: Type;
+ BEGIN
+ CASE eltyp OF
+ | -1: HALT(100) (* COM interface pointers not supported *)
+ | 0: eltyp := S.ADR(PtrType)
+ | 1: eltyp := S.ADR(Char8Type)
+ | 2: eltyp := S.ADR(Int16Type)
+ | 3: eltyp := S.ADR(Int8Type)
+ | 4: eltyp := S.ADR(Int32Type)
+ | 5: eltyp := S.ADR(BoolType)
+ | 6: eltyp := S.ADR(SetType)
+ | 7: eltyp := S.ADR(Real32Type)
+ | 8: eltyp := S.ADR(Real64Type)
+ | 9: eltyp := S.ADR(Char16Type)
+ | 10: eltyp := S.ADR(Int64Type)
+ | 11: eltyp := S.ADR(ProcType)
+ | 12: HALT(101) (* COM interface pointers not supported *)
+ ELSE
+ ASSERT(~ODD(eltyp), 102) (* COM interface pointers not supported *)
+ END;
+ t := S.VAL(Type, eltyp);
+ headSize := 4 * nofdim + 12;
+ size := headSize + nofelem * t.size;
+ b := NewBlock(size);
+ IF b # NIL THEN
+ b.tag := S.VAL(Type, eltyp + 2); (* tag + array mark *)
+ b.last := S.ADR(b.last) + size - t.size; (* pointer to last elem *)
+ b.first := S.ADR(b.last) + headSize; (* pointer to first elem *)
+ RETURN S.ADR(b.last)
+ ELSE
+ RETURN 0
+ END;
+ END NewArr;
+
+ (* -------------------- handler installation (portable) --------------------- *)
+
+ PROCEDURE ThisFinObj* (VAR id: Identifier): ANYPTR;
+ VAR l: FList;
+ BEGIN
+ ASSERT(id.typ # 0, 100);
+ l := finalizers;
+ WHILE l # NIL DO
+ IF S.VAL(INTEGER, l.blk.tag) = id.typ THEN
+ id.obj := S.VAL(ANYPTR, S.ADR(l.blk.last));
+ IF id.Identified() THEN RETURN id.obj END
+ END;
+ l := l.next
+ END;
+ RETURN NIL
+ END ThisFinObj;
+
+ PROCEDURE InstallReducer* (r: Reducer);
+ BEGIN
+ r.next := reducers; reducers := r
+ END InstallReducer;
+
+ PROCEDURE InstallTrapViewer* (h: Handler);
+ BEGIN
+ trapViewer := h
+ END InstallTrapViewer;
+
+ PROCEDURE InstallTrapChecker* (h: Handler);
+ BEGIN
+ trapChecker := h
+ END InstallTrapChecker;
+
+ PROCEDURE PushTrapCleaner* (c: TrapCleaner);
+ VAR t: TrapCleaner;
+ BEGIN
+ t := trapStack; WHILE (t # NIL) & (t # c) DO t := t.next END;
+ ASSERT(t = NIL, 20);
+ c.next := trapStack; trapStack := c
+ END PushTrapCleaner;
+
+ PROCEDURE PopTrapCleaner* (c: TrapCleaner);
+ VAR t: TrapCleaner;
+ BEGIN
+ t := NIL;
+ WHILE (trapStack # NIL) & (t # c) DO
+ t := trapStack; trapStack := trapStack.next
+ END
+ END PopTrapCleaner;
+
+ PROCEDURE InstallCleaner* (p: Command);
+ VAR c: CList;
+ BEGIN
+ c := S.VAL(CList, NewRec(S.TYP(CList))); (* NEW(c) *)
+ c.do := p; c.trapped := FALSE; c.next := cleaners; cleaners := c
+ END InstallCleaner;
+
+ PROCEDURE RemoveCleaner* (p: Command);
+ VAR c0, c: CList;
+ BEGIN
+ c := cleaners; c0 := NIL;
+ WHILE (c # NIL) & (c.do # p) DO c0 := c; c := c.next END;
+ IF c # NIL THEN
+ IF c0 = NIL THEN cleaners := cleaners.next ELSE c0.next := c.next END
+ END
+ END RemoveCleaner;
+
+ PROCEDURE Cleanup*;
+ VAR c, c0: CList;
+ BEGIN
+ c := cleaners; c0 := NIL;
+ WHILE c # NIL DO
+ IF ~c.trapped THEN
+ c.trapped := TRUE; c.do; c.trapped := FALSE; c0 := c
+ ELSE
+ IF c0 = NIL THEN cleaners := cleaners.next
+ ELSE c0.next := c.next
+ END
+ END;
+ c := c.next
+ END
+ END Cleanup;
+
+ (* -------------------- meta information (portable) --------------------- *)
+
+ PROCEDURE (h: LoaderHook) ThisMod* (IN name: ARRAY OF CHAR): Module, NEW, ABSTRACT;
+
+ PROCEDURE SetLoaderHook*(h: LoaderHook);
+ BEGIN
+ loader := h
+ END SetLoaderHook;
+
+ PROCEDURE InitModule (mod: Module); (* initialize linked modules *)
+ VAR body: Command;
+ BEGIN
+ IF ~(dyn IN mod.opts) & (mod.next # NIL) & ~(init IN mod.next.opts) THEN InitModule(mod.next) END;
+ IF ~(init IN mod.opts) THEN
+ body := S.VAL(Command, mod.code);
+ INCL(mod.opts, init);
+ actual := mod;
+ body(); actual := NIL
+ END
+ END InitModule;
+
+ PROCEDURE ThisLoadedMod* (IN name: ARRAY OF CHAR): Module; (* loaded modules only *)
+ VAR m: Module; res: INTEGER; n: Utf8Name;
+ BEGIN
+ StringToUtf8(name, n, res); ASSERT(res = 0);
+ loadres := done;
+ m := modList;
+ WHILE (m # NIL) & ((m.name # n) OR (m.refcnt < 0)) DO m := m.next END;
+ IF (m # NIL) & ~(init IN m.opts) THEN InitModule(m) END;
+ IF m = NIL THEN loadres := moduleNotFound END;
+ RETURN m
+ END ThisLoadedMod;
+
+ PROCEDURE ThisMod* (IN name: ARRAY OF CHAR): Module;
+ BEGIN
+ IF loader # NIL THEN
+ loader.res := done;
+ RETURN loader.ThisMod(name)
+ ELSE
+ RETURN ThisLoadedMod(name)
+ END
+ END ThisMod;
+
+ PROCEDURE LoadMod* (IN name: ARRAY OF CHAR);
+ VAR m: Module;
+ BEGIN
+ m := ThisMod(name)
+ END LoadMod;
+
+ PROCEDURE GetLoaderResult* (OUT res: INTEGER; OUT importing, imported, object: ARRAY OF CHAR);
+ BEGIN
+ IF loader # NIL THEN
+ res := loader.res;
+ importing := loader.importing$;
+ imported := loader.imported$;
+ object := loader.object$
+ ELSE
+ res := loadres;
+ importing := "";
+ imported := "";
+ object := ""
+ END
+ END GetLoaderResult;
+
+ PROCEDURE ThisObject* (mod: Module; IN name: ARRAY OF CHAR): Object;
+ VAR l, r, m, res: INTEGER; p: StrPtr; n: Utf8Name;
+ BEGIN
+ StringToUtf8(name, n, res); ASSERT(res = 0);
+ l := 0; r := mod.export.num;
+ WHILE l < r DO (* binary search *)
+ m := (l + r) DIV 2;
+ p := S.VAL(StrPtr, S.ADR(mod.names[mod.export.obj[m].id DIV 256]));
+ IF p^ = n THEN RETURN S.VAL(Object, S.ADR(mod.export.obj[m])) END;
+ IF p^ < n THEN l := m + 1 ELSE r := m END
+ END;
+ RETURN NIL
+ END ThisObject;
+
+ PROCEDURE ThisDesc* (mod: Module; fprint: INTEGER): Object;
+ VAR i, n: INTEGER;
+ BEGIN
+ i := 0; n := mod.export.num;
+ WHILE (i < n) & (mod.export.obj[i].id DIV 256 = 0) DO
+ IF mod.export.obj[i].offs = fprint THEN RETURN S.VAL(Object, S.ADR(mod.export.obj[i])) END;
+ INC(i)
+ END;
+ RETURN NIL
+ END ThisDesc;
+
+ PROCEDURE ThisField* (rec: Type; IN name: ARRAY OF CHAR): Object;
+ VAR n, res: INTEGER; p: StrPtr; obj: Object; m: Module; nn: Utf8Name;
+ BEGIN
+ StringToUtf8(name, nn, res); ASSERT(res = 0);
+ m := rec.mod;
+ obj := S.VAL(Object, S.ADR(rec.fields.obj[0])); n := rec.fields.num;
+ WHILE n > 0 DO
+ p := S.VAL(StrPtr, S.ADR(m.names[obj.id DIV 256]));
+ IF p^ = nn THEN RETURN obj END;
+ DEC(n); INC(S.VAL(INTEGER, obj), 16)
+ END;
+ RETURN NIL
+ END ThisField;
+
+ PROCEDURE ThisCommand* (mod: Module; IN name: ARRAY OF CHAR): Command;
+ VAR x: Object; sig: Signature;
+ BEGIN
+ x := ThisObject(mod, name);
+ IF (x # NIL) & (x.id MOD 16 = mProc) THEN
+ sig := S.VAL(Signature, x.struct);
+ IF (sig.retStruct = NIL) & (sig.num = 0) THEN RETURN S.VAL(Command, mod.procBase + x.offs) END
+ END;
+ RETURN NIL
+ END ThisCommand;
+
+ PROCEDURE ThisType* (mod: Module; IN name: ARRAY OF CHAR): Type;
+ VAR x: Object;
+ BEGIN
+ x := ThisObject(mod, name);
+ IF (x # NIL) & (x.id MOD 16 = mTyp) & (S.VAL(INTEGER, x.struct) DIV 256 # 0) THEN
+ RETURN x.struct
+ ELSE
+ RETURN NIL
+ END
+ END ThisType;
+
+ PROCEDURE TypeOf* (IN rec: ANYREC): Type;
+ BEGIN
+ RETURN S.VAL(Type, S.TYP(rec))
+ END TypeOf;
+
+ PROCEDURE LevelOf* (t: Type): SHORTINT;
+ BEGIN
+ RETURN SHORT(t.id DIV 16 MOD 16)
+ END LevelOf;
+
+ PROCEDURE NewObj* (VAR o: S.PTR; t: Type);
+ VAR i: INTEGER;
+ BEGIN
+ IF t.size = -1 THEN o := NIL
+ ELSE
+ i := 0; WHILE t.ptroffs[i] >= 0 DO INC(i) END;
+ IF t.ptroffs[i+1] >= 0 THEN INC(S.VAL(INTEGER, t)) END; (* with interface pointers *)
+ o := S.VAL(S.PTR, NewRec(S.VAL(INTEGER, t))) (* generic NEW *)
+ END
+ END NewObj;
+
+ PROCEDURE GetModName* (mod: Module; OUT name: Name);
+ VAR res: INTEGER;
+ BEGIN
+ Utf8ToString(mod.name, name, res); ASSERT(res = 0)
+ END GetModName;
+
+ PROCEDURE GetObjName* (mod: Module; obj: Object; OUT name: Name);
+ VAR p: StrPtr; res: INTEGER;
+ BEGIN
+ p := S.VAL(StrPtr, S.ADR(mod.names[obj.id DIV 256]));
+ Utf8ToString(p^$, name, res); ASSERT(res = 0)
+ END GetObjName;
+
+ PROCEDURE GetTypeName* (t: Type; OUT name: Name);
+ VAR p: StrPtr; res: INTEGER;
+ BEGIN
+ p := S.VAL(StrPtr, S.ADR(t.mod.names[t.id DIV 256]));
+ Utf8ToString(p^$, name, res); ASSERT(res = 0)
+ END GetTypeName;
+
+ PROCEDURE RegisterMod* (mod: Module);
+ VAR i: INTEGER; epoch: time.time_t; tm: time.struct_tm; ptm: time.Pstruct_tm;
+ BEGIN
+ mod.next := modList; modList := mod; mod.refcnt := 0; INCL(mod.opts, dyn); i := 0;
+ WHILE i < mod.nofimps DO
+ IF mod.imports[i] # NIL THEN INC(mod.imports[i].refcnt) END;
+ INC(i)
+ END;
+ epoch := time.time(NIL);
+ ptm := time.localtime_r(epoch, tm);
+ IF ptm # NIL THEN
+ mod.loadTime[0] := SHORT(tm.tm_year + 1900);
+ mod.loadTime[1] := SHORT(tm.tm_mon + 1);
+ mod.loadTime[2] := SHORT(tm.tm_mday);
+ mod.loadTime[3] := SHORT(tm.tm_hour);
+ mod.loadTime[4] := SHORT(tm.tm_min);
+ mod.loadTime[5] := SHORT(tm.tm_sec)
+ ELSE
+ mod.loadTime[0] := 0;
+ mod.loadTime[1] := 0;
+ mod.loadTime[2] := 0;
+ mod.loadTime[3] := 0;
+ mod.loadTime[4] := 0;
+ mod.loadTime[5] := 0
+ END;
+ IF ~(init IN mod.opts) THEN InitModule(mod) END
+ END RegisterMod;
+
+ PROCEDURE^ Collect*;
+
+ PROCEDURE UnloadMod* (mod: Module);
+ VAR i: INTEGER; t: Command;
+ BEGIN
+ IF mod.refcnt = 0 THEN
+ t := mod.term; mod.term := NIL;
+ IF t # NIL THEN t() END; (* terminate module *)
+ i := 0;
+ WHILE i < mod.nofptrs DO (* release global pointers *)
+ S.PUT(mod.varBase + mod.ptrs[i], 0); INC(i)
+ END;
+ Collect; (* call finalizers *)
+ i := 0;
+ WHILE i < mod.nofimps DO (* release imported modules *)
+ IF mod.imports[i] # NIL THEN DEC(mod.imports[i].refcnt) END;
+ INC(i)
+ END;
+ mod.refcnt := -1;
+ IF dyn IN mod.opts THEN (* release memory *)
+ InvalModMem(mod.data + mod.dsize - mod.refs, mod.refs)
+ END
+ END
+ END UnloadMod;
+
+ (* -------------------- dynamic procedure call --------------------- *)
+
+ PROCEDURE Call* (adr: INTEGER; sig: Signature; IN par: ARRAY OF INTEGER; n: INTEGER): LONGINT;
+ BEGIN
+ HALT(126); (* !!! *)
+ RETURN 0
+ END Call;
+
+ (* -------------------- reference information (portable) --------------------- *)
+
+ PROCEDURE RefCh (VAR ref: INTEGER; OUT ch: SHORTCHAR);
+ BEGIN
+ S.GET(ref, ch); INC(ref)
+ END RefCh;
+
+ PROCEDURE RefNum (VAR ref: INTEGER; OUT x: INTEGER);
+ VAR s, n: INTEGER; ch: SHORTCHAR;
+ BEGIN
+ s := 0; n := 0; RefCh(ref, ch);
+ WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); RefCh(ref, ch) END;
+ x := n + ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s)
+ END RefNum;
+
+ PROCEDURE RefName (VAR ref: INTEGER; OUT n: Utf8Name);
+ VAR i: INTEGER; ch: SHORTCHAR;
+ BEGIN
+ i := 0; RefCh(ref, ch);
+ WHILE ch # 0X DO n[i] := ch; INC(i); RefCh(ref, ch) END;
+ n[i] := 0X
+ END RefName;
+
+ PROCEDURE GetRefProc* (VAR ref: INTEGER; OUT adr: INTEGER; OUT name: Utf8Name);
+ VAR ch: SHORTCHAR;
+ BEGIN
+ S.GET(ref, ch);
+ WHILE ch >= 0FDX DO (* skip variables *)
+ INC(ref); RefCh(ref, ch);
+ IF ch = 10X THEN INC(ref, 4) END;
+ RefNum(ref, adr); RefName(ref, name); S.GET(ref, ch)
+ END;
+ WHILE (ch > 0X) & (ch < 0FCX) DO (* skip source refs *)
+ INC(ref); RefNum(ref, adr); S.GET(ref, ch)
+ END;
+ IF ch = 0FCX THEN INC(ref); RefNum(ref, adr); RefName(ref, name)
+ ELSE adr := 0
+ END
+ END GetRefProc;
+
+ PROCEDURE GetRefVar* (VAR ref: INTEGER; OUT mode, form: SHORTCHAR; OUT desc: Type; OUT adr: INTEGER; OUT name: Utf8Name);
+ BEGIN
+ S.GET(ref, mode); desc := NIL;
+ IF mode >= 0FDX THEN
+ mode := SHORT(CHR(ORD(mode) - 0FCH));
+ INC(ref); RefCh(ref, form);
+ IF form = 10X THEN
+ S.GET(ref, desc); INC(ref, 4); form := SHORT(CHR(16 + desc.id MOD 4))
+ END;
+ RefNum(ref, adr); RefName(ref, name)
+ ELSE
+ mode := 0X; form := 0X; adr := 0
+ END
+ END GetRefVar;
+
+ PROCEDURE SourcePos* (mod: Module; codePos: INTEGER): INTEGER;
+ VAR ref, pos, ad, d: INTEGER; ch: SHORTCHAR; name: Utf8Name;
+ BEGIN
+ IF mod # NIL THEN (* mf, 12.02.04 *)
+ ref := mod.refs; pos := 0; ad := 0; S.GET(ref, ch);
+ WHILE ch # 0X DO
+ WHILE (ch > 0X) & (ch < 0FCX) DO (* srcref: {dAdr,dPos} *)
+ INC(ad, ORD(ch)); INC(ref); RefNum(ref, d);
+ IF ad > codePos THEN RETURN pos END;
+ INC(pos, d); S.GET(ref, ch)
+ END;
+ IF ch = 0FCX THEN (* proc: 0FCX,Adr,Name *)
+ INC(ref); RefNum(ref, d); RefName(ref, name); S.GET(ref, ch);
+ IF (d > codePos) & (pos > 0) THEN RETURN pos END
+ END;
+ WHILE ch >= 0FDX DO (* skip variables: Mode, Form, adr, Name *)
+ INC(ref); RefCh(ref, ch);
+ IF ch = 10X THEN INC(ref, 4) END;
+ RefNum(ref, d); RefName(ref, name); S.GET(ref, ch)
+ END
+ END;
+ END;
+ RETURN -1
+ END SourcePos;
+
+ PROCEDURE LoadDll* (IN name: ARRAY OF CHAR; VAR ok: BOOLEAN);
+ VAR h: ADDRESS; file: Utf8Name; res: INTEGER;
+ BEGIN
+ StringToUtf8(name, file, res);
+ IF res = 0 THEN
+ h := dlfcn.dlopen(file, dlfcn.RTLD_LAZY + dlfcn.RTLD_GLOBAL);
+ ok := h # 0
+ ELSE
+ ok := FALSE
+ END
+ END LoadDll;
+
+ PROCEDURE ThisDllObj* (mode, fprint: INTEGER; IN dll, name: ARRAY OF CHAR): INTEGER;
+ VAR h, p: ADDRESS; file, sym: Utf8Name; res: INTEGER; err: dlfcn.int;
+ BEGIN
+ StringToUtf8(dll, file, res);
+ IF res = 0 THEN
+ h := dlfcn.dlopen(file, dlfcn.RTLD_LAZY + dlfcn.RTLD_GLOBAL);
+ IF h # 0 THEN
+ StringToUtf8(name, sym, res);
+ IF res = 0 THEN
+ p := dlfcn.dlsym(h, sym)
+ ELSE
+ p := 0
+ END;
+ err := dlfcn.dlclose(h);
+ ASSERT(err = 0, 100)
+ ELSE
+ p := 0
+ END
+ ELSE
+ p := 0
+ END;
+ RETURN p
+ END ThisDllObj;
+
+ (* -------------------- garbage collector (portable) --------------------- *)
+
+ PROCEDURE Mark (this: Block);
+ VAR father, son: Block; tag: Type; flag, offset, actual: INTEGER;
+ BEGIN
+ IF ~ODD(S.VAL(INTEGER, this.tag)) THEN
+ father := NIL;
+ LOOP
+ INC(S.VAL(INTEGER, this.tag));
+ flag := S.VAL(INTEGER, this.tag) MOD 4;
+ tag := S.VAL(Type, S.VAL(INTEGER, this.tag) - flag);
+ IF flag >= 2 THEN actual := this.first; this.actual := actual
+ ELSE actual := S.ADR(this.last)
+ END;
+ LOOP
+ offset := tag.ptroffs[0];
+ IF offset < 0 THEN
+ INC(S.VAL(INTEGER, tag), offset + 4); (* restore tag *)
+ IF (flag >= 2) & (actual < this.last) & (offset < -4) THEN (* next array element *)
+ INC(actual, tag.size); this.actual := actual
+ ELSE (* up *)
+ this.tag := S.VAL(Type, S.VAL(INTEGER, tag) + flag);
+ IF father = NIL THEN RETURN END;
+ son := this; this := father;
+ flag := S.VAL(INTEGER, this.tag) MOD 4;
+ tag := S.VAL(Type, S.VAL(INTEGER, this.tag) - flag);
+ offset := tag.ptroffs[0];
+ IF flag >= 2 THEN actual := this.actual ELSE actual := S.ADR(this.last) END;
+ S.GET(actual + offset, father); S.PUT(actual + offset, S.ADR(son.last));
+ INC(S.VAL(INTEGER, tag), 4)
+ END
+ ELSE
+ S.GET(actual + offset, son);
+ IF son # NIL THEN
+ DEC(S.VAL(INTEGER, son), 4);
+ IF ~ODD(S.VAL(INTEGER, son.tag)) THEN (* down *)
+ this.tag := S.VAL(Type, S.VAL(INTEGER, tag) + flag);
+ S.PUT(actual + offset, father); father := this; this := son;
+ EXIT
+ END
+ END;
+ INC(S.VAL(INTEGER, tag), 4)
+ END
+ END
+ END
+ END
+ END Mark;
+
+ PROCEDURE MarkGlobals;
+ VAR m: Module; i, p: INTEGER;
+ BEGIN
+ m := modList;
+ WHILE m # NIL DO
+ IF m.refcnt >= 0 THEN
+ i := 0;
+ WHILE i < m.nofptrs DO
+ S.GET(m.varBase + m.ptrs[i], p); INC(i);
+ IF p # 0 THEN Mark(S.VAL(Block, p - 4)) END
+ END
+ END;
+ m := m.next
+ END
+ END MarkGlobals;
+
+ PROCEDURE Next (b: Block): Block; (* next block in same cluster *)
+ VAR size: INTEGER;
+ BEGIN
+ S.GET(S.VAL(INTEGER, b.tag) DIV 4 * 4, size);
+ IF ODD(S.VAL(INTEGER, b.tag) DIV 2) THEN INC(size, b.last - S.ADR(b.last)) END;
+ RETURN S.VAL(Block, S.VAL(INTEGER, b) + (size + 19) DIV 16 * 16)
+ END Next;
+
+ PROCEDURE CheckCandidates;
+ (* pre: nofcand > 0 *)
+ VAR i, j, h, p, end: INTEGER; c: Cluster; blk, next: Block;
+ BEGIN
+ (* sort candidates (shellsort) *)
+ h := 1; REPEAT h := h*3 + 1 UNTIL h > nofcand;
+ REPEAT h := h DIV 3; i := h;
+ WHILE i < nofcand DO p := candidates[i]; j := i;
+ WHILE (j >= h) & (candidates[j-h] > p) DO
+ candidates[j] := candidates[j-h]; j := j-h
+ END;
+ candidates[j] := p; INC(i)
+ END
+ UNTIL h = 1;
+ (* sweep *)
+ c := root; i := 0;
+ WHILE c # NIL DO
+ blk := S.VAL(Block, S.VAL(INTEGER, c) + 12);
+ end := S.VAL(INTEGER, blk) + (c.size - 12) DIV 16 * 16;
+ WHILE candidates[i] < S.VAL(INTEGER, blk) DO
+ INC(i);
+ IF i = nofcand THEN RETURN END
+ END;
+ WHILE S.VAL(INTEGER, blk) < end DO
+ next := Next(blk);
+ IF candidates[i] < S.VAL(INTEGER, next) THEN
+ IF (S.VAL(INTEGER, blk.tag) # S.ADR(blk.last)) (* not a free block *)
+ & (~strictStackSweep OR (candidates[i] = S.ADR(blk.last))) THEN
+ Mark(blk)
+ END;
+ REPEAT
+ INC(i);
+ IF i = nofcand THEN RETURN END
+ UNTIL candidates[i] >= S.VAL(INTEGER, next)
+ END;
+ IF (S.VAL(INTEGER, blk.tag) MOD 4 = 0) & (S.VAL(INTEGER, blk.tag) # S.ADR(blk.last))
+ & (blk.tag.base[0] = NIL) & (blk.actual > 0) THEN (* referenced interface record *)
+ Mark(blk)
+ END;
+ blk := next
+ END;
+ c := c.next
+ END
+ END CheckCandidates;
+
+ PROCEDURE MarkLocals;
+ VAR sp, p, min, max: INTEGER; c: Cluster;
+ BEGIN
+ sp := S.ADR(sp); nofcand := 0; c := root;
+ WHILE c.next # NIL DO c := c.next END;
+ min := S.VAL(INTEGER, root); max := S.VAL(INTEGER, c) + c.size;
+ WHILE sp < baseStack DO
+ S.GET(sp, p);
+ IF (p > min) & (p < max) & (~strictStackSweep OR (p MOD 16 = 0)) THEN
+ candidates[nofcand] := p; INC(nofcand);
+ IF nofcand = LEN(candidates) - 1 THEN CheckCandidates; nofcand := 0 END
+ END;
+ INC(sp, 4)
+ END;
+ candidates[nofcand] := max; INC(nofcand); (* ensure complete scan for interface mark*)
+ IF nofcand > 0 THEN CheckCandidates END
+ END MarkLocals;
+
+ PROCEDURE MarkFinObj;
+ VAR f: FList;
+ BEGIN
+ wouldFinalize := FALSE;
+ f := finalizers;
+ WHILE f # NIL DO
+ IF ~ODD(S.VAL(INTEGER, f.blk.tag)) THEN wouldFinalize := TRUE END;
+ Mark(f.blk);
+ f := f.next
+ END;
+ f := hotFinalizers;
+ WHILE f # NIL DO IF ~ODD(S.VAL(INTEGER, f.blk.tag)) THEN wouldFinalize := TRUE END;
+ Mark(f.blk);
+ f := f.next
+ END
+ END MarkFinObj;
+
+ PROCEDURE CheckFinalizers;
+ VAR f, g, h, k: FList;
+ BEGIN
+ f := finalizers; g := NIL;
+ IF hotFinalizers = NIL THEN k := NIL
+ ELSE
+ k := hotFinalizers;
+ WHILE k.next # NIL DO k := k.next END
+ END;
+ WHILE f # NIL DO
+ h := f; f := f.next;
+ IF ~ODD(S.VAL(INTEGER, h.blk.tag)) THEN
+ IF g = NIL THEN finalizers := f ELSE g.next := f END;
+ IF k = NIL THEN hotFinalizers := h ELSE k.next := h END;
+ k := h; h.next := NIL
+ ELSE g := h
+ END
+ END;
+ h := hotFinalizers;
+ WHILE h # NIL DO Mark(h.blk); h := h.next END
+ END CheckFinalizers;
+
+ PROCEDURE ExecFinalizer (a, b, c: INTEGER);
+ VAR f: FList; fin: PROCEDURE(this: ANYPTR);
+ BEGIN
+ f := S.VAL(FList, a);
+ S.GET(S.VAL(INTEGER, f.blk.tag) - 4, fin); (* method 0 *)
+ IF (fin # NIL) & (f.blk.tag.mod.refcnt >= 0) THEN fin(S.VAL(ANYPTR, S.ADR(f.blk.last))) END;
+ END ExecFinalizer;
+
+ PROCEDURE^ Try* (h: TryHandler; a, b, c: INTEGER); (* COMPILER DEPENDENT *)
+
+ PROCEDURE CallFinalizers;
+ VAR f: FList;
+ BEGIN
+ WHILE hotFinalizers # NIL DO
+ f := hotFinalizers; hotFinalizers := hotFinalizers.next;
+ Try(ExecFinalizer, S.VAL(INTEGER, f), 0, 0)
+ END;
+ wouldFinalize := FALSE
+ END CallFinalizers;
+
+ PROCEDURE Insert (blk: FreeBlock; size: INTEGER); (* insert block in free list *)
+ VAR i: INTEGER;
+ BEGIN
+ blk.size := size - 4; blk.tag := S.VAL(Type, S.ADR(blk.size));
+ i := MIN(N - 1, (blk.size DIV 16));
+ blk.next := free[i]; free[i] := blk
+ END Insert;
+
+ PROCEDURE Sweep (dealloc: BOOLEAN);
+ VAR cluster, last, c: Cluster; blk, next: Block; fblk, b, t: FreeBlock; end, i: INTEGER;
+ BEGIN
+ cluster := root; last := NIL; allocated := 0;
+ i := N;
+ REPEAT DEC(i); free[i] := sentinel UNTIL i = 0;
+ WHILE cluster # NIL DO
+ blk := S.VAL(Block, S.VAL(INTEGER, cluster) + 12);
+ end := S.VAL(INTEGER, blk) + (cluster.size - 12) DIV 16 * 16;
+ fblk := NIL;
+ WHILE S.VAL(INTEGER, blk) < end DO
+ next := Next(blk);
+ IF ODD(S.VAL(INTEGER, blk.tag)) THEN
+ IF fblk # NIL THEN
+ Insert(fblk, S.VAL(INTEGER, blk) - S.VAL(INTEGER, fblk));
+ fblk := NIL
+ END;
+ DEC(S.VAL(INTEGER, blk.tag)); (* unmark *)
+ INC(allocated, S.VAL(INTEGER, next) - S.VAL(INTEGER, blk))
+ ELSIF fblk = NIL THEN
+ fblk := S.VAL(FreeBlock, blk)
+ END;
+ blk := next
+ END;
+ IF dealloc & (S.VAL(INTEGER, fblk) = S.VAL(INTEGER, cluster) + 12) THEN (* deallocate cluster *)
+ c := cluster; cluster := cluster.next;
+ IF last = NIL THEN root := cluster ELSE last.next := cluster END;
+ FreeHeapMem(c)
+ ELSE
+ IF fblk # NIL THEN Insert(fblk, end - S.VAL(INTEGER, fblk)) END;
+ last := cluster; cluster := cluster.next
+ END
+ END;
+ (* reverse free list *)
+ i := N;
+ REPEAT
+ DEC(i);
+ b := free[i]; fblk := sentinel;
+ WHILE b # sentinel DO t := b; b := t.next; t.next := fblk; fblk := t END;
+ free[i] := fblk
+ UNTIL i = 0
+ END Sweep;
+
+ PROCEDURE Collect*;
+ BEGIN
+ IF root # NIL THEN
+ CallFinalizers; (* trap cleanup *)
+ MarkGlobals;
+ MarkLocals;
+ CheckFinalizers;
+ Sweep(TRUE);
+ CallFinalizers
+ END
+ END Collect;
+
+ PROCEDURE FastCollect*;
+ BEGIN
+ IF root # NIL THEN
+ MarkGlobals;
+ MarkLocals;
+ MarkFinObj;
+ Sweep(FALSE)
+ END
+ END FastCollect;
+
+ PROCEDURE WouldFinalize* (): BOOLEAN;
+ BEGIN
+ RETURN wouldFinalize
+ END WouldFinalize;
+
+ (* --------------------- memory allocation (portable) -------------------- *)
+
+ PROCEDURE OldBlock (size: INTEGER): FreeBlock; (* size MOD 16 = 0 *)
+ VAR b, l: FreeBlock; s, i: INTEGER;
+ BEGIN
+ s := size - 4;
+ i := MIN(N - 1, s DIV 16);
+ WHILE (i # N - 1) & (free[i] = sentinel) DO INC(i) END;
+ b := free[i]; l := NIL;
+ WHILE b.size < s DO l := b; b := b.next END;
+ IF b # sentinel THEN
+ IF l = NIL THEN free[i] := b.next ELSE l.next := b.next END
+ ELSE b := NIL
+ END;
+ RETURN b
+ END OldBlock;
+
+ PROCEDURE LastBlock (limit: INTEGER): FreeBlock; (* size MOD 16 = 0 *)
+ VAR b, l: FreeBlock; s, i: INTEGER;
+ BEGIN
+ s := limit - 4;
+ i := 0;
+ REPEAT
+ b := free[i]; l := NIL;
+ WHILE (b # sentinel) & (S.VAL(INTEGER, b) + b.size # s) DO l := b; b := b.next END;
+ IF b # sentinel THEN
+ IF l = NIL THEN free[i] := b.next ELSE l.next := b.next END
+ ELSE b := NIL
+ END;
+ INC(i)
+ UNTIL (b # NIL) OR (i = N);
+ RETURN b
+ END LastBlock;
+
+ PROCEDURE NewBlock (size: INTEGER): Block;
+ VAR tsize, a, s: INTEGER; b: FreeBlock; new, c: Cluster; r: Reducer;
+ BEGIN
+ ASSERT(size >= 0, 20);
+ IF size > MAX(INTEGER) - 19 THEN RETURN NIL END;
+ tsize := (size + 19) DIV 16 * 16;
+ b := OldBlock(tsize); (* 1) search for free block *)
+ IF b = NIL THEN
+ FastCollect; b := OldBlock(tsize); (* 2) collect *)
+ IF b = NIL THEN
+ Collect; b := OldBlock(tsize); (* 2a) fully collect *)
+ END;
+ IF b = NIL THEN
+ AllocHeapMem(tsize + 12, new); (* 3) allocate new cluster *)
+ IF new # NIL THEN
+ IF (root = NIL) OR (S.VAL(INTEGER, new) < S.VAL(INTEGER, root)) THEN
+ new.next := root; root := new
+ ELSE
+ c := root;
+ WHILE (c.next # NIL) & (S.VAL(INTEGER, new) > S.VAL(INTEGER, c.next)) DO c := c.next END;
+ new.next := c.next; c.next := new
+ END;
+ b := S.VAL(FreeBlock, S.VAL(INTEGER, new) + 12);
+ b.size := (new.size - 12) DIV 16 * 16 - 4
+ ELSE
+ RETURN NIL (* 4) give up *)
+ END
+ END
+ END;
+ (* b # NIL *)
+ a := b.size + 4 - tsize;
+ IF a > 0 THEN Insert(S.VAL(FreeBlock, S.VAL(INTEGER, b) + tsize), a) END;
+ IF size > 0 THEN Erase(S.ADR(b.size), (size + 3) DIV 4) END;
+ INC(allocated, tsize);
+ RETURN S.VAL(Block, b)
+ END NewBlock;
+
+ PROCEDURE Allocated* (): INTEGER;
+ BEGIN
+ RETURN allocated
+ END Allocated;
+
+ PROCEDURE Used* (): INTEGER;
+ BEGIN
+ RETURN used
+ END Used;
+
+ PROCEDURE Root* (): INTEGER;
+ BEGIN
+ RETURN S.VAL(INTEGER, root)
+ END Root;
+
+ (* -------------------- Trap Handling --------------------- *)
+
+ PROCEDURE Start* (code: Command);
+ VAR res: setjmp.int;
+ BEGIN
+ restart := code;
+ S.GETREG(SP, baseStack);
+ res := setjmp.sigsetjmp(startEnv, 1);
+ restart
+ END Start;
+
+ PROCEDURE Quit* (exitCode: INTEGER);
+ VAR m: Module; term: Command; t: BOOLEAN;
+ BEGIN
+ trapViewer := NIL; trapChecker := NIL; restart := NIL;
+ t := terminating; terminating := TRUE; m := modList;
+ WHILE m # NIL DO (* call terminators *)
+ IF ~static OR ~t THEN
+ term := m.term; m.term := NIL;
+ IF term # NIL THEN term() END
+ END;
+ m := m.next
+ END;
+ CallFinalizers;
+ hotFinalizers := finalizers; finalizers := NIL;
+ CallFinalizers;
+ stdlib.exit(exitCode)
+ END Quit;
+
+ PROCEDURE FatalError* (id: INTEGER; str: ARRAY OF CHAR);
+ VAR res: stdio.int; title: ARRAY 16 OF CHAR; text: ARRAY 256 OF SHORTCHAR;
+ BEGIN
+ title := "Error xy";
+ title[6] := CHR(id DIV 10 + ORD("0"));
+ title[7] := CHR(id MOD 10 + ORD("0"));
+ res := unistd.write(2, S.ADR(title), 8);
+ stdlib.abort
+ END FatalError;
+
+ PROCEDURE DefaultTrapViewer;
+ VAR out: ARRAY 2048 OF SHORTCHAR; a, b, c, len, ref, end: INTEGER; mod: Module;
+ modName, name: Name; n: Utf8Name; res: unistd.int;
+
+ PROCEDURE WriteString (IN s: ARRAY OF SHORTCHAR);
+ VAR i: INTEGER;
+ BEGIN
+ i := 0;
+ WHILE (len < LEN(out) - 1) & (s[i] # 0X) DO out[len] := s[i]; INC(i); INC(len) END
+ END WriteString;
+
+ PROCEDURE WriteHex (x, n: INTEGER);
+ VAR i, y: INTEGER;
+ BEGIN
+ IF len + n < LEN(out) THEN
+ i := len + n - 1;
+ WHILE i >= len DO
+ y := x MOD 16; x := x DIV 16;
+ IF y > 9 THEN y := y + (ORD("A") - ORD("0") - 10) END;
+ out[i] := SHORT(CHR(y + ORD("0"))); DEC(i)
+ END;
+ INC(len, n)
+ END
+ END WriteHex;
+
+ PROCEDURE WriteLn;
+ BEGIN
+ IF len < LEN(out) - 1 THEN out[len] := 0AX; INC(len) END
+ END WriteLn;
+
+ BEGIN
+ len := 0;
+ WriteString("====== ");
+ IF err = 129 THEN WriteString("invalid with")
+ ELSIF err = 130 THEN WriteString("invalid case")
+ ELSIF err = 131 THEN WriteString("function without return")
+ ELSIF err = 132 THEN WriteString("type guard")
+ ELSIF err = 133 THEN WriteString("implied type guard")
+ ELSIF err = 134 THEN WriteString("value out of range")
+ ELSIF err = 135 THEN WriteString("index out of range")
+ ELSIF err = 136 THEN WriteString("string too long")
+ ELSIF err = 137 THEN WriteString("stack overflow")
+ ELSIF err = 138 THEN WriteString("integer overflow")
+ ELSIF err = 139 THEN WriteString("division by zero")
+ ELSIF err = 140 THEN WriteString("infinite real result")
+ ELSIF err = 141 THEN WriteString("real underflow")
+ ELSIF err = 142 THEN WriteString("real overflow")
+ ELSIF err = 143 THEN WriteString("undefined real result")
+ ELSIF err = 144 THEN WriteString("not a number")
+ ELSIF err = 200 THEN WriteString("keyboard interrupt")
+ ELSIF err = 201 THEN WriteString("NIL dereference")
+ ELSIF err = 202 THEN WriteString("illegal instruction: ");
+ WriteHex(val, 4)
+ ELSIF err = 203 THEN WriteString("illegal memory read [ad = ");
+ WriteHex(val, 8); WriteString("]")
+ ELSIF err = 204 THEN WriteString("illegal memory write [ad = ");
+ WriteHex(val, 8); WriteString("]")
+ ELSIF err = 205 THEN WriteString("illegal execution [ad = ");
+ WriteHex(val, 8); WriteString("]")
+ ELSIF err = 257 THEN WriteString("out of memory")
+ ELSIF err = 10001H THEN WriteString("bus error")
+ ELSIF err = 10002H THEN WriteString("address error")
+ ELSIF err = 10007H THEN WriteString("fpu error")
+ ELSIF err < 0 THEN WriteString("exception #"); WriteHex(-err, 2)
+ ELSE err := err DIV 100 * 256 + err DIV 10 MOD 10 * 16 + err MOD 10;
+ WriteString("trap #"); WriteHex(err, 3)
+ END;
+ WriteString(" ======");
+ a := pc; b := fp; c := 12;
+ REPEAT
+ WriteLn; WriteString("- ");
+ mod := modList;
+ WHILE (mod # NIL) & ((a < mod.code) OR (a >= mod.code + mod.csize)) DO mod := mod.next END;
+ IF mod # NIL THEN
+ DEC(a, mod.code);
+ IF mod.refcnt >= 0 THEN
+ GetModName(mod, modName); WriteString(SHORT(modName)); ref := mod.refs;
+ REPEAT GetRefProc(ref, end, n) UNTIL (end = 0) OR (a < end);
+ IF a < end THEN
+ Utf8ToString(n, name, res); WriteString("."); WriteString(SHORT(name))
+ END
+ ELSE
+ GetModName(mod, modName); WriteString("("); WriteString(SHORT(modName)); WriteString(")")
+ END;
+ WriteString(" ")
+ END;
+ WriteString("(pc="); WriteHex(a, 8);
+ WriteString(", fp="); WriteHex(b, 8); WriteString(")");
+ IF (b >= sp) & (b < stack) THEN
+ S.GET(b+4, a); (* stacked pc *)
+ S.GET(b, b); (* dynamic link *)
+ DEC(c)
+ ELSE c := 0
+ END
+ UNTIL c = 0;
+ out[len] := 0X;
+ res := unistd.write(2, S.ADR(out), len)
+ END DefaultTrapViewer;
+
+ PROCEDURE TrapCleanup;
+ VAR t: TrapCleaner;
+ BEGIN
+ WHILE trapStack # NIL DO
+ t := trapStack; trapStack := trapStack.next; t.Cleanup
+ END;
+ IF (trapChecker # NIL) & (err # 128) THEN trapChecker END
+ END TrapCleanup;
+
+ PROCEDURE SetTrapGuard* (on: BOOLEAN);
+ BEGIN
+ guarded := on
+ END SetTrapGuard;
+
+ PROCEDURE Try* (h: TryHandler; a, b, c: INTEGER);
+ VAR oldIsTry: BOOLEAN; oldTryEnv: setjmp.jmp_buf; res: setjmp.int;
+ BEGIN
+ oldIsTry := isTry; oldTryEnv := tryEnv;
+ isTry := TRUE;
+ res := setjmp._setjmp(tryEnv);
+ IF res = 0 THEN h(a, b, c) END;
+ isTry := oldIsTry; tryEnv := oldTryEnv
+ END Try;
+
+ PROCEDURE Trap* (n: INTEGER);
+ BEGIN
+ IF trapped THEN
+ DefaultTrapViewer;
+ IF ~secondTrap THEN trapped := FALSE; secondTrap := TRUE END
+ END;
+ IF n >= 0 THEN err := n
+ ELSE err := -n + 128
+ END;
+ pc := 0; sp := 0; fp := 0; stack := 0; val := 0;
+ INC(trapCount);
+ (* !!! InitFPU *)
+ TrapCleanup;
+ IF isTry THEN
+ setjmp._longjmp(tryEnv, 1)
+ END;
+ IF err = 128 THEN (* do nothing *)
+ ELSIF (trapViewer # NIL) & (restart # NIL) & ~trapped & ~guarded THEN
+ trapped := TRUE; trapViewer()
+ ELSE DefaultTrapViewer
+ END;
+ trapped := FALSE; secondTrap := FALSE;
+ IF restart # NIL THEN
+ setjmp.siglongjmp(startEnv, 1)
+ END;
+ stdlib.abort
+ END Trap;
+
+ PROCEDURE [ccall] TrapHandler (signo: signal.int; IN info: signal.siginfo_t; context: ADDRESS);
+ VAR res: signal.int;
+ BEGIN
+ IF trapped THEN
+ DefaultTrapViewer;
+ IF ~secondTrap THEN trapped := FALSE; secondTrap := TRUE END
+ END;
+ err := -signo; pc := 0; sp := 0; fp := 0; stack := baseStack; val := 0;
+ CASE signo OF
+ | signal.SIGFPE:
+ val := info.si_code;
+ pc := info.info.sigfpe.si_addr;
+ CASE info.si_code OF
+ | signal.FPE_INTDIV: err := 139 (* division by zero *)
+ | signal.FPE_INTOVF: err := 138 (* integer overflow *)
+ | signal.FPE_FLTDIV: err := 140 (* fpu: division by zero *)
+ | signal.FPE_FLTOVF: err := 142 (* fpu: overflow *)
+ | signal.FPE_FLTUND: err := 141 (* fpu: underflow *)
+ (* !!! | signal.FPE_FLTRES: err := ??? (* fpu: *) *)
+ | signal.FPE_FLTINV: err := 143 (* val := opcode *) (* fpu: invalid op *)
+ (* !!! | signal.FPE_FLTSUB: err := ??? (* fpu: *) *)
+ ELSE (* unknown *)
+ END
+ | signal.SIGINT:
+ val := info.si_code;
+ err := 200 (* keyboard interrupt *)
+ | signal.SIGSEGV:
+ val := info.info.sigsegv.si_addr;
+ err := 203 (* illigal read *)
+ | signal.SIGBUS:
+ val := info.info.sigbus.si_addr;
+ err := 10001H (* bus error *)
+ | signal.SIGILL:
+ pc := info.info.sigill.si_addr;
+ err := 202; (* illigal instruction *)
+ IF IsReadable(pc, pc + 4) THEN
+ S.GET(pc, val)
+ (* !!! err := halt code *)
+ END;
+ ELSE (* unknown *)
+ END;
+ INC(trapCount);
+ (* !!! InitFPU *)
+ TrapCleanup;
+ IF isTry THEN
+ setjmp._longjmp(tryEnv, 1)
+ END;
+ IF err = 128 THEN (* do nothing *)
+ ELSIF (trapViewer # NIL) & (restart # NIL) & ~trapped & ~guarded THEN
+ trapped := TRUE; trapViewer()
+ ELSE DefaultTrapViewer
+ END;
+ trapped := FALSE; secondTrap := FALSE;
+ IF restart # NIL THEN
+ setjmp.siglongjmp(startEnv, 1)
+ END;
+ stdlib.abort
+ END TrapHandler;
+
+ (* -------------------- Initialization --------------------- *)
+
+ PROCEDURE InstallTrap (signo: signal.int);
+ VAR act: signal.struct_sigaction; res: signal.int;
+ BEGIN
+ act.handler.sa_handler := NIL;
+ res := signal.sigemptyset(act.sa_mask);
+ act.sa_flags := signal.SA_NODEFER + signal.SA_SIGINFO;
+ act.handler.sa_sigaction := TrapHandler;
+ res := signal.sigaction(signo, act, NIL);
+ END InstallTrap;
+
+ PROCEDURE InstallTrapVectors;
+ BEGIN
+ InstallTrap(signal.SIGFPE);
+ InstallTrap(signal.SIGINT);
+ InstallTrap(signal.SIGSEGV);
+ InstallTrap(signal.SIGBUS);
+ InstallTrap(signal.SIGILL)
+ END InstallTrapVectors;
+
+ PROCEDURE RemoveTrapVectors;
+ END RemoveTrapVectors;
+
+ PROCEDURE Init;
+ VAR i: INTEGER;
+ BEGIN
+ pagesize := unistd.sysconf(unistd._SC_PAGESIZE);
+
+ (* init heap *)
+ allocated := 0; total := 0; used := 0;
+ sentinelBlock.size := MAX(INTEGER);
+ sentinel := S.ADR(sentinelBlock);
+ i := N;
+ REPEAT DEC(i); free[i] := sentinel UNTIL i = 0;
+
+ IF ~inDll THEN
+ InstallTrapVectors
+ END;
+
+ (* !!! InitFPU *)
+ IF ~static THEN
+ InitModule(modList);
+ IF ~inDll THEN Quit(1) END
+ END
+ END Init;
+
+BEGIN
+ IF modList = NIL THEN (* only once *)
+ S.GETREG(SP, baseStack);
+ S.GET(baseStack + 16, argc);
+ argv := S.VAL(ArrStrPtr, baseStack + 20);
+ S.GETREG(ML, modList); (* linker loads module list to BX *)
+ static := init IN modList.opts;
+ inDll := dll IN modList.opts;
+ Init
+ END
+CLOSE
+ IF ~terminating THEN
+ terminating := TRUE;
+ Quit(0)
+ END
+END Kernel.
diff --git a/src/posix/Host/Mod/Console.cp b/src/posix/Host/Mod/Console.cp
--- /dev/null
@@ -0,0 +1,41 @@
+MODULE HostConsole;
+
+ IMPORT S := SYSTEM, Console, HostLang, unistd := C99unistd;
+
+ TYPE
+ Directory = POINTER TO RECORD (Console.Directory) END;
+
+ PROCEDURE (d: Directory) WriteChar (ch: CHAR);
+ VAR res: INTEGER; s: ARRAY 2 OF CHAR; ss: ARRAY 12 OF SHORTCHAR;
+ BEGIN
+ s[0] := ch; s[1] := 0X;
+ HostLang.StringToHost(s, ss, TRUE, res);
+ ASSERT(res = 0, 100);
+ res := unistd.write(1, S.ADR(ss[0]), LEN(ss$));
+ res := unistd.fsync(1)
+ END WriteChar;
+
+ PROCEDURE (d: Directory) WriteString (IN s: ARRAY OF CHAR);
+ VAR ss: POINTER TO ARRAY OF SHORTCHAR; res: INTEGER;
+ BEGIN
+ NEW(ss, LEN(s$) * 4 + 1);
+ HostLang.StringToHost(s, ss, TRUE, res);
+ ASSERT(res = 0, 100);
+ res := unistd.write(1, S.ADR(ss[0]), LEN(ss$));
+ res := unistd.fsync(1)
+ END WriteString;
+
+ PROCEDURE (d: Directory) WriteLn;
+ BEGIN
+ d.WriteChar(0AX)
+ END WriteLn;
+
+ PROCEDURE Init;
+ VAR d: Directory;
+ BEGIN
+ NEW(d); Console.SetDir(d)
+ END Init;
+
+BEGIN
+ Init
+END HostConsole.
diff --git a/src/posix/Host/Mod/Dates.cp b/src/posix/Host/Mod/Dates.cp
--- /dev/null
@@ -0,0 +1,142 @@
+MODULE HostDates;
+
+ IMPORT Dates, Strings, time := C99time;
+
+ (* add localization? *)
+
+ TYPE
+ Hook = POINTER TO RECORD (Dates.Hook) END;
+
+ VAR
+ day: ARRAY 7, 10 OF CHAR;
+ month: ARRAY 12, 10 OF CHAR;
+
+ PROCEDURE (h: Hook) GetTime (OUT d: Dates.Date; OUT t: Dates.Time);
+ VAR epoch: time.time_t; tm: time.struct_tm; ptm: time.Pstruct_tm;
+ BEGIN
+ epoch := time.time(NIL);
+ ptm := time.localtime_r(epoch, tm);
+ IF ptm # NIL THEN
+ d.year := tm.tm_year + 1900;
+ d.month := tm.tm_mon + 1;
+ d.day := tm.tm_mday;
+ t.hour := tm.tm_hour;
+ t.minute := tm.tm_min;
+ t.second := tm.tm_sec
+ ELSE
+ d.year := 0;
+ d.month := 0;
+ d.day := 0;
+ t.hour := 0;
+ t.minute := 0;
+ t.second := 0
+ END
+ END GetTime;
+
+ PROCEDURE (h: Hook) GetUTCTime (OUT d: Dates.Date; OUT t: Dates.Time);
+ VAR epoch: time.time_t; tm: time.struct_tm; ptm: time.Pstruct_tm;
+ BEGIN
+ epoch := time.time(NIL);
+ ptm := time.gmtime_r(epoch, tm);
+ IF ptm # NIL THEN
+ d.year := tm.tm_year + 1900;
+ d.month := tm.tm_mon + 1;
+ d.day := tm.tm_mday;
+ t.hour := tm.tm_hour;
+ t.minute := tm.tm_min;
+ t.second := tm.tm_sec
+ ELSE
+ d.year := 0;
+ d.month := 0;
+ d.day := 0;
+ t.hour := 0;
+ t.minute := 0;
+ t.second := 0
+ END
+ END GetUTCTime;
+
+ PROCEDURE (h: Hook) GetUTCBias (OUT bias: INTEGER);
+ BEGIN
+ time.tzset;
+ (* !!! fix Dev2 *)
+ (* bias := time.timezone DIV 60 *)
+ bias := 0;
+ END GetUTCBias;
+
+ PROCEDURE (h: Hook) DateToString (d: Dates.Date; format: INTEGER; OUT str: ARRAY OF CHAR);
+ VAR s: ARRAY 20 OF CHAR;
+
+ PROCEDURE Copy (IN s: ARRAY OF CHAR; n: INTEGER; OUT str: ARRAY OF CHAR);
+ VAR i: INTEGER;
+ BEGIN
+ FOR i := 0 TO n - 1 DO
+ str[i] := s[i]
+ END;
+ str[i] := 0X
+ END Copy;
+
+ BEGIN
+ CASE format OF
+ | Dates.short:
+ str[0] := CHR(d.day DIV 10 MOD 10 + ORD("0"));
+ str[1] := CHR(d.day MOD 10 + ORD("0"));
+ str[2] := "/";
+ str[3] := CHR(d.month DIV 10 MOD 10 + ORD("0"));
+ str[4] := CHR(d.month MOD 10 + ORD("0"));
+ str[5] := "/";
+ str[6] := CHR(d.year DIV 10 MOD 10 + ORD("0"));
+ str[7] := CHR(d.year MOD 10 + ORD("0"));
+ str[8] := 0X
+ | Dates.abbreviated:
+ Copy(day[d.day - 1], 3, str);
+ Copy(month[d.month - 1], 3, s); str := str + ", " + s;
+ Strings.IntToString(d.year, s); str := str + ", " + s
+ | Dates.long:
+ str := day[d.day - 1] + ", " + month[d.month - 1];
+ Strings.IntToString(d.year, s); str := str + ", " + s
+ | Dates.plainAbbreviated:
+ Copy(month[d.month - 1], 3, str);
+ Strings.IntToString(d.day, s); str := str + " " + s;
+ Strings.IntToString(d.year, s); str := str + ", " + s
+ | Dates.plainLong:
+ Strings.IntToString(d.day, s); str := month[d.month - 1] + " " + s;
+ Strings.IntToString(d.year, s); str := str + ", " + s
+ END
+ END DateToString;
+
+ PROCEDURE (h: Hook) TimeToString (t: Dates.Time; OUT str: ARRAY OF CHAR);
+ VAR s: ARRAY 12 OF CHAR;
+ BEGIN
+ Strings.IntToString(t.hour, str);
+ Strings.IntToString(t.minute, s); str := str + ":" + s;
+ Strings.IntToString(t.second, s); str := str + ":" + s;
+ END TimeToString;
+
+ PROCEDURE Init;
+ VAR h: Hook;
+ BEGIN
+ day[0] := "Monday";
+ day[1] := "Tuesday";
+ day[2] := "Wednesday";
+ day[3] := "Thursday";
+ day[4] := "Friday";
+ day[5] := "Saturday";
+ day[6] := "Sunday";
+ month[0] := "January";
+ month[1] := "February";
+ month[2] := "March";
+ month[3] := "April";
+ month[4] := "May";
+ month[5] := "June";
+ month[6] := "July";
+ month[7] := "August";
+ month[8] := "September";
+ month[9] := "October";
+ month[10] := "November";
+ month[11] := "December";
+ NEW(h); Dates.SetHook(h)
+ END Init;
+
+BEGIN
+ Init
+END HostDates.
diff --git a/src/posix/Host/Mod/Files.cp b/src/posix/Host/Mod/Files.cp
--- /dev/null
@@ -0,0 +1,757 @@
+MODULE HostFiles;
+
+ IMPORT S := SYSTEM, Kernel, HostLang, Files, Log, stdlib := C99stdlib,
+ unistd := C99unistd, dirent := C99dirent, fcntl := C99fcntl,
+ sysstat := C99sys_stat, stdio := C99stdio, errno := C99errno,
+ macro := C99macro, libgen := C99libgen, time := C99time;
+
+ (* !!! add buffer cache *)
+
+ CONST
+ closed = 0; new = 1; temp = 2; shared = 3; exclusive = 4;
+
+ TYPE
+ FullName* = Files.Name;
+ NativeName* = ARRAY 1024 OF SHORTCHAR;
+
+ Locator = POINTER TO RECORD (Files.Locator)
+ path-: FullName (* pathname # "" *)
+ END;
+
+ Directory = POINTER TO RECORD (Files.Directory) END;
+
+ File = POINTER TO RECORD (Files.File)
+ state: INTEGER;
+ len: INTEGER;
+ fd: unistd.int;
+ ino: sysstat.ino_t;
+ pathname: FullName
+ END;
+
+ Reader = POINTER TO RECORD (Files.Reader)
+ f: File;
+ pos: INTEGER
+ END;
+
+ Writer = POINTER TO RECORD (Files.Writer)
+ f: File;
+ pos: INTEGER
+ END;
+
+ InodeIdentifier = RECORD (Kernel.Identifier)
+ ino: sysstat.ino_t
+ END;
+
+ VAR
+ ignoreAsk-: BOOLEAN;
+ root: Locator;
+
+ PROCEDURE (VAR id: InodeIdentifier) Identified (): BOOLEAN;
+ VAR f: File;
+ BEGIN
+ f := id.obj(File);
+ RETURN (f.state # closed) & (f.ino = id.ino)
+ END Identified;
+
+ PROCEDURE GetFileByInode (ino: sysstat.ino_t): File;
+ VAR id: InodeIdentifier; obj: ANYPTR; f: File;
+ BEGIN
+ ASSERT(ino # 0, 20);
+ id.typ := S.TYP(File);
+ id.ino := ino;
+ obj := Kernel.ThisFinObj(id);
+ IF obj # NIL THEN f := obj(File)
+ ELSE f := NIL
+ END;
+ RETURN f
+ END GetFileByInode;
+
+ PROCEDURE GetError (OUT res: INTEGER);
+ VAR err: INTEGER;
+ BEGIN
+ err := macro.errno();
+ CASE err OF
+ | errno.ENAMETOOLONG, errno.ENOTDIR: res := 1 (* invalid name/location *)
+ | errno.ENOENT: res := 2 (* file/dir not found *)
+ | errno.EEXIST: res := 3 (* file/dir already exists *)
+ | errno.EROFS: res := 4 (* write-protection *)
+ | errno.EIO: res := 5 (* io error *)
+ | errno.EACCES, errno.EPERM: res := 6 (* access denied *)
+ | errno.ENOMEM: res := 80 (* not enough memory *)
+ | errno.ENFILE, errno.ENOBUFS, errno.ENOSPC: res := 81 (* not enough system resources *)
+ ELSE res := -err
+ END
+ END GetError;
+
+ (* Locator *)
+
+ PROCEDURE NewLocator* (IN path: ARRAY OF CHAR): Locator;
+ VAR l: Locator; ch: SHORTCHAR;
+ BEGIN
+ NEW(l);
+ IF path = "" THEN l.path := "."
+ ELSE l.path := path$
+ END;
+ RETURN l
+ END NewLocator;
+
+ PROCEDURE (l: Locator) This (IN path: ARRAY OF CHAR): Locator;
+ VAR loc: Locator;
+ BEGIN
+ IF path = "" THEN NEW(loc); loc^ := l^
+ ELSIF path[0] = "/" THEN loc := NewLocator(path)
+ ELSE loc := NewLocator(l.path + "/" + path)
+ END;
+ RETURN loc
+ END This;
+
+ (* File *)
+
+ PROCEDURE (f: File) Length (): INTEGER;
+ BEGIN
+ RETURN f.len
+ END Length;
+
+ PROCEDURE (f: File) NewReader (old: Files.Reader): Reader;
+ VAR r: Reader;
+ BEGIN
+ ASSERT(f.state # closed, 20);
+ IF (old # NIL) & (old.Base() = f) THEN
+ r := old(Reader);
+ IF r.pos > f.len THEN r.pos := 0 END;
+ r.eof := FALSE
+ ELSE NEW(r); r.f := f; r.pos := 0
+ END;
+ RETURN r
+ END NewReader;
+
+ PROCEDURE (f: File) NewWriter (old: Files.Writer): Writer;
+ VAR w: Writer;
+ BEGIN
+ ASSERT(f.state # closed, 20);
+ ASSERT(f.state # shared, 21);
+ IF (old # NIL) & (old.Base() = f) THEN
+ w := old(Writer);
+ IF w.pos > f.len THEN w.pos := 0 END
+ ELSE NEW(w); w.f := f; w.pos := 0
+ END;
+ RETURN w
+ END NewWriter;
+
+ PROCEDURE (f: File) Flush;
+ VAR res: unistd.int;
+ BEGIN
+ IF f.state # closed THEN
+ res := unistd.fsync(f.fd);
+ ASSERT(res = 0, 100)
+ END
+ END Flush;
+
+ PROCEDURE IsName (IN name: Files.Name): BOOLEAN;
+ VAR i: INTEGER;
+ BEGIN
+ i := 0;
+ WHILE (name[i] # "/") & (name[i] # 0X) DO INC(i) END;
+ RETURN name[i] = 0X
+ END IsName;
+
+ PROCEDURE DirName (VAR path: ARRAY OF CHAR);
+ VAR i, j, k: INTEGER;
+ BEGIN
+ IF path[0] = "/" THEN i := 1; j := 1; k := 1
+ ELSE i := 0; j := 0; k := 0
+ END;
+ WHILE path[i] # 0X DO
+ IF path[i] = "/" THEN
+ k := j; j := i; INC(i);
+ WHILE (path[i] # 0X) & (path[i] = "/") DO INC(i) END;
+ IF path[i] = 0X THEN j := k END
+ ELSE
+ INC(i)
+ END
+ END;
+ path[j] := 0X
+ END DirName;
+
+ PROCEDURE (f: File) Register (name: Files.Name; type: Files.Type; ask: BOOLEAN; OUT res: INTEGER);
+ VAR i, err: INTEGER; dir: FullName; p0, p1: NativeName; s: sysstat.struct_stat; x: unistd.int;
+ BEGIN
+ ASSERT(f.state = new, 20);
+ ASSERT(name # "", 21);
+ ASSERT(IsName(name), 22);
+ HostLang.StringToHost(f.pathname, p0, FALSE, err);
+ IF err = 0 THEN
+ dir := f.pathname$;
+ DirName(dir);
+ HostLang.StringToHost(dir + "/" + name, p1, FALSE, err);
+ IF err = 0 THEN
+ x := stdio.rename(p0, p1);
+ IF x = 0 THEN res := 0 (* no error *)
+ ELSE GetError(res)
+ END;
+ f.state := exclusive;
+ f.Close
+ ELSE
+ res := 1 (* invalid name (too long?) *)
+ END
+ ELSE
+ res := 1 (* invalid name (too long?) *)
+ END
+ END Register;
+
+ PROCEDURE (f: File) Close;
+ VAR res: unistd.int; path: NativeName; err: INTEGER;
+ BEGIN
+ IF f.state # closed THEN
+ f.Flush;
+ IF f.state = new THEN
+ HostLang.StringToHost(f.pathname, path, FALSE, err);
+ ASSERT(err = 0, 100);
+ res := unistd.unlink(path);
+ ASSERT(res = 0, 101);
+ f.state := temp
+ END;
+ res := unistd.close(f.fd);
+ ASSERT(res = 0, 102);
+ f.state := closed
+ END
+ END Close;
+
+ PROCEDURE (f: File) Closed (): BOOLEAN;
+ BEGIN
+ RETURN f.state = closed
+ END Closed;
+
+ PROCEDURE (f: File) Shared (): BOOLEAN;
+ BEGIN
+ RETURN f.state = shared
+ END Shared;
+
+ PROCEDURE (f: File) FINALIZE;
+ BEGIN
+ f.Close
+ END FINALIZE;
+
+ (* Reader *)
+
+ PROCEDURE (r: Reader) Base (): File;
+ BEGIN
+ RETURN r.f
+ END Base;
+
+ PROCEDURE (r: Reader) Pos (): INTEGER;
+ BEGIN
+ RETURN r.pos
+ END Pos;
+
+ PROCEDURE (r: Reader) SetPos (pos: INTEGER);
+ BEGIN
+ ASSERT(pos >= 0, 20);
+ ASSERT(pos <= r.f.len, 21);
+ r.pos := pos;
+ r.eof := FALSE
+ END SetPos;
+
+ PROCEDURE (r: Reader) ReadByte (OUT x: BYTE);
+ VAR res: unistd.int; offset: unistd.off_t;
+ BEGIN
+ ASSERT(r.f.state # closed, 20);
+ offset := unistd.lseek(r.f.fd, r.pos, unistd.SEEK_SET);
+ ASSERT(offset = r.pos, 100);
+ res := unistd.read(r.f.fd, S.ADR(x), 1);
+ ASSERT(res # -1, 101);
+ IF res = 0 THEN x := 0 END;
+ r.pos := r.pos + res;
+ r.eof := res = 0
+ END ReadByte;
+
+ PROCEDURE (r: Reader) ReadBytes (VAR x: ARRAY OF BYTE; beg, len: INTEGER);
+ VAR res: unistd.int; offset: unistd.off_t;
+ BEGIN
+ ASSERT(beg >= 0, 20);
+ ASSERT(len >= 0, 2);
+ ASSERT(beg + len <= LEN(x), 22);
+ ASSERT(r.f.state # closed, 23);
+ offset := unistd.lseek(r.f.fd, r.pos, unistd.SEEK_SET);
+ ASSERT(offset = r.pos, 100);
+ res := unistd.read(r.f.fd, S.ADR(x[beg]), len);
+ ASSERT(res # -1, 101);
+ r.pos := r.pos + res;
+ r.eof := res = 0
+ END ReadBytes;
+
+ (* Writer *)
+
+ PROCEDURE (w: Writer) Base (): File;
+ BEGIN
+ RETURN w.f
+ END Base;
+
+ PROCEDURE (w: Writer) Pos (): INTEGER;
+ BEGIN
+ RETURN w.pos
+ END Pos;
+
+ PROCEDURE (w: Writer) SetPos (pos: INTEGER);
+ BEGIN
+ ASSERT(pos >= 0, 20);
+ ASSERT(pos <= w.f.len, 21);
+ w.pos := pos
+ END SetPos;
+
+ PROCEDURE (w: Writer) WriteByte (x: BYTE);
+ VAR res: unistd.int; offset: unistd.off_t;
+ BEGIN
+ ASSERT(w.f.state # closed, 20);
+ offset := unistd.lseek(w.f.fd, w.pos, unistd.SEEK_SET);
+ ASSERT(offset = w.pos, 100);
+ res := unistd.write(w.f.fd, S.ADR(x), 1);
+ ASSERT(res # -1, 101);
+ w.pos := w.pos + res;
+ w.f.len := MAX(w.f.len, w.pos);
+ ASSERT(res = 1, 60)
+ END WriteByte;
+
+ PROCEDURE (w: Writer) WriteBytes (IN x: ARRAY OF BYTE; beg, len: INTEGER);
+ VAR res: unistd.int; offset: unistd.off_t;
+ BEGIN
+ ASSERT(beg >= 0, 20);
+ ASSERT(len >= 0, 21);
+ ASSERT(beg + len <= LEN(x), 22);
+ ASSERT(w.f.state # closed, 23);
+ offset := unistd.lseek(w.f.fd, w.pos, unistd.SEEK_SET);
+ ASSERT(offset = w.pos, 100);
+ res := unistd.write(w.f.fd, S.ADR(x[beg]), len);
+ ASSERT(res # -1, 101);
+ w.pos := w.pos + res;
+ w.f.len := MAX(w.f.len, w.pos);
+ ASSERT(res = len, 60)
+ END WriteBytes;
+
+ (* Directory *)
+
+ PROCEDURE (d: Directory) This (IN path: ARRAY OF CHAR): Locator;
+ BEGIN
+ RETURN root.This(path)
+ END This;
+
+ PROCEDURE MakeDir (path: ARRAY OF SHORTCHAR; OUT res: unistd.int);
+ VAR i: INTEGER; sep: BOOLEAN; err: unistd.int; s: sysstat.struct_stat; mode: sysstat.mode_t;
+ BEGIN
+ i := 0; err := 0;
+ mode := ORD(BITS(511(*a=rwx*)) - BITS(sysstat.umask(0)));
+ WHILE (err = 0) & (path[i] # 0X) DO
+ WHILE (path[i] # "/") & (path[i] # 0X) DO INC(i) END;
+ sep := path[i] = "/";
+ IF sep THEN path[i] := 0X END;
+ err := sysstat.mkdir(path, mode);
+ IF err = -1 THEN
+ GetError(err);
+ IF err = 3 THEN
+ (* already exists, continue make dirs *)
+ err := 0
+ END
+ END;
+ IF sep THEN path[i] := "/" END;
+ INC(i)
+ END;
+ res := err
+ END MakeDir;
+
+ PROCEDURE (d: Directory) New (loc: Files.Locator; ask: BOOLEAN): File;
+ VAR err: INTEGER; f: File; s: sysstat.struct_stat; fd, res: unistd.int; pathname: NativeName;
+ BEGIN
+ ASSERT(loc # NIL, 20);
+ WITH loc: Locator DO
+ HostLang.StringToHost(loc.path, pathname, FALSE, err);
+ IF err = 0 THEN
+ MakeDir(pathname, res);
+ IF res = 0 THEN
+ (* use fcntl.open() with O_TMPFILE for Linux 3.11+? *)
+ pathname := pathname + "/" + ".newXXXXXX";
+ fd := stdlib.mkstemp(pathname);
+ IF fd # -1 THEN
+ NEW(f); HostLang.HostToString(pathname, f.pathname, FALSE, err);
+ IF err = 0 THEN
+ (* !!! get valid inode? *)
+ f.fd := fd; f.len := 0; f.state := new; f.ino := 0;
+ loc.res := 0 (* no errors *)
+ ELSE
+ f := NIL;
+ res := unistd.close(fd);
+ ASSERT(res = 0, 100);
+ res := unistd.unlink(pathname);
+ ASSERT(res = 0, 101);
+ loc.res := 1 (* invalid name *)
+ END
+ ELSE
+ GetError(loc.res)
+ END
+ ELSE
+ loc.res := res
+ END
+ ELSE
+ loc.res := 1 (* invalid name *)
+ END
+ ELSE
+ loc.res := 1 (* invalid locator *)
+ END;
+ RETURN f
+ END New;
+
+ PROCEDURE IsRegFile (IN s: sysstat.struct_stat): BOOLEAN;
+ BEGIN
+ RETURN BITS(s.st_mode) * BITS(sysstat.S_IFMT) = BITS(sysstat.S_IFREG)
+ END IsRegFile;
+
+ PROCEDURE (d: Directory) Old (loc: Files.Locator; name: Files.Name; isShared: BOOLEAN): File;
+ CONST rwrwrw = 438;
+ VAR err: INTEGER; f, if: File; s: sysstat.struct_stat; fd, flags, res: unistd.int;
+ pathname: NativeName; mode: sysstat.mode_t; lock: fcntl.struct_flock;
+
+ PROCEDURE Cleanup;
+ BEGIN
+ f := NIL;
+ res := unistd.close(fd);
+ ASSERT(res = 0, 100)
+ END Cleanup;
+
+ BEGIN
+ ASSERT(loc # NIL, 20);
+ ASSERT(name # "", 21);
+ WITH loc: Locator DO
+ IF IsName(name) THEN
+ HostLang.StringToHost(loc.path + "/" + name, pathname, FALSE, err);
+ IF err = 0 THEN
+ res := macro.stat(pathname, s);
+ IF res = 0 THEN
+ IF IsRegFile(s) THEN
+ if := GetFileByInode(s.st_ino);
+ IF (if = NIL) OR isShared & (if.state = shared) THEN
+ mode := ORD(BITS(rwrwrw) - BITS(sysstat.umask(0)));
+ IF isShared THEN flags := fcntl.O_RDONLY
+ ELSE flags := fcntl.O_RDWR
+ END;
+ fd := fcntl.open(pathname, flags, mode);
+ IF fd # -1 THEN
+ IF isShared THEN lock.l_type := fcntl.F_RDLCK
+ ELSE lock.l_type := fcntl.F_WRLCK
+ END;
+ lock.l_whence := unistd.SEEK_SET;
+ lock.l_start := 0;
+ lock.l_len := 0;
+ lock.l_pid := 0;
+ res := fcntl.fcntl(fd, fcntl.F_SETLK, S.ADR(lock));
+ IF res # -1 THEN
+ NEW(f); HostLang.HostToString(pathname, f.pathname, FALSE, err);
+ IF err = 0 THEN
+ f.fd := fd; f.len := s.st_size; f.ino := s.st_ino;
+ IF isShared THEN f.state := shared
+ ELSE f.state := exclusive
+ END;
+ loc.res := 0 (* no errors *)
+ ELSE
+ loc.res := 1; (* invalid name *)
+ Cleanup
+ END
+ ELSE
+ GetError(loc.res); (* already locked *)
+ Cleanup
+ END
+ ELSE
+ GetError(loc.res) (* failed to open *)
+ END
+ ELSE
+ loc.res := 6 (* already opened / locked *)
+ END
+ ELSE
+ loc.res := 6 (* access denied (not a regular file) *)
+ END
+ ELSE
+ loc.res := 2 (* file not found *)
+ END
+ ELSE
+ loc.res := 1 (* invalid name *)
+ END
+ ELSE
+ loc.res := 1 (* invalid name *)
+ END
+ ELSE
+ loc.res := 1 (* invalid locator *)
+ END;
+ RETURN f
+ END Old;
+
+ PROCEDURE (d: Directory) Temp (): File;
+ VAR f: File; fd: unistd.int; name: ARRAY 12 OF SHORTCHAR;
+ BEGIN
+ (* use fcntl.open() with O_TMPFILE for Linux 3.11+? *)
+ name := ".tmpXXXXXX";
+ fd := stdlib.mkstemp(name);
+ ASSERT(fd # -1, 100);
+ (* !!! get pathname and unlink it here *)
+ NEW(f); f.fd := fd; f.pathname := ""; f.len := 0; f.ino := 0; f.state := temp;
+ RETURN f
+ END Temp;
+
+ PROCEDURE (d: Directory) Delete (loc: Files.Locator; name: Files.Name);
+ VAR pathname: NativeName; err: INTEGER; res: unistd.int;
+ BEGIN
+ ASSERT(loc # NIL, 20);
+ ASSERT(IsName(name), 21);
+ WITH loc: Locator DO
+ IF IsName(name) THEN
+ HostLang.StringToHost(loc.path + "/" + name, pathname, FALSE, err);
+ IF err = 0 THEN
+ res := unistd.unlink(pathname);
+ IF res = 0 THEN loc.res := 0 (* no error *)
+ ELSE GetError(loc.res)
+ END
+ ELSE
+ loc.res := 1 (* invalid name *)
+ END
+ ELSE
+ loc.res := 1 (* invalid name *)
+ END
+ ELSE
+ loc.res := 1 (* invalid locator *)
+ END
+ END Delete;
+
+ PROCEDURE (d: Directory) Rename (loc: Files.Locator; old, new: Files.Name; ask: BOOLEAN);
+ VAR p0, p1: NativeName; res: stdio.int; err: INTEGER;
+ BEGIN
+ ASSERT(loc # NIL, 20);
+ ASSERT(old # "", 21);
+ ASSERT(new # "", 22);
+ WITH loc: Locator DO
+ IF IsName(old) & IsName(new) THEN
+ HostLang.StringToHost(loc.path + "/" + old, p0, FALSE, err);
+ IF err = 0 THEN
+ HostLang.StringToHost(loc.path + "/" + new, p1, FALSE, err);
+ IF err = 0 THEN
+ res := stdio.rename(p0, p1);
+ IF res = 0 THEN loc.res := 0 (* no error *)
+ ELSE GetError(loc.res)
+ END
+ ELSE
+ loc.res := 1 (* invalid name *)
+ END
+ ELSE
+ loc.res := 1 (* invalid name *)
+ END
+ ELSE
+ loc.res := 1 (* invalid name *)
+ END
+ ELSE
+ loc.res := 1 (* invalid locator *)
+ END
+ END Rename;
+
+ PROCEDURE (d: Directory) SameFile (loc0: Files.Locator; name0: Files.Name; loc1: Files.Locator; name1: Files.Name): BOOLEAN;
+ VAR ok: BOOLEAN; a0, a1: NativeName; s0, s1: sysstat.struct_stat; err: INTEGER;
+ BEGIN
+ ASSERT(loc0 # NIL, 20);
+ ASSERT(name0 # "", 21);
+ ASSERT(loc1 # NIL, 22);
+ ASSERT(name1 # "", 23);
+ ok := FALSE;
+ WITH loc0: Locator DO
+ WITH loc1: Locator DO
+ IF IsName(name0) & IsName(name1) THEN
+ HostLang.StringToHost(loc0.path + "/" + name0, a0, FALSE, err);
+ IF err = 0 THEN
+ err := macro.stat(a0, s0);
+ IF err = 0 THEN
+ HostLang.StringToHost(loc1.path + "/" + name1, a1, FALSE, err);
+ IF err = 0 THEN
+ err := macro.stat(a1, s1);
+ IF err = 0 THEN
+ ok := s0.st_ino = s1.st_ino
+ END
+ END
+ END
+ END
+ END
+ ELSE (* don't trap *)
+ END
+ ELSE (* don't trap *)
+ END;
+ RETURN ok
+ END SameFile;
+
+ PROCEDURE IsDir (IN s: sysstat.struct_stat): BOOLEAN;
+ BEGIN
+ RETURN BITS(s.st_mode) * BITS(sysstat.S_IFMT) = BITS(sysstat.S_IFDIR)
+ END IsDir;
+
+ PROCEDURE GetAttr (IN path: NativeName; IN name: FullName; s: sysstat.struct_stat): SET;
+ VAR attr: SET;
+ BEGIN
+ attr := {};
+ IF name[0] = "." THEN INCL(attr, Files.hidden) END;
+ IF BITS(s.st_mode) * BITS(sysstat.S_IXOTH) # {} THEN INCL(attr, 16) END;
+ IF BITS(s.st_mode) * BITS(sysstat.S_IWOTH) # {} THEN INCL(attr, 17) END;
+ IF BITS(s.st_mode) * BITS(sysstat.S_IROTH) # {} THEN INCL(attr, 18) END;
+ IF BITS(s.st_mode) * BITS(sysstat.S_IXGRP) # {} THEN INCL(attr, 19) END;
+ IF BITS(s.st_mode) * BITS(sysstat.S_IWGRP) # {} THEN INCL(attr, 20) END;
+ IF BITS(s.st_mode) * BITS(sysstat.S_IRGRP) # {} THEN INCL(attr, 21) END;
+ IF BITS(s.st_mode) * BITS(sysstat.S_IXUSR) # {} THEN INCL(attr, 22) END;
+ IF BITS(s.st_mode) * BITS(sysstat.S_IWUSR) # {} THEN INCL(attr, 23) END;
+ IF BITS(s.st_mode) * BITS(sysstat.S_IRUSR) # {} THEN INCL(attr, 24) END;
+ IF BITS(s.st_mode) * BITS(sysstat.S_ISVTX) # {} THEN INCL(attr, 25) END;
+ IF BITS(s.st_mode) * BITS(sysstat.S_ISGID) # {} THEN INCL(attr, 26) END;
+ IF BITS(s.st_mode) * BITS(sysstat.S_ISUID) # {} THEN INCL(attr, 27) END;
+ (* !!! better to check real access? *)
+ IF BITS(s.st_mode) * BITS(sysstat.S_IRUSR) # {} THEN INCL(attr, Files.readOnly) END;
+ RETURN attr
+ END GetAttr;
+
+ PROCEDURE (d: Directory) FileList (loc: Files.Locator): Files.FileInfo;
+ VAR
+ pathname: NativeName;
+ name: FullName;
+ err: INTEGER;
+ p: dirent.PDIR;
+ ent: dirent.Pstruct_dirent;
+ s: sysstat.struct_stat;
+ res: sysstat.int;
+ tm: time.Pstruct_tm;
+ h, t: Files.FileInfo;
+ BEGIN
+ ASSERT(loc # NIL, 20);
+ WITH loc: Locator DO
+ HostLang.StringToHost(loc.path, pathname, FALSE, err);
+ IF err = 0 THEN
+ p := dirent.opendir(pathname);
+ IF p # NIL THEN
+ ent := dirent.readdir(p);
+ WHILE ent # NIL DO
+ HostLang.HostToString(ent.d_name, name, FALSE, err);
+ IF err = 0 THEN
+ HostLang.StringToHost(loc.path + "/" + name, pathname, FALSE, err);
+ IF err = 0 THEN
+ res := macro.stat(pathname, s);
+ IF (res = 0) & ~IsDir(s) THEN
+ IF h = NIL THEN NEW(h); t := h
+ ELSE NEW(t.next); t := t.next
+ END;
+ t.name := name$;
+ t.type := ""; (* ??? *)
+ t.length := s.st_size;
+ tm := time.localtime(s.st_mtim.tv_sec);
+ IF tm # NIL THEN
+ t.modified.year := tm.tm_year + 1900;
+ t.modified.month := tm.tm_mon + 1;
+ t.modified.day := tm.tm_mday;
+ t.modified.hour := tm.tm_hour;
+ t.modified.minute := tm.tm_min;
+ t.modified.second := tm.tm_sec
+ END;
+ t.attr := GetAttr(pathname, name, s)
+ END
+ END
+ END;
+ ent := dirent.readdir(p)
+ END;
+ res := dirent.closedir(p);
+ ASSERT(res = 0, 100);
+ loc.res := 0 (* no error *)
+ ELSE
+ GetError(loc.res)
+ END
+ ELSE
+ loc.res := 1 (* invalid name *)
+ END
+ ELSE
+ loc.res := 1 (* invalid locator *)
+ END;
+ RETURN h
+ END FileList;
+
+ PROCEDURE (d: Directory) LocList (loc: Files.Locator): Files.LocInfo;
+ VAR
+ pathname: NativeName;
+ name: FullName;
+ err: INTEGER;
+ p: dirent.PDIR;
+ ent: dirent.Pstruct_dirent;
+ s: sysstat.struct_stat;
+ res: sysstat.int;
+ tm: time.Pstruct_tm;
+ h, t: Files.LocInfo;
+ BEGIN
+ ASSERT(loc # NIL, 20);
+ WITH loc: Locator DO
+ HostLang.StringToHost(loc.path, pathname, FALSE, err);
+ IF err = 0 THEN
+ p := dirent.opendir(pathname);
+ IF p # NIL THEN
+ ent := dirent.readdir(p);
+ WHILE ent # NIL DO
+ HostLang.HostToString(ent.d_name, name, FALSE, err);
+ IF err = 0 THEN
+ HostLang.StringToHost(loc.path + "/" + name, pathname, FALSE, err);
+ IF err = 0 THEN
+ res := macro.stat(pathname, s);
+ IF (res = 0) & IsDir(s) & (name # ".") & (name # "..") THEN
+ IF h = NIL THEN NEW(h); t := h
+ ELSE NEW(t.next); t := t.next
+ END;
+ t.name := name$;
+ t.attr := GetAttr(pathname, name, s)
+ END
+ END
+ END;
+ ent := dirent.readdir(p)
+ END;
+ res := dirent.closedir(p);
+ ASSERT(res = 0, 100);
+ loc.res := 0 (* no error *)
+ ELSE
+ GetError(loc.res)
+ END
+ ELSE
+ loc.res := 1 (* invlid name *)
+ END
+ ELSE
+ loc.res := 1 (* invalid locator *)
+ END;
+ RETURN h
+ END LocList;
+
+ PROCEDURE (d: Directory) GetFileName (name: Files.Name; type: Files.Type; OUT filename: Files.Name);
+ BEGIN
+ filename := name + "." + type
+ END GetFileName;
+
+ (* Misc *)
+
+ (* !!! implement NofFiles *)
+ (* !!! implement GetModDate & GetName *)
+
+ PROCEDURE SetRootDir* (x: ARRAY OF CHAR);
+ BEGIN
+ root := NewLocator(x)
+ END SetRootDir;
+
+ PROCEDURE UseAsk*;
+ BEGIN
+ ignoreAsk := FALSE
+ END UseAsk;
+
+ PROCEDURE IgnoreAsk*;
+ BEGIN
+ ignoreAsk := TRUE
+ END IgnoreAsk;
+
+ PROCEDURE Init;
+ VAR d: Directory;
+ BEGIN
+ SetRootDir(".");
+ NEW(d); Files.SetDir(d)
+ END Init;
+
+BEGIN
+ Init
+END HostFiles.
diff --git a/src/posix/Host/Mod/Lang.cp b/src/posix/Host/Mod/Lang.cp
--- /dev/null
@@ -0,0 +1,167 @@
+MODULE HostLang;
+
+ IMPORT S := SYSTEM, Kernel, stdlib := C99stdlib, locale := C99locale,
+ iconv := C99iconv, errno := C99errno, macro := C99macro;
+
+ CONST
+ maxLen = 32;
+
+ VAR
+ lang-, country-, encoding-: ARRAY maxLen OF CHAR;
+ c2sc, sc2c, invalid: iconv.iconv_t;
+
+ (* PEP 383 *)
+
+ PROCEDURE StringToHost* (IN in: ARRAY OF CHAR; OUT out: ARRAY OF SHORTCHAR; low: BOOLEAN; OUT res: INTEGER);
+ VAR i, j, err: INTEGER; maxlen, len, count: iconv.size_t; inadr, outadr: Kernel.ADDRESS; ch: SHORTCHAR;
+ BEGIN
+ ASSERT(c2sc # invalid, 100);
+ i := 0; err := 0;
+ outadr := S.ADR(out[0]);
+ maxlen := LEN(out) - 1;
+ WHILE (err = 0) & (in[i] # 0X) DO
+ j := i;
+ WHILE (in[i] # 0X) & ((in[i] < 0D800X) OR (in[i] > 0D8FFX)) DO INC(i) END;
+ len := (i - j) * 2;
+ WHILE (err = 0) & (len > 0) & (maxlen > 0) DO
+ inadr := S.ADR(in[j]);
+ count := iconv.iconv(c2sc, inadr, len, outadr, maxlen);
+ IF count # 0 THEN
+ CASE macro.errno() OF
+ | errno.EILSEQ:
+ (* !!! HALT(101)*) (* invalid input char *)
+ IF maxlen < 1 THEN
+ err := 1
+ ELSE
+ ch := "?";
+ S.PUT(outadr, ch); INC(outadr); DEC(maxlen);
+ INC(j); DEC(len, 2)
+ END
+ | errno.E2BIG: err := 1 (* unexpected end of out *)
+ | errno.EINVAL: HALT(102) (* unexpected end of input *)
+ | errno.EBADF: HALT(103) (* invalid iconv descriptor *)
+ ELSE HALT(104) (* unknown error *)
+ END
+ END
+ END;
+ WHILE (err = 0) & (in[i] >= 0D800X) & (in[i] <= 0D8FFX) DO
+ IF maxlen < 1 THEN
+ err := 1
+ ELSE
+ ch := SHORT(CHR(ORD(in[i]) MOD 256));
+ IF low OR (ch > 7FX) THEN
+ S.PUT(outadr, ch); INC(outadr); DEC(maxlen);
+ INC(i)
+ ELSE
+ err := 3 (* invalid char *)
+ END
+ END
+ END
+ END;
+ ch := 0X;
+ S.PUT(outadr, ch);
+ res := err
+ END StringToHost;
+
+ PROCEDURE HostToString* (IN in: ARRAY OF SHORTCHAR; OUT out: ARRAY OF CHAR; low: BOOLEAN; OUT res: INTEGER);
+ VAR err: INTEGER; maxin, maxout, count: iconv.size_t; inadr, outadr: Kernel.ADDRESS; sch: SHORTCHAR; ch: CHAR;
+ BEGIN
+ ASSERT(sc2c # invalid, 100);
+ err := 0;
+ inadr := S.ADR(in[0]);
+ outadr := S.ADR(out[0]);
+ maxin := LEN(in$); maxout := LEN(out) * 2 - 2;
+ WHILE (err = 0) & (maxout > 1) & (maxin > 0) DO
+ count := iconv.iconv(sc2c, inadr, maxin, outadr, maxout);
+ IF count # 0 THEN
+ CASE macro.errno() OF
+ | errno.EILSEQ, errno.EINVAL, errno.E2BIG:
+ IF maxout < 2 THEN
+ err := 1 (* unexpected end of output buffer *)
+ ELSIF maxin < 1 THEN
+ err := 2 (* unexpected end of input buffer *)
+ ELSE
+ S.GET(inadr, sch); INC(inadr); DEC(maxin);
+ ch := CHR(0D800H + ORD(sch));
+ IF low OR (ch > 7FX) THEN
+ S.PUT(outadr, ch); INC(outadr, 2); DEC(maxout, 2)
+ ELSE
+ err := 3 (* invalid char *)
+ END
+ END
+ | errno.EBADF: HALT(101)
+ ELSE HALT(102)
+ END
+ END
+ END;
+ ch := 0X;
+ S.PUT(outadr, ch);
+ res := err
+ END HostToString;
+
+ PROCEDURE Init;
+ VAR p: POINTER TO ARRAY [untagged] OF SHORTCHAR; i, j: INTEGER; enc: ARRAY 32 OF SHORTCHAR;
+ BEGIN
+ invalid := S.VAL(iconv.iconv_t, -1);
+ p := locale.setlocale(locale.LC_ALL, "");
+ IF p = NIL THEN
+ p := stdlib.getenv("LANG");
+ IF p = NIL THEN
+ p := ""
+ END
+ END;
+ i := 0; j := 0;
+ WHILE (p[i] # 0X) & (p[i] # "_") & (p[i] # ".") DO
+ lang[j] := p[i];
+ INC(i); INC(j)
+ END;
+ lang[j] := 0X;
+ IF p[i] = "_" THEN
+ INC(i); j := 0;
+ WHILE (p[i] # 0X) & (p[i] # ".") DO
+ country[j] := p[i];
+ INC(i); INC(j)
+ END;
+ country[j] := 0X
+ END;
+ enc := "ASCII";
+ IF p[i] = "." THEN
+ INC(i); j := 0;
+ WHILE p[i] # 0X DO
+ enc[j] := p[i];
+ INC(i); INC(j)
+ END;
+ enc[j] := 0X
+ END;
+ IF (lang = "C") OR (lang = "POSIX") THEN
+ lang := ""
+ END;
+ sc2c := invalid; c2sc := invalid;
+ IF Kernel.littleEndian THEN sc2c := iconv.iconv_open("UCS-2LE", enc)
+ ELSE sc2c := iconv.iconv_open("UCS-2BE", enc)
+ END;
+ IF sc2c = invalid THEN enc := "ASCII";
+ IF Kernel.littleEndian THEN sc2c := iconv.iconv_open("UCS-2LE", enc)
+ ELSE sc2c := iconv.iconv_open("UCS-2BE", enc)
+ END;
+ ASSERT(c2sc # invalid, 100) (* ascii to ucs2 not supported? *)
+ END;
+ IF Kernel.littleEndian THEN c2sc := iconv.iconv_open(enc, "UCS-2LE")
+ ELSE c2sc := iconv.iconv_open(enc, "UCS-2BE");
+ END;
+ ASSERT(c2sc # invalid, 101); (* ucs2 to ascii not supported? *)
+ encoding := enc$
+ END Init;
+
+ PROCEDURE Fin;
+ VAR res: iconv.int;
+ BEGIN
+ res := iconv.iconv_close(sc2c); sc2c := invalid;
+ res := iconv.iconv_close(c2sc); c2sc := invalid
+ END Fin;
+
+BEGIN
+ Init
+CLOSE
+ Fin
+END HostLang.