diff --git a/bootstrap/unix-44/Configuration.c b/bootstrap/unix-44/Configuration.c new file mode 100644 index 00000000..a1992033 --- /dev/null +++ b/bootstrap/unix-44/Configuration.c @@ -0,0 +1,16 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" + + + + + + + +export void *Configuration__init(void) +{ + __DEFMOD; + __REGMOD("Configuration", 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-44/Configuration.h b/bootstrap/unix-44/Configuration.h new file mode 100644 index 00000000..e7aed50a --- /dev/null +++ b/bootstrap/unix-44/Configuration.h @@ -0,0 +1,14 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Configuration__h +#define Configuration__h + +#include "SYSTEM.h" + + + + +import void *Configuration__init(void); + + +#endif diff --git a/bootstrap/unix-44/Console.c b/bootstrap/unix-44/Console.c new file mode 100644 index 00000000..7f8fd8c0 --- /dev/null +++ b/bootstrap/unix-44/Console.c @@ -0,0 +1,150 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "Platform.h" + + +static CHAR Console_line[128]; +static INTEGER Console_pos; + + +export void Console_Bool (BOOLEAN b); +export void Console_Char (CHAR ch); +export void Console_Flush (void); +export void Console_Hex (LONGINT i); +export void Console_Int (LONGINT i, LONGINT n); +export void Console_Ln (void); +export void Console_Read (CHAR *ch); +export void Console_ReadLine (CHAR *line, LONGINT line__len); +export void Console_String (CHAR *s, LONGINT s__len); + + +void Console_Flush (void) +{ + INTEGER error; + error = Platform_Write(((LONGINT)(1)), (LONGINT)(uintptr_t)Console_line, Console_pos); + Console_pos = 0; +} + +void Console_Char (CHAR ch) +{ + if (Console_pos == 128) { + Console_Flush(); + } + Console_line[__X(Console_pos, ((LONGINT)(128)))] = ch; + Console_pos += 1; + if (ch == 0x0a) { + Console_Flush(); + } +} + +void Console_String (CHAR *s, LONGINT s__len) +{ + INTEGER i; + __DUP(s, s__len, CHAR); + i = 0; + while (s[__X(i, s__len)] != 0x00) { + Console_Char(s[__X(i, s__len)]); + i += 1; + } + __DEL(s); +} + +void Console_Int (LONGINT i, LONGINT n) +{ + CHAR s[32]; + LONGINT i1, k; + if (i == __LSHL(1, 31, LONGINT)) { + __MOVE("8463847412", s, 11); + k = 10; + } else { + i1 = __ABS(i); + s[0] = (CHAR)(__MOD(i1, 10) + 48); + i1 = __DIV(i1, 10); + k = 1; + while (i1 > 0) { + s[__X(k, ((LONGINT)(32)))] = (CHAR)(__MOD(i1, 10) + 48); + i1 = __DIV(i1, 10); + k += 1; + } + } + if (i < 0) { + s[__X(k, ((LONGINT)(32)))] = '-'; + k += 1; + } + while (n > k) { + Console_Char(' '); + n -= 1; + } + while (k > 0) { + k -= 1; + Console_Char(s[__X(k, ((LONGINT)(32)))]); + } +} + +void Console_Ln (void) +{ + Console_Char(0x0a); +} + +void Console_Bool (BOOLEAN b) +{ + if (b) { + Console_String((CHAR*)"TRUE", (LONGINT)5); + } else { + Console_String((CHAR*)"FALSE", (LONGINT)6); + } +} + +void Console_Hex (LONGINT i) +{ + LONGINT k, n; + k = -28; + while (k <= 0) { + n = __MASK(__ASH(i, k), -16); + if (n <= 9) { + Console_Char((CHAR)(48 + n)); + } else { + Console_Char((CHAR)(55 + n)); + } + k += 4; + } +} + +void Console_Read (CHAR *ch) +{ + LONGINT n; + INTEGER error; + Console_Flush(); + error = Platform_ReadBuf(((LONGINT)(0)), (void*)&*ch, ((LONGINT)(1)), &n); + if (n != 1) { + *ch = 0x00; + } +} + +void Console_ReadLine (CHAR *line, LONGINT line__len) +{ + LONGINT i; + CHAR ch; + Console_Flush(); + i = 0; + Console_Read(&ch); + while ((((i < line__len - 1 && ch != 0x0a)) && ch != 0x00)) { + line[__X(i, line__len)] = ch; + i += 1; + Console_Read(&ch); + } + line[__X(i, line__len)] = 0x00; +} + + +export void *Console__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Platform); + __REGMOD("Console", 0); + __REGCMD("Flush", Console_Flush); + __REGCMD("Ln", Console_Ln); +/* BEGIN */ + Console_pos = 0; + __ENDMOD; +} diff --git a/bootstrap/unix-44/Console.h b/bootstrap/unix-44/Console.h new file mode 100644 index 00000000..316e7e46 --- /dev/null +++ b/bootstrap/unix-44/Console.h @@ -0,0 +1,23 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Console__h +#define Console__h + +#include "SYSTEM.h" + + + + +import void Console_Bool (BOOLEAN b); +import void Console_Char (CHAR ch); +import void Console_Flush (void); +import void Console_Hex (LONGINT i); +import void Console_Int (LONGINT i, LONGINT n); +import void Console_Ln (void); +import void Console_Read (CHAR *ch); +import void Console_ReadLine (CHAR *line, LONGINT line__len); +import void Console_String (CHAR *s, LONGINT s__len); +import void *Console__init(void); + + +#endif diff --git a/bootstrap/unix-44/Files.c b/bootstrap/unix-44/Files.c new file mode 100644 index 00000000..f3b9b280 --- /dev/null +++ b/bootstrap/unix-44/Files.c @@ -0,0 +1,1078 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tspkaSfF */ +#include "SYSTEM.h" +#include "Configuration.h" +#include "Console.h" +#include "Heap.h" +#include "Platform.h" +#include "Strings.h" + +typedef + struct Files_Handle *Files_File; + +typedef + struct Files_BufDesc { + Files_File f; + BOOLEAN chg; + LONGINT org, size; + SYSTEM_BYTE data[4096]; + } Files_BufDesc; + +typedef + Files_BufDesc *Files_Buffer; + +typedef + CHAR Files_FileName[101]; + +typedef + struct Files_Handle { + Files_FileName workName, registerName; + BOOLEAN tempFile; + Platform_FileIdentity identity; + LONGINT fd, len, pos; + Files_Buffer bufs[4]; + INTEGER swapper, state; + } Files_Handle; + +typedef + struct Files_Rider { + LONGINT res; + BOOLEAN eof; + Files_Buffer buf; + LONGINT org, offset; + } Files_Rider; + + +static LONGINT Files_fileTab[256]; +static INTEGER Files_tempno; +static CHAR Files_HOME[1024]; +static struct { + LONGINT len[1]; + CHAR data[1]; +} *Files_SearchPath; + +export LONGINT *Files_Handle__typ; +export LONGINT *Files_BufDesc__typ; +export LONGINT *Files_Rider__typ; + +export Files_File Files_Base (Files_Rider *r, LONGINT *r__typ); +static Files_File Files_CacheEntry (Platform_FileIdentity identity); +export void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res); +export void Files_Close (Files_File f); +static void Files_Create (Files_File f); +export void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res); +static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INTEGER errcode); +static void Files_Finalize (SYSTEM_PTR o); +static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len); +static void Files_Flush (Files_Buffer buf); +export void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d); +export void Files_GetName (Files_File f, CHAR *name, LONGINT name__len); +static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len); +static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len); +static void Files_Init (void); +export LONGINT Files_Length (Files_File f); +static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len); +export Files_File Files_New (CHAR *name, LONGINT name__len); +export Files_File Files_Old (CHAR *name, LONGINT name__len); +export LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ); +export void Files_Purge (Files_File f); +export void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x); +export void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x); +export void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len); +export void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n); +export void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x); +export void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x); +export void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x); +export void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +export void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x); +export void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x); +export void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x); +export void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +export void Files_Register (Files_File f); +export void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res); +static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len); +export void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos); +export void Files_SetSearchPath (CHAR *path, LONGINT path__len); +export void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x); +export void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x); +export void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n); +export void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x); +export void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x); +export void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x); +export void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x); +export void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x); +export void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x); +export void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); + +#define Files_IdxTrap() __HALT(-1) + +static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INTEGER errcode) +{ + __DUP(s, s__len, CHAR); + Console_Ln(); + Console_String((CHAR*)"-- ", (LONGINT)4); + Console_String(s, s__len); + Console_String((CHAR*)": ", (LONGINT)3); + if (f != NIL) { + if (f->registerName[0] != 0x00) { + Console_String(f->registerName, ((LONGINT)(101))); + } else { + Console_String(f->workName, ((LONGINT)(101))); + } + if (f->fd != 0) { + Console_String((CHAR*)"f.fd = ", (LONGINT)8); + Console_Int(f->fd, ((LONGINT)(1))); + } + } + if (errcode != 0) { + Console_String((CHAR*)" errcode = ", (LONGINT)12); + Console_Int(errcode, ((LONGINT)(1))); + } + Console_Ln(); + __HALT(99); + __DEL(s); +} + +static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len) +{ + INTEGER i, j; + __DUP(dir, dir__len, CHAR); + __DUP(name, name__len, CHAR); + i = 0; + j = 0; + while (dir[i] != 0x00) { + dest[i] = dir[i]; + i += 1; + } + if (dest[i - 1] != '/') { + dest[i] = '/'; + i += 1; + } + while (name[j] != 0x00) { + dest[i] = name[j]; + i += 1; + j += 1; + } + dest[i] = 0x00; + __DEL(dir); + __DEL(name); +} + +static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len) +{ + LONGINT n, i, j; + __DUP(finalName, finalName__len, CHAR); + Files_tempno += 1; + n = Files_tempno; + i = 0; + if (finalName[0] != '/') { + while (Platform_CWD[i] != 0x00) { + name[i] = Platform_CWD[i]; + i += 1; + } + if (Platform_CWD[i - 1] != '/') { + name[i] = '/'; + i += 1; + } + } + j = 0; + while (finalName[j] != 0x00) { + name[i] = finalName[j]; + i += 1; + j += 1; + } + i -= 1; + while (name[i] != '/') { + i -= 1; + } + name[i + 1] = '.'; + name[i + 2] = 't'; + name[i + 3] = 'm'; + name[i + 4] = 'p'; + name[i + 5] = '.'; + i += 6; + while (n > 0) { + name[i] = (CHAR)(__MOD(n, 10) + 48); + n = __DIV(n, 10); + i += 1; + } + name[i] = '.'; + i += 1; + n = Platform_PID; + while (n > 0) { + name[i] = (CHAR)(__MOD(n, 10) + 48); + n = __DIV(n, 10); + i += 1; + } + name[i] = 0x00; + __DEL(finalName); +} + +static void Files_Create (Files_File f) +{ + Platform_FileIdentity identity; + BOOLEAN done; + INTEGER error; + CHAR err[32]; + if (f->fd == -1) { + if (f->state == 1) { + Files_GetTempName(f->registerName, ((LONGINT)(101)), (void*)f->workName, ((LONGINT)(101))); + f->tempFile = 1; + } else if (f->state == 2) { + __COPY(f->registerName, f->workName, ((LONGINT)(101))); + f->registerName[0] = 0x00; + f->tempFile = 0; + } + error = Platform_Unlink((void*)f->workName, ((LONGINT)(101))); + error = Platform_New((void*)f->workName, ((LONGINT)(101)), &f->fd); + done = error == 0; + if ((!done && Platform_TooManyFiles(error)) || (done && f->fd >= 256)) { + if ((done && f->fd >= 256)) { + error = Platform_Close(f->fd); + } + Heap_GC(1); + error = Platform_New((void*)f->workName, ((LONGINT)(101)), &f->fd); + done = f->fd == 0; + } + if (done) { + if (f->fd >= 256) { + error = Platform_Close(f->fd); + Files_Err((CHAR*)"too many files open", (LONGINT)20, f, 0); + } else { + Files_fileTab[f->fd] = (LONGINT)(uintptr_t)f; + Heap_FileCount += 1; + Heap_RegisterFinalizer((void*)f, Files_Finalize); + f->state = 0; + f->pos = 0; + error = Platform_Identify(f->fd, &f->identity, Platform_FileIdentity__typ); + } + } else { + if (Platform_NoSuchDirectory(error)) { + __MOVE("no such directory", err, 18); + } else if (Platform_TooManyFiles(error)) { + __MOVE("too many files open", err, 20); + } else { + __MOVE("file not created", err, 17); + } + Files_Err(err, ((LONGINT)(32)), f, error); + } + } +} + +static void Files_Flush (Files_Buffer buf) +{ + INTEGER error; + Files_File f = NIL; + if (buf->chg) { + f = buf->f; + Files_Create(f); + if (buf->org != f->pos) { + error = Platform_Seek(f->fd, buf->org, Platform_SeekSet); + } + error = Platform_Write(f->fd, (LONGINT)(uintptr_t)buf->data, buf->size); + if (error != 0) { + Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error); + } + f->pos = buf->org + buf->size; + buf->chg = 0; + error = Platform_Identify(f->fd, &f->identity, Platform_FileIdentity__typ); + if (error != 0) { + Files_Err((CHAR*)"error identifying file", (LONGINT)23, f, error); + } + } +} + +void Files_Close (Files_File f) +{ + LONGINT i; + INTEGER error; + if (f->state != 1 || f->registerName[0] != 0x00) { + Files_Create(f); + i = 0; + while ((i < 4 && f->bufs[i] != NIL)) { + Files_Flush(f->bufs[i]); + i += 1; + } + error = Platform_Sync(f->fd); + if (error != 0) { + Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error); + } + Files_fileTab[f->fd] = 0; + error = Platform_Close(f->fd); + f->fd = -1; + f->state = 1; + Heap_FileCount -= 1; + } +} + +LONGINT Files_Length (Files_File f) +{ + LONGINT _o_result; + _o_result = f->len; + return _o_result; +} + +Files_File Files_New (CHAR *name, LONGINT name__len) +{ + Files_File _o_result; + Files_File f = NIL; + __DUP(name, name__len, CHAR); + __NEW(f, Files_Handle); + f->workName[0] = 0x00; + __COPY(name, f->registerName, ((LONGINT)(101))); + f->fd = -1; + f->state = 1; + f->len = 0; + f->pos = 0; + f->swapper = -1; + _o_result = f; + __DEL(name); + return _o_result; +} + +static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len) +{ + INTEGER i; + CHAR ch; + i = 0; + if (Files_SearchPath == NIL) { + if (*pos == 0) { + dir[0] = '.'; + i = 1; + *pos += 1; + } + } else { + ch = (Files_SearchPath->data)[*pos]; + while (ch == ' ' || ch == ';') { + *pos += 1; + ch = (Files_SearchPath->data)[*pos]; + } + if (ch == '~') { + *pos += 1; + ch = (Files_SearchPath->data)[*pos]; + while (Files_HOME[i] != 0x00) { + dir[i] = Files_HOME[i]; + i += 1; + } + if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) { + while ((i > 0 && dir[i - 1] != '/')) { + i -= 1; + } + } + } + while ((ch != 0x00 && ch != ';')) { + dir[i] = ch; + i += 1; + *pos += 1; + ch = (Files_SearchPath->data)[*pos]; + } + while ((i > 0 && dir[i - 1] == ' ')) { + i -= 1; + } + } + dir[i] = 0x00; +} + +static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len) +{ + BOOLEAN _o_result; + INTEGER i; + CHAR ch; + i = 0; + ch = name[0]; + while ((ch != 0x00 && ch != '/')) { + i += 1; + ch = name[i]; + } + _o_result = ch == '/'; + return _o_result; +} + +static Files_File Files_CacheEntry (Platform_FileIdentity identity) +{ + Files_File _o_result; + Files_File f = NIL; + INTEGER i, error; + i = 0; + while (i < 256) { + f = (Files_File)(uintptr_t)Files_fileTab[i]; + if ((f != NIL && Platform_SameFile(identity, f->identity))) { + if (!Platform_SameFileTime(identity, f->identity)) { + i = 0; + while (i < 4) { + if (f->bufs[i] != NIL) { + f->bufs[i]->org = -1; + f->bufs[i] = NIL; + } + i += 1; + } + f->swapper = -1; + f->identity = identity; + error = Platform_Size(f->fd, &f->len); + } + _o_result = f; + return _o_result; + } + i += 1; + } + _o_result = NIL; + return _o_result; +} + +Files_File Files_Old (CHAR *name, LONGINT name__len) +{ + Files_File _o_result; + Files_File f = NIL; + LONGINT fd; + INTEGER pos; + BOOLEAN done; + CHAR dir[256], path[256]; + INTEGER error; + Platform_FileIdentity identity; + __DUP(name, name__len, CHAR); + if (name[0] != 0x00) { + if (Files_HasDir((void*)name, name__len)) { + dir[0] = 0x00; + __COPY(name, path, ((LONGINT)(256))); + } else { + pos = 0; + Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256))); + Files_MakeFileName(dir, ((LONGINT)(256)), name, name__len, (void*)path, ((LONGINT)(256))); + Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256))); + } + for (;;) { + error = Platform_OldRW((void*)path, ((LONGINT)(256)), &fd); + done = error == 0; + if ((!done && Platform_TooManyFiles(error)) || (done && fd >= 256)) { + if ((done && fd >= 256)) { + error = Platform_Close(fd); + } + Heap_GC(1); + error = Platform_OldRW((void*)path, ((LONGINT)(256)), &fd); + done = error == 0; + if ((!done && Platform_TooManyFiles(error))) { + Files_Err((CHAR*)"too many files open", (LONGINT)20, f, error); + } + } + if ((!done && Platform_Inaccessible(error))) { + error = Platform_OldRO((void*)path, ((LONGINT)(256)), &fd); + done = error == 0; + } + if ((!done && !Platform_Absent(error))) { + Console_String((CHAR*)"Warning: Files.Old ", (LONGINT)20); + Console_String(name, name__len); + Console_String((CHAR*)" error = ", (LONGINT)10); + Console_Int(error, ((LONGINT)(0))); + Console_Ln(); + } + if (done) { + error = Platform_Identify(fd, &identity, Platform_FileIdentity__typ); + f = Files_CacheEntry(identity); + if (f != NIL) { + error = Platform_Close(fd); + _o_result = f; + __DEL(name); + return _o_result; + } else if (fd >= 256) { + error = Platform_Close(fd); + Files_Err((CHAR*)"too many files open", (LONGINT)20, f, 0); + } else { + __NEW(f, Files_Handle); + Files_fileTab[fd] = (LONGINT)(uintptr_t)f; + Heap_FileCount += 1; + Heap_RegisterFinalizer((void*)f, Files_Finalize); + f->fd = fd; + f->state = 0; + f->pos = 0; + f->swapper = -1; + error = Platform_Size(fd, &f->len); + __COPY(name, f->workName, ((LONGINT)(101))); + f->registerName[0] = 0x00; + f->tempFile = 0; + f->identity = identity; + _o_result = f; + __DEL(name); + return _o_result; + } + } else if (dir[0] == 0x00) { + _o_result = NIL; + __DEL(name); + return _o_result; + } else { + Files_MakeFileName(dir, ((LONGINT)(256)), name, name__len, (void*)path, ((LONGINT)(256))); + Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256))); + } + } + } else { + _o_result = NIL; + __DEL(name); + return _o_result; + } + __RETCHK; +} + +void Files_Purge (Files_File f) +{ + INTEGER i; + Platform_FileIdentity identity; + INTEGER error; + i = 0; + while (i < 4) { + if (f->bufs[i] != NIL) { + f->bufs[i]->org = -1; + f->bufs[i] = NIL; + } + i += 1; + } + if (f->fd != -1) { + error = Platform_Truncate(f->fd, ((LONGINT)(0))); + error = Platform_Seek(f->fd, ((LONGINT)(0)), Platform_SeekSet); + } + f->pos = 0; + f->len = 0; + f->swapper = -1; + error = Platform_Identify(f->fd, &identity, Platform_FileIdentity__typ); + Platform_SetMTime(&f->identity, Platform_FileIdentity__typ, identity); +} + +void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d) +{ + Platform_FileIdentity identity; + INTEGER error; + Files_Create(f); + error = Platform_Identify(f->fd, &identity, Platform_FileIdentity__typ); + Platform_MTimeAsClock(identity, &*t, &*d); +} + +LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ) +{ + LONGINT _o_result; + _o_result = (*r).org + (*r).offset; + return _o_result; +} + +void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos) +{ + LONGINT org, offset, i, n; + Files_Buffer buf = NIL; + INTEGER error; + if (f != NIL) { + if (pos > f->len) { + pos = f->len; + } else if (pos < 0) { + pos = 0; + } + offset = __MASK(pos, -4096); + org = pos - offset; + i = 0; + while ((((i < 4 && f->bufs[i] != NIL)) && org != f->bufs[i]->org)) { + i += 1; + } + if (i < 4) { + if (f->bufs[i] == NIL) { + __NEW(buf, Files_BufDesc); + buf->chg = 0; + buf->org = -1; + buf->f = f; + f->bufs[i] = buf; + } else { + buf = f->bufs[i]; + } + } else { + f->swapper = __MASK(f->swapper + 1, -4); + buf = f->bufs[f->swapper]; + Files_Flush(buf); + } + if (buf->org != org) { + if (org == f->len) { + buf->size = 0; + } else { + Files_Create(f); + if (f->pos != org) { + error = Platform_Seek(f->fd, org, Platform_SeekSet); + } + error = Platform_ReadBuf(f->fd, (void*)buf->data, ((LONGINT)(4096)), &n); + if (error != 0) { + Files_Err((CHAR*)"read from file not done", (LONGINT)24, f, error); + } + f->pos = org + n; + buf->size = n; + } + buf->org = org; + buf->chg = 0; + } + } else { + buf = NIL; + org = 0; + offset = 0; + } + (*r).buf = buf; + (*r).org = org; + (*r).offset = offset; + (*r).eof = 0; + (*r).res = 0; +} + +void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x) +{ + LONGINT offset; + Files_Buffer buf = NIL; + buf = (*r).buf; + offset = (*r).offset; + if ((*r).org != buf->org) { + Files_Set(&*r, r__typ, buf->f, (*r).org + offset); + buf = (*r).buf; + offset = (*r).offset; + } + if (offset < buf->size) { + *x = buf->data[offset]; + (*r).offset = offset + 1; + } else if ((*r).org + offset < buf->f->len) { + Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset); + *x = (*r).buf->data[0]; + (*r).offset = 1; + } else { + *x = 0x00; + (*r).eof = 1; + } +} + +void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n) +{ + LONGINT xpos, min, restInBuf, offset; + Files_Buffer buf = NIL; + if (n > x__len) { + Files_IdxTrap(); + } + xpos = 0; + buf = (*r).buf; + offset = (*r).offset; + while (n > 0) { + if ((*r).org != buf->org || offset >= 4096) { + Files_Set(&*r, r__typ, buf->f, (*r).org + offset); + buf = (*r).buf; + offset = (*r).offset; + } + restInBuf = buf->size - offset; + if (restInBuf == 0) { + (*r).res = n; + (*r).eof = 1; + return; + } else if (n > restInBuf) { + min = restInBuf; + } else { + min = n; + } + __MOVE((LONGINT)(uintptr_t)buf->data + offset, (LONGINT)(uintptr_t)x + xpos, min); + offset += min; + (*r).offset = offset; + xpos += min; + n -= min; + } + (*r).res = 0; + (*r).eof = 0; +} + +void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len) +{ + Files_ReadBytes(&*r, r__typ, (void*)x, x__len * ((LONGINT)(1)), ((LONGINT)(1))); +} + +Files_File Files_Base (Files_Rider *r, LONGINT *r__typ) +{ + Files_File _o_result; + _o_result = (*r).buf->f; + return _o_result; +} + +void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x) +{ + Files_Buffer buf = NIL; + LONGINT offset; + buf = (*r).buf; + offset = (*r).offset; + if ((*r).org != buf->org || offset >= 4096) { + Files_Set(&*r, r__typ, buf->f, (*r).org + offset); + buf = (*r).buf; + offset = (*r).offset; + } + buf->data[offset] = x; + buf->chg = 1; + if (offset == buf->size) { + buf->size += 1; + buf->f->len += 1; + } + (*r).offset = offset + 1; + (*r).res = 0; +} + +void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n) +{ + LONGINT xpos, min, restInBuf, offset; + Files_Buffer buf = NIL; + if (n > x__len) { + Files_IdxTrap(); + } + xpos = 0; + buf = (*r).buf; + offset = (*r).offset; + while (n > 0) { + if ((*r).org != buf->org || offset >= 4096) { + Files_Set(&*r, r__typ, buf->f, (*r).org + offset); + buf = (*r).buf; + offset = (*r).offset; + } + restInBuf = 4096 - offset; + if (n > restInBuf) { + min = restInBuf; + } else { + min = n; + } + __MOVE((LONGINT)(uintptr_t)x + xpos, (LONGINT)(uintptr_t)buf->data + offset, min); + offset += min; + (*r).offset = offset; + if (offset > buf->size) { + buf->f->len += offset - buf->size; + buf->size = offset; + } + xpos += min; + n -= min; + buf->chg = 1; + } + (*r).res = 0; +} + +void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res) +{ + __DUP(name, name__len, CHAR); + *res = Platform_Unlink((void*)name, name__len); + __DEL(name); +} + +void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res) +{ + LONGINT fdold, fdnew, n; + INTEGER error, ignore; + Platform_FileIdentity oldidentity, newidentity; + CHAR buf[4096]; + __DUP(old, old__len, CHAR); + __DUP(new, new__len, CHAR); + error = Platform_IdentifyByName(old, old__len, &oldidentity, Platform_FileIdentity__typ); + if (error == 0) { + error = Platform_IdentifyByName(new, new__len, &newidentity, Platform_FileIdentity__typ); + if ((error != 0 && !Platform_SameFile(oldidentity, newidentity))) { + Files_Delete(new, new__len, &error); + } + error = Platform_Rename((void*)old, old__len, (void*)new, new__len); + if (!Platform_DifferentFilesystems(error)) { + *res = error; + return; + } else { + error = Platform_OldRO((void*)old, old__len, &fdold); + if (error != 0) { + *res = 2; + return; + } + error = Platform_New((void*)new, new__len, &fdnew); + if (error != 0) { + error = Platform_Close(fdold); + *res = 3; + return; + } + error = Platform_Read(fdold, (LONGINT)(uintptr_t)buf, ((LONGINT)(4096)), &n); + while (n > 0) { + error = Platform_Write(fdnew, (LONGINT)(uintptr_t)buf, n); + if (error != 0) { + ignore = Platform_Close(fdold); + ignore = Platform_Close(fdnew); + Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error); + } + error = Platform_Read(fdold, (LONGINT)(uintptr_t)buf, ((LONGINT)(4096)), &n); + } + ignore = Platform_Close(fdold); + ignore = Platform_Close(fdnew); + if (n == 0) { + error = Platform_Unlink((void*)old, old__len); + *res = 0; + } else { + Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error); + } + } + } else { + *res = 2; + } + __DEL(old); + __DEL(new); +} + +void Files_Register (Files_File f) +{ + INTEGER idx, errcode; + Files_File f1 = NIL; + CHAR file[104]; + if ((f->state == 1 && f->registerName[0] != 0x00)) { + f->state = 2; + } + Files_Close(f); + if (f->registerName[0] != 0x00) { + Files_Rename(f->workName, ((LONGINT)(101)), f->registerName, ((LONGINT)(101)), &errcode); + if (errcode != 0) { + __COPY(f->registerName, file, ((LONGINT)(104))); + __HALT(99); + } + __COPY(f->registerName, f->workName, ((LONGINT)(101))); + f->registerName[0] = 0x00; + f->tempFile = 0; + } +} + +void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res) +{ + __DUP(path, path__len, CHAR); + *res = Platform_Chdir((void*)path, path__len); + __DEL(path); +} + +static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len) +{ + LONGINT i, j; + if (!Platform_LittleEndian) { + i = src__len; + j = 0; + while (i > 0) { + i -= 1; + dest[j] = src[i]; + j += 1; + } + } else { + __MOVE((LONGINT)(uintptr_t)src, (LONGINT)(uintptr_t)dest, src__len); + } +} + +void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x) +{ + Files_Read(&*R, R__typ, (CHAR*)(void*)&*x); +} + +void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x) +{ + CHAR b[2]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(2)), ((LONGINT)(2))); + *x = (int)b[0] + __ASHL((int)b[1], 8); +} + +void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x) +{ + CHAR b[4]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); + *x = ((LONGINT)((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((LONGINT)b[2], 16)) + __ASHL((LONGINT)b[3], 24); +} + +void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x) +{ + CHAR b[4]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); + *x = (SET)(((LONGINT)((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((LONGINT)b[2], 16)) + __ASHL((LONGINT)b[3], 24)); +} + +void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x) +{ + CHAR b[4]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); + Files_FlipBytes((void*)b, ((LONGINT)(4)), (void*)&*x, ((LONGINT)(4))); +} + +void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x) +{ + CHAR b[8]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(8)), ((LONGINT)(8))); + Files_FlipBytes((void*)b, ((LONGINT)(8)), (void*)&*x, ((LONGINT)(8))); +} + +void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len) +{ + INTEGER i; + CHAR ch; + i = 0; + do { + Files_Read(&*R, R__typ, (void*)&ch); + x[i] = ch; + i += 1; + } while (!(ch == 0x00)); +} + +void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len) +{ + INTEGER i; + CHAR ch; + BOOLEAN b; + i = 0; + b = 0; + do { + Files_Read(&*R, R__typ, (void*)&ch); + if ((ch == 0x00 || ch == 0x0a) || ch == 0x0d) { + b = 1; + } else { + x[i] = ch; + i += 1; + } + } while (!b); +} + +void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x) +{ + SHORTINT s; + CHAR ch; + LONGINT n; + s = 0; + n = 0; + Files_Read(&*R, R__typ, (void*)&ch); + while ((int)ch >= 128) { + n += __ASH((LONGINT)((int)ch - 128), s); + s += 7; + Files_Read(&*R, R__typ, (void*)&ch); + } + n += __ASH((LONGINT)(__MASK((int)ch, -64) - __ASHL(__ASHR((int)ch, 6), 6)), s); + *x = n; +} + +void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x) +{ + Files_Write(&*R, R__typ, __VAL(CHAR, x)); +} + +void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x) +{ + CHAR b[2]; + b[0] = (CHAR)x; + b[1] = (CHAR)__ASHR(x, 8); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(2)), ((LONGINT)(2))); +} + +void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x) +{ + CHAR b[4]; + b[0] = (CHAR)x; + b[1] = (CHAR)__ASHR(x, 8); + b[2] = (CHAR)__ASHR(x, 16); + b[3] = (CHAR)__ASHR(x, 24); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); +} + +void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x) +{ + CHAR b[4]; + LONGINT i; + i = (LONGINT)x; + b[0] = (CHAR)i; + b[1] = (CHAR)__ASHR(i, 8); + b[2] = (CHAR)__ASHR(i, 16); + b[3] = (CHAR)__ASHR(i, 24); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); +} + +void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x) +{ + CHAR b[4]; + Files_FlipBytes((void*)&x, ((LONGINT)(4)), (void*)b, ((LONGINT)(4))); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); +} + +void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x) +{ + CHAR b[8]; + Files_FlipBytes((void*)&x, ((LONGINT)(8)), (void*)b, ((LONGINT)(8))); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(8)), ((LONGINT)(8))); +} + +void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len) +{ + INTEGER i; + i = 0; + while (x[i] != 0x00) { + i += 1; + } + Files_WriteBytes(&*R, R__typ, (void*)x, x__len * ((LONGINT)(1)), i + 1); +} + +void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x) +{ + while (x < -64 || x > 63) { + Files_Write(&*R, R__typ, (CHAR)(__MASK(x, -128) + 128)); + x = __ASHR(x, 7); + } + Files_Write(&*R, R__typ, (CHAR)__MASK(x, -128)); +} + +void Files_GetName (Files_File f, CHAR *name, LONGINT name__len) +{ + __COPY(f->workName, name, name__len); +} + +static void Files_Finalize (SYSTEM_PTR o) +{ + Files_File f = NIL; + LONGINT res; + f = (Files_File)(uintptr_t)o; + if (f->fd >= 0) { + Files_fileTab[f->fd] = 0; + res = Platform_Close(f->fd); + f->fd = -1; + Heap_FileCount -= 1; + if (f->tempFile) { + res = Platform_Unlink((void*)f->workName, ((LONGINT)(101))); + } + } +} + +void Files_SetSearchPath (CHAR *path, LONGINT path__len) +{ + __DUP(path, path__len, CHAR); + if (Strings_Length(path, path__len) != 0) { + Files_SearchPath = __NEWARR(NIL, ((LONGINT)(1)), 1, 1, 1, (LONGINT)(Strings_Length(path, path__len) + 1)); + __COPY(path, Files_SearchPath->data, Files_SearchPath->len[0]); + } else { + Files_SearchPath = NIL; + } + __DEL(path); +} + +static void Files_Init (void) +{ + LONGINT i; + i = 0; + while (i < 256) { + Files_fileTab[i] = 0; + i += 1; + } + Files_tempno = -1; + Heap_FileCount = 0; + Files_SearchPath = NIL; + Files_HOME[0] = 0x00; + Platform_GetEnv((CHAR*)"HOME", (LONGINT)5, (void*)Files_HOME, ((LONGINT)(1024))); +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(Files_SearchPath); +} + +__TDESC(Files_Handle, 1, 4) = {__TDFLDS("Handle", 248), {228, 232, 236, 240, -20}}; +__TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4112), {0, -8}}; +__TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 20), {8, -8}}; + +export void *Files__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Console); + __MODULE_IMPORT(Heap); + __MODULE_IMPORT(Platform); + __MODULE_IMPORT(Strings); + __REGMOD("Files", EnumPtrs); + __INITYP(Files_Handle, Files_Handle, 0); + __INITYP(Files_BufDesc, Files_BufDesc, 0); + __INITYP(Files_Rider, Files_Rider, 0); +/* BEGIN */ + Files_Init(); + __ENDMOD; +} diff --git a/bootstrap/unix-44/Files.h b/bootstrap/unix-44/Files.h new file mode 100644 index 00000000..002d2dc5 --- /dev/null +++ b/bootstrap/unix-44/Files.h @@ -0,0 +1,70 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tspkaSfF */ + +#ifndef Files__h +#define Files__h + +#include "SYSTEM.h" + +typedef + struct Files_Handle *Files_File; + +typedef + struct Files_Handle { + char _prvt0[216]; + LONGINT fd; + char _prvt1[28]; + } Files_Handle; + +typedef + struct Files_Rider { + LONGINT res; + BOOLEAN eof; + char _prvt0[15]; + } Files_Rider; + + + +import LONGINT *Files_Handle__typ; +import LONGINT *Files_Rider__typ; + +import Files_File Files_Base (Files_Rider *r, LONGINT *r__typ); +import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res); +import void Files_Close (Files_File f); +import void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res); +import void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d); +import void Files_GetName (Files_File f, CHAR *name, LONGINT name__len); +import LONGINT Files_Length (Files_File f); +import Files_File Files_New (CHAR *name, LONGINT name__len); +import Files_File Files_Old (CHAR *name, LONGINT name__len); +import LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ); +import void Files_Purge (Files_File f); +import void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x); +import void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x); +import void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len); +import void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n); +import void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x); +import void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x); +import void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x); +import void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +import void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x); +import void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x); +import void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x); +import void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +import void Files_Register (Files_File f); +import void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res); +import void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos); +import void Files_SetSearchPath (CHAR *path, LONGINT path__len); +import void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x); +import void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x); +import void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n); +import void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x); +import void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x); +import void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x); +import void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x); +import void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x); +import void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x); +import void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +import void *Files__init(void); + + +#endif diff --git a/bootstrap/unix-44/Heap.c b/bootstrap/unix-44/Heap.c new file mode 100644 index 00000000..cbb21626 --- /dev/null +++ b/bootstrap/unix-44/Heap.c @@ -0,0 +1,752 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tskSfF */ +#include "SYSTEM.h" + +struct Heap__1 { + CHAR ch; + SYSTEM_PTR p; +}; + +typedef + struct Heap_CmdDesc *Heap_Cmd; + +typedef + CHAR Heap_CmdName[24]; + +typedef + void (*Heap_Command)(void); + +typedef + struct Heap_CmdDesc { + Heap_Cmd next; + Heap_CmdName name; + Heap_Command cmd; + } Heap_CmdDesc; + +typedef + void (*Heap_EnumProc)(void(*)(SYSTEM_PTR)); + +typedef + struct Heap_FinDesc *Heap_FinNode; + +typedef + void (*Heap_Finalizer)(SYSTEM_PTR); + +typedef + struct Heap_FinDesc { + Heap_FinNode next; + LONGINT obj; + BOOLEAN marked; + Heap_Finalizer finalize; + } Heap_FinDesc; + +typedef + struct Heap_ModuleDesc *Heap_Module; + +typedef + CHAR Heap_ModuleName[20]; + +typedef + struct Heap_ModuleDesc { + Heap_Module next; + Heap_ModuleName name; + LONGINT refcnt; + Heap_Cmd cmds; + LONGINT types; + Heap_EnumProc enumPtrs; + LONGINT reserved1, reserved2; + } Heap_ModuleDesc; + + +export SYSTEM_PTR Heap_modules; +static LONGINT Heap_freeList[10]; +static LONGINT Heap_bigBlocks; +export LONGINT Heap_allocated; +static BOOLEAN Heap_firstTry; +static LONGINT Heap_heap, Heap_heapend; +export LONGINT Heap_heapsize; +static Heap_FinNode Heap_fin; +static INTEGER Heap_lockdepth; +static BOOLEAN Heap_interrupted; +export INTEGER Heap_FileCount; + +export LONGINT *Heap_ModuleDesc__typ; +export LONGINT *Heap_CmdDesc__typ; +export LONGINT *Heap_FinDesc__typ; +export LONGINT *Heap__1__typ; + +static void Heap_CheckFin (void); +static void Heap_ExtendHeap (LONGINT blksz); +export void Heap_FINALL (void); +static void Heap_Finalize (void); +export void Heap_GC (BOOLEAN markStack); +static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len); +export void Heap_INCREF (Heap_Module m); +export void Heap_InitHeap (void); +export void Heap_Lock (void); +static void Heap_Mark (LONGINT q); +static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len); +static void Heap_MarkP (SYSTEM_PTR p); +static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len); +export SYSTEM_PTR Heap_NEWBLK (LONGINT size); +export SYSTEM_PTR Heap_NEWREC (LONGINT tag); +static LONGINT Heap_NewChunk (LONGINT blksz); +export void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd); +export SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs); +export void Heap_REGTYP (Heap_Module m, LONGINT typ); +export void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize); +static void Heap_Scan (void); +static void Heap_Sift (LONGINT l, LONGINT r, LONGINT *a, LONGINT a__len); +export void Heap_Unlock (void); + +extern void *Heap__init(); +extern LONGINT Platform_MainStackFrame; +extern LONGINT Platform_OSAllocate(LONGINT size); +#define Heap_FetchAddress(pointer) (LONGINT)(uintptr_t)(*((void**)((uintptr_t)pointer))) +#define Heap_HeapModuleInit() Heap__init() +#define Heap_OSAllocate(size) Platform_OSAllocate(size) +#define Heap_PlatformHalt(code) Platform_Halt(code) +#define Heap_PlatformMainStackFrame() Platform_MainStackFrame + +void Heap_Lock (void) +{ + Heap_lockdepth += 1; +} + +void Heap_Unlock (void) +{ + Heap_lockdepth -= 1; + if ((Heap_interrupted && Heap_lockdepth == 0)) { + Heap_PlatformHalt(((LONGINT)(-9))); + } +} + +SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs) +{ + SYSTEM_PTR _o_result; + Heap_Module m; + if (__STRCMP(name, "Heap") == 0) { + __SYSNEW(m, 48); + } else { + __NEW(m, Heap_ModuleDesc); + } + m->types = 0; + m->cmds = NIL; + __COPY(name, m->name, ((LONGINT)(20))); + m->refcnt = 0; + m->enumPtrs = enumPtrs; + m->next = (Heap_Module)(uintptr_t)Heap_modules; + Heap_modules = (SYSTEM_PTR)m; + _o_result = (void*)m; + return _o_result; +} + +void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd) +{ + Heap_Cmd c; + if (__STRCMP(m->name, "Heap") == 0) { + __SYSNEW(c, 32); + } else { + __NEW(c, Heap_CmdDesc); + } + __COPY(name, c->name, ((LONGINT)(24))); + c->cmd = cmd; + c->next = m->cmds; + m->cmds = c; +} + +void Heap_REGTYP (Heap_Module m, LONGINT typ) +{ + __PUT(typ, m->types, LONGINT); + m->types = typ; +} + +void Heap_INCREF (Heap_Module m) +{ + m->refcnt += 1; +} + +static LONGINT Heap_NewChunk (LONGINT blksz) +{ + LONGINT _o_result; + LONGINT chnk; + chnk = Heap_OSAllocate(blksz + 12); + if (chnk != 0) { + __PUT(chnk + 4, chnk + (12 + blksz), LONGINT); + __PUT(chnk + 12, chnk + 16, LONGINT); + __PUT(chnk + 16, blksz, LONGINT); + __PUT(chnk + 20, -4, LONGINT); + __PUT(chnk + 24, Heap_bigBlocks, LONGINT); + Heap_bigBlocks = chnk + 12; + Heap_heapsize += blksz; + } + _o_result = chnk; + return _o_result; +} + +static void Heap_ExtendHeap (LONGINT blksz) +{ + LONGINT size, chnk, j, next; + if (blksz > 160000) { + size = blksz; + } else { + size = 160000; + } + chnk = Heap_NewChunk(size); + if (chnk != 0) { + if (chnk < Heap_heap) { + __PUT(chnk, Heap_heap, LONGINT); + Heap_heap = chnk; + } else { + j = Heap_heap; + next = Heap_FetchAddress(j); + while ((next != 0 && chnk > next)) { + j = next; + next = Heap_FetchAddress(j); + } + __PUT(chnk, next, LONGINT); + __PUT(j, chnk, LONGINT); + } + if (next == 0) { + Heap_heapend = Heap_FetchAddress(chnk + 4); + } + } +} + +SYSTEM_PTR Heap_NEWREC (LONGINT tag) +{ + SYSTEM_PTR _o_result; + LONGINT i, i0, di, blksz, restsize, t, adr, end, next, prev; + SYSTEM_PTR new; + Heap_Lock(); + blksz = Heap_FetchAddress(tag); + i0 = __ASHR(blksz, 4); + i = i0; + if (i < 9) { + adr = Heap_freeList[i]; + while (adr == 0) { + i += 1; + adr = Heap_freeList[i]; + } + } + if (i < 9) { + next = Heap_FetchAddress(adr + 12); + Heap_freeList[i] = next; + if (i != i0) { + di = i - i0; + restsize = __ASHL(di, 4); + end = adr + restsize; + __PUT(end + 4, blksz, LONGINT); + __PUT(end + 8, -4, LONGINT); + __PUT(end, end + 4, LONGINT); + __PUT(adr + 4, restsize, LONGINT); + __PUT(adr + 12, Heap_freeList[di], LONGINT); + Heap_freeList[di] = adr; + adr += restsize; + } + } else { + adr = Heap_bigBlocks; + prev = 0; + for (;;) { + if (adr == 0) { + if (Heap_firstTry) { + Heap_GC(1); + blksz += 16; + if (__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2) < Heap_heapsize) { + Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize); + } + Heap_firstTry = 0; + new = Heap_NEWREC(tag); + Heap_firstTry = 1; + if (new == NIL) { + Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize); + new = Heap_NEWREC(tag); + } + Heap_Unlock(); + _o_result = new; + return _o_result; + } else { + Heap_Unlock(); + _o_result = NIL; + return _o_result; + } + } + t = Heap_FetchAddress(adr + 4); + if (t >= blksz) { + break; + } + prev = adr; + adr = Heap_FetchAddress(adr + 12); + } + restsize = t - blksz; + end = adr + restsize; + __PUT(end + 4, blksz, LONGINT); + __PUT(end + 8, -4, LONGINT); + __PUT(end, end + 4, LONGINT); + if (restsize > 144) { + __PUT(adr + 4, restsize, LONGINT); + } else { + next = Heap_FetchAddress(adr + 12); + if (prev == 0) { + Heap_bigBlocks = next; + } else { + __PUT(prev + 12, next, LONGINT); + } + if (restsize > 0) { + di = __ASHR(restsize, 4); + __PUT(adr + 4, restsize, LONGINT); + __PUT(adr + 12, Heap_freeList[di], LONGINT); + Heap_freeList[di] = adr; + } + } + adr += restsize; + } + i = adr + 16; + end = adr + blksz; + while (i < end) { + __PUT(i, 0, LONGINT); + __PUT(i + 4, 0, LONGINT); + __PUT(i + 8, 0, LONGINT); + __PUT(i + 12, 0, LONGINT); + i += 16; + } + __PUT(adr + 12, 0, LONGINT); + __PUT(adr, tag, LONGINT); + __PUT(adr + 4, 0, LONGINT); + __PUT(adr + 8, 0, LONGINT); + Heap_allocated += blksz; + Heap_Unlock(); + _o_result = (SYSTEM_PTR)(uintptr_t)(adr + 4); + return _o_result; +} + +SYSTEM_PTR Heap_NEWBLK (LONGINT size) +{ + SYSTEM_PTR _o_result; + LONGINT blksz, tag; + SYSTEM_PTR new; + Heap_Lock(); + blksz = __ASHL(__ASHR(size + 31, 4), 4); + new = Heap_NEWREC((LONGINT)(uintptr_t)&blksz); + tag = ((LONGINT)(uintptr_t)new + blksz) - 12; + __PUT(tag - 4, 0, LONGINT); + __PUT(tag, blksz, LONGINT); + __PUT(tag + 4, -4, LONGINT); + __PUT((LONGINT)(uintptr_t)new - 4, tag, LONGINT); + Heap_Unlock(); + _o_result = new; + return _o_result; +} + +static void Heap_Mark (LONGINT q) +{ + LONGINT p, tag, fld, n, offset, tagbits; + if (q != 0) { + tagbits = Heap_FetchAddress(q - 4); + if (!__ODD(tagbits)) { + __PUT(q - 4, tagbits + 1, LONGINT); + p = 0; + tag = tagbits + 4; + for (;;) { + __GET(tag, offset, LONGINT); + if (offset < 0) { + __PUT(q - 4, (tag + offset) + 1, LONGINT); + if (p == 0) { + break; + } + n = q; + q = p; + tag = Heap_FetchAddress(q - 4); + tag -= 1; + __GET(tag, offset, LONGINT); + fld = q + offset; + p = Heap_FetchAddress(fld); + __PUT(fld, (SYSTEM_PTR)(uintptr_t)n, SYSTEM_PTR); + } else { + fld = q + offset; + n = Heap_FetchAddress(fld); + if (n != 0) { + tagbits = Heap_FetchAddress(n - 4); + if (!__ODD(tagbits)) { + __PUT(n - 4, tagbits + 1, LONGINT); + __PUT(q - 4, tag + 1, LONGINT); + __PUT(fld, (SYSTEM_PTR)(uintptr_t)p, SYSTEM_PTR); + p = q; + q = n; + tag = tagbits; + } + } + } + tag += 4; + } + } + } +} + +static void Heap_MarkP (SYSTEM_PTR p) +{ + Heap_Mark((LONGINT)(uintptr_t)p); +} + +static void Heap_Scan (void) +{ + LONGINT chnk, adr, end, start, tag, i, size, freesize; + Heap_bigBlocks = 0; + i = 1; + while (i < 9) { + Heap_freeList[i] = 0; + i += 1; + } + freesize = 0; + Heap_allocated = 0; + chnk = Heap_heap; + while (chnk != 0) { + adr = chnk + 12; + end = Heap_FetchAddress(chnk + 4); + while (adr < end) { + tag = Heap_FetchAddress(adr); + if (__ODD(tag)) { + if (freesize > 0) { + start = adr - freesize; + __PUT(start, start + 4, LONGINT); + __PUT(start + 4, freesize, LONGINT); + __PUT(start + 8, -4, LONGINT); + i = __ASHR(freesize, 4); + freesize = 0; + if (i < 9) { + __PUT(start + 12, Heap_freeList[i], LONGINT); + Heap_freeList[i] = start; + } else { + __PUT(start + 12, Heap_bigBlocks, LONGINT); + Heap_bigBlocks = start; + } + } + tag -= 1; + __PUT(adr, tag, LONGINT); + size = Heap_FetchAddress(tag); + Heap_allocated += size; + adr += size; + } else { + size = Heap_FetchAddress(tag); + freesize += size; + adr += size; + } + } + if (freesize > 0) { + start = adr - freesize; + __PUT(start, start + 4, LONGINT); + __PUT(start + 4, freesize, LONGINT); + __PUT(start + 8, -4, LONGINT); + i = __ASHR(freesize, 4); + freesize = 0; + if (i < 9) { + __PUT(start + 12, Heap_freeList[i], LONGINT); + Heap_freeList[i] = start; + } else { + __PUT(start + 12, Heap_bigBlocks, LONGINT); + Heap_bigBlocks = start; + } + } + chnk = Heap_FetchAddress(chnk); + } +} + +static void Heap_Sift (LONGINT l, LONGINT r, LONGINT *a, LONGINT a__len) +{ + LONGINT i, j, x; + j = l; + x = a[j]; + for (;;) { + i = j; + j = __ASHL(j, 1) + 1; + if ((j < r && a[j] < a[j + 1])) { + j += 1; + } + if (j > r || a[j] <= x) { + break; + } + a[i] = a[j]; + } + a[i] = x; +} + +static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len) +{ + LONGINT l, r, x; + l = __ASHR(n, 1); + r = n - 1; + while (l > 0) { + l -= 1; + Heap_Sift(l, r, (void*)a, a__len); + } + while (r > 0) { + x = a[0]; + a[0] = a[r]; + a[r] = x; + r -= 1; + Heap_Sift(l, r, (void*)a, a__len); + } +} + +static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len) +{ + LONGINT chnk, adr, tag, next, lim, lim1, i, ptr, size; + chnk = Heap_heap; + i = 0; + lim = cand[n - 1]; + while ((chnk != 0 && chnk < lim)) { + adr = chnk + 12; + lim1 = Heap_FetchAddress(chnk + 4); + if (lim < lim1) { + lim1 = lim; + } + while (adr < lim1) { + tag = Heap_FetchAddress(adr); + if (__ODD(tag)) { + size = Heap_FetchAddress(tag - 1); + adr += size; + } else { + size = Heap_FetchAddress(tag); + ptr = adr + 4; + while (cand[i] < ptr) { + i += 1; + } + if (i == n) { + return; + } + next = adr + size; + if (cand[i] < next) { + Heap_Mark(ptr); + } + adr = next; + } + } + chnk = Heap_FetchAddress(chnk); + } +} + +static void Heap_CheckFin (void) +{ + Heap_FinNode n; + LONGINT tag; + n = Heap_fin; + while (n != NIL) { + tag = Heap_FetchAddress(n->obj - 4); + if (!__ODD(tag)) { + n->marked = 0; + Heap_Mark(n->obj); + } else { + n->marked = 1; + } + n = n->next; + } +} + +static void Heap_Finalize (void) +{ + Heap_FinNode n, prev; + n = Heap_fin; + prev = NIL; + while (n != NIL) { + if (!n->marked) { + if (n == Heap_fin) { + Heap_fin = Heap_fin->next; + } else { + prev->next = n->next; + } + (*n->finalize)((SYSTEM_PTR)(uintptr_t)n->obj); + if (prev == NIL) { + n = Heap_fin; + } else { + n = n->next; + } + } else { + prev = n; + n = n->next; + } + } +} + +void Heap_FINALL (void) +{ + Heap_FinNode n; + while (Heap_fin != NIL) { + n = Heap_fin; + Heap_fin = Heap_fin->next; + (*n->finalize)((SYSTEM_PTR)(uintptr_t)n->obj); + } +} + +static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len) +{ + SYSTEM_PTR frame; + LONGINT inc, nofcand, sp, p, stack0, ptr; + struct Heap__1 align; + if (n > 0) { + Heap_MarkStack(n - 1, cand, cand__len); + if (n > 100) { + return; + } + } + if (n == 0) { + nofcand = 0; + sp = (LONGINT)(uintptr_t)&frame; + stack0 = Heap_PlatformMainStackFrame(); + inc = (LONGINT)(uintptr_t)&align.p - (LONGINT)(uintptr_t)&align; + if (sp > stack0) { + inc = -inc; + } + while (sp != stack0) { + __GET(sp, p, LONGINT); + if ((p > Heap_heap && p < Heap_heapend)) { + if (nofcand == cand__len) { + Heap_HeapSort(nofcand, (void*)cand, cand__len); + Heap_MarkCandidates(nofcand, (void*)cand, cand__len); + nofcand = 0; + } + cand[nofcand] = p; + nofcand += 1; + } + sp += inc; + } + if (nofcand > 0) { + Heap_HeapSort(nofcand, (void*)cand, cand__len); + Heap_MarkCandidates(nofcand, (void*)cand, cand__len); + } + } +} + +void Heap_GC (BOOLEAN markStack) +{ + Heap_Module m; + LONGINT i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23; + LONGINT cand[10000]; + if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) { + Heap_Lock(); + m = (Heap_Module)(uintptr_t)Heap_modules; + while (m != NIL) { + if (m->enumPtrs != NIL) { + (*m->enumPtrs)(Heap_MarkP); + } + m = m->next; + } + if (markStack) { + i0 = -100; + i1 = -101; + i2 = -102; + i3 = -103; + i4 = -104; + i5 = -105; + i6 = -106; + i7 = -107; + i8 = 1; + i9 = 2; + i10 = 3; + i11 = 4; + i12 = 5; + i13 = 6; + i14 = 7; + i15 = 8; + i16 = 9; + i17 = 10; + i18 = 11; + i19 = 12; + i20 = 13; + i21 = 14; + i22 = 15; + i23 = 16; + for (;;) { + i0 += 1; + i1 += 2; + i2 += 3; + i3 += 4; + i4 += 5; + i5 += 6; + i6 += 7; + i7 += 8; + i8 += 9; + i9 += 10; + i10 += 11; + i11 += 12; + i12 += 13; + i13 += 14; + i14 += 15; + i15 += 16; + i16 += 17; + i17 += 18; + i18 += 19; + i19 += 20; + i20 += 21; + i21 += 22; + i22 += 23; + i23 += 24; + if ((i0 == -99 && i15 == 24)) { + Heap_MarkStack(((LONGINT)(32)), (void*)cand, ((LONGINT)(10000))); + break; + } + } + if (((((((((((((((((((((((i0 + i1) + i2) + i3) + i4) + i5) + i6) + i7) + i8) + i9) + i10) + i11) + i12) + i13) + i14) + i15) + i16) + i17) + i18) + i19) + i20) + i21) + i22) + i23 > 10000) { + return; + } + } + Heap_CheckFin(); + Heap_Scan(); + Heap_Finalize(); + Heap_Unlock(); + } +} + +void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize) +{ + Heap_FinNode f; + __NEW(f, Heap_FinDesc); + f->obj = (LONGINT)(uintptr_t)obj; + f->finalize = finalize; + f->marked = 1; + f->next = Heap_fin; + Heap_fin = f; +} + +void Heap_InitHeap (void) +{ + Heap_heap = Heap_NewChunk(128000); + Heap_heapend = Heap_FetchAddress(Heap_heap + 4); + __PUT(Heap_heap, 0, LONGINT); + Heap_allocated = 0; + Heap_firstTry = 1; + Heap_freeList[9] = 1; + Heap_lockdepth = 0; + Heap_FileCount = 0; + Heap_modules = NIL; + Heap_heapsize = 0; + Heap_bigBlocks = 0; + Heap_fin = NIL; + Heap_interrupted = 0; + Heap_HeapModuleInit(); +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(Heap_modules); + P(Heap_fin); +} + +__TDESC(Heap_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 48), {0, 28, -12}}; +__TDESC(Heap_CmdDesc, 1, 1) = {__TDFLDS("CmdDesc", 32), {0, -8}}; +__TDESC(Heap_FinDesc, 1, 1) = {__TDFLDS("FinDesc", 16), {0, -8}}; +__TDESC(Heap__1, 1, 1) = {__TDFLDS("", 8), {4, -8}}; + +export void *Heap__init(void) +{ + __DEFMOD; + __REGMOD("Heap", EnumPtrs); + __REGCMD("FINALL", Heap_FINALL); + __REGCMD("InitHeap", Heap_InitHeap); + __REGCMD("Lock", Heap_Lock); + __REGCMD("Unlock", Heap_Unlock); + __INITYP(Heap_ModuleDesc, Heap_ModuleDesc, 0); + __INITYP(Heap_CmdDesc, Heap_CmdDesc, 0); + __INITYP(Heap_FinDesc, Heap_FinDesc, 0); + __INITYP(Heap__1, Heap__1, 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-44/Heap.h b/bootstrap/unix-44/Heap.h new file mode 100644 index 00000000..d270a455 --- /dev/null +++ b/bootstrap/unix-44/Heap.h @@ -0,0 +1,54 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tskSfF */ + +#ifndef Heap__h +#define Heap__h + +#include "SYSTEM.h" + +typedef + CHAR Heap_CmdName[24]; + +typedef + void (*Heap_Command)(void); + +typedef + void (*Heap_EnumProc)(void(*)(SYSTEM_PTR)); + +typedef + void (*Heap_Finalizer)(SYSTEM_PTR); + +typedef + struct Heap_ModuleDesc *Heap_Module; + +typedef + struct Heap_ModuleDesc { + LONGINT _prvt0; + char _prvt1[44]; + } Heap_ModuleDesc; + +typedef + CHAR Heap_ModuleName[20]; + + +import SYSTEM_PTR Heap_modules; +import LONGINT Heap_allocated, Heap_heapsize; +import INTEGER Heap_FileCount; + +import LONGINT *Heap_ModuleDesc__typ; + +import void Heap_FINALL (void); +import void Heap_GC (BOOLEAN markStack); +import void Heap_INCREF (Heap_Module m); +import void Heap_InitHeap (void); +import void Heap_Lock (void); +import SYSTEM_PTR Heap_NEWBLK (LONGINT size); +import SYSTEM_PTR Heap_NEWREC (LONGINT tag); +import void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd); +import SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs); +import void Heap_REGTYP (Heap_Module m, LONGINT typ); +import void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize); +import void Heap_Unlock (void); +import void *Heap__init(void); + + +#endif diff --git a/bootstrap/unix-44/Modules.c b/bootstrap/unix-44/Modules.c new file mode 100644 index 00000000..6c0f5e0b --- /dev/null +++ b/bootstrap/unix-44/Modules.c @@ -0,0 +1,171 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "Console.h" +#include "Heap.h" + +typedef + struct Modules_CmdDesc *Modules_Cmd; + +typedef + void (*Modules_Command)(void); + +typedef + struct Modules_CmdDesc { + Modules_Cmd next; + CHAR name[24]; + Modules_Command cmd; + } Modules_CmdDesc; + +typedef + struct Modules_ModuleDesc *Modules_Module; + +typedef + CHAR Modules_ModuleName[20]; + +typedef + struct Modules_ModuleDesc { + Modules_Module next; + Modules_ModuleName name; + LONGINT refcnt; + Modules_Cmd cmds; + LONGINT types; + void (*enumPtrs)(void(*)(LONGINT)); + LONGINT reserved1, reserved2; + } Modules_ModuleDesc; + + +export INTEGER Modules_res; +export CHAR Modules_resMsg[256]; +export Modules_ModuleName Modules_imported, Modules_importing; + +export LONGINT *Modules_ModuleDesc__typ; +export LONGINT *Modules_CmdDesc__typ; + +static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len); +export void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all); +export Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len); +export Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len); + +#define Modules_modules() (Modules_Module)Heap_modules +#define Modules_setmodules(m) Heap_modules = m + +static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len) +{ + INTEGER i, j; + __DUP(b, b__len, CHAR); + i = 0; + while (a[__X(i, a__len)] != 0x00) { + i += 1; + } + j = 0; + while (b[__X(j, b__len)] != 0x00) { + a[__X(i, a__len)] = b[__X(j, b__len)]; + i += 1; + j += 1; + } + a[__X(i, a__len)] = 0x00; + __DEL(b); +} + +Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len) +{ + Modules_Module _o_result; + Modules_Module m = NIL; + CHAR bodyname[64]; + Modules_Command body; + __DUP(name, name__len, CHAR); + m = Modules_modules(); + while ((m != NIL && __STRCMP(m->name, name) != 0)) { + m = m->next; + } + if (m != NIL) { + Modules_res = 0; + Modules_resMsg[0] = 0x00; + } else { + Modules_res = 1; + __COPY(name, Modules_importing, ((LONGINT)(20))); + __MOVE(" module \"", Modules_resMsg, 10); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), name, name__len); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)"\" not found", (LONGINT)12); + } + _o_result = m; + __DEL(name); + return _o_result; +} + +Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len) +{ + Modules_Command _o_result; + Modules_Cmd c = NIL; + __DUP(name, name__len, CHAR); + c = mod->cmds; + while ((c != NIL && __STRCMP(c->name, name) != 0)) { + c = c->next; + } + if (c != NIL) { + Modules_res = 0; + Modules_resMsg[0] = 0x00; + _o_result = c->cmd; + __DEL(name); + return _o_result; + } else { + Modules_res = 2; + __MOVE(" command \"", Modules_resMsg, 11); + __COPY(name, Modules_importing, ((LONGINT)(20))); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), mod->name, ((LONGINT)(20))); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)".", (LONGINT)2); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), name, name__len); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)"\" not found", (LONGINT)12); + _o_result = NIL; + __DEL(name); + return _o_result; + } + __RETCHK; +} + +void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all) +{ + Modules_Module m = NIL, p = NIL; + __DUP(name, name__len, CHAR); + m = Modules_modules(); + if (all) { + Modules_res = 1; + __MOVE("unloading \"all\" not yet supported", Modules_resMsg, 34); + } else { + while ((m != NIL && __STRCMP(m->name, name) != 0)) { + p = m; + m = m->next; + } + if ((m != NIL && m->refcnt == 0)) { + if (m == Modules_modules()) { + Modules_setmodules(m->next); + } else { + p->next = m->next; + } + Modules_res = 0; + } else { + Modules_res = 1; + if (m == NIL) { + __MOVE("module not found", Modules_resMsg, 17); + } else { + __MOVE("clients of this module exist", Modules_resMsg, 29); + } + } + } + __DEL(name); +} + +__TDESC(Modules_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 48), {0, 28, -12}}; +__TDESC(Modules_CmdDesc, 1, 1) = {__TDFLDS("CmdDesc", 32), {0, -8}}; + +export void *Modules__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Console); + __MODULE_IMPORT(Heap); + __REGMOD("Modules", 0); + __INITYP(Modules_ModuleDesc, Modules_ModuleDesc, 0); + __INITYP(Modules_CmdDesc, Modules_CmdDesc, 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-44/Modules.h b/bootstrap/unix-44/Modules.h new file mode 100644 index 00000000..5968d1aa --- /dev/null +++ b/bootstrap/unix-44/Modules.h @@ -0,0 +1,54 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Modules__h +#define Modules__h + +#include "SYSTEM.h" + +typedef + struct Modules_CmdDesc *Modules_Cmd; + +typedef + void (*Modules_Command)(void); + +typedef + struct Modules_CmdDesc { + Modules_Cmd next; + CHAR name[24]; + Modules_Command cmd; + } Modules_CmdDesc; + +typedef + struct Modules_ModuleDesc *Modules_Module; + +typedef + CHAR Modules_ModuleName[20]; + +typedef + struct Modules_ModuleDesc { + Modules_Module next; + Modules_ModuleName name; + LONGINT refcnt; + Modules_Cmd cmds; + LONGINT types; + void (*enumPtrs)(void(*)(LONGINT)); + char _prvt0[8]; + } Modules_ModuleDesc; + + +import INTEGER Modules_res; +import CHAR Modules_resMsg[256]; +import Modules_ModuleName Modules_imported, Modules_importing; + +import LONGINT *Modules_ModuleDesc__typ; +import LONGINT *Modules_CmdDesc__typ; + +import void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all); +import Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len); +import Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len); +import void *Modules__init(void); + +#define Modules_modules() (Modules_Module)Heap_modules +#define Modules_setmodules(m) Heap_modules = m + +#endif diff --git a/bootstrap/unix-44/OPB.c b/bootstrap/unix-44/OPB.c new file mode 100644 index 00000000..0c22a7a7 --- /dev/null +++ b/bootstrap/unix-44/OPB.c @@ -0,0 +1,2677 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "OPM.h" +#include "OPS.h" +#include "OPT.h" + + +export void (*OPB_typSize)(OPT_Struct); +static INTEGER OPB_exp; +static LONGINT OPB_maxExp; + + +export void OPB_Assign (OPT_Node *x, OPT_Node y); +static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node y); +static LONGINT OPB_BoolToInt (BOOLEAN b); +export void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp); +static void OPB_CharToString (OPT_Node n); +static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode); +static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo); +export void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames); +static void OPB_CheckProc (OPT_Struct x, OPT_Object y); +static void OPB_CheckPtr (OPT_Node x, OPT_Node y); +static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x); +static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp); +static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y); +export void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y); +static void OPB_Convert (OPT_Node *x, OPT_Struct typ); +export void OPB_DeRef (OPT_Node *x); +static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar); +export OPT_Node OPB_EmptySet (void); +export void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc); +export void OPB_Field (OPT_Node *x, OPT_Object y); +export void OPB_In (OPT_Node *x, OPT_Node y); +export void OPB_Index (OPT_Node *x, OPT_Node y); +export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ); +static BOOLEAN OPB_IntToBool (LONGINT i); +export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y); +export void OPB_MOp (SHORTINT op, OPT_Node *x); +export OPT_Node OPB_NewBoolConst (BOOLEAN boolval); +export OPT_Node OPB_NewIntConst (LONGINT intval); +export OPT_Node OPB_NewLeaf (OPT_Object obj); +export OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ); +export OPT_Node OPB_NewString (OPS_String str, LONGINT len); +export OPT_Node OPB_Nil (void); +static BOOLEAN OPB_NotVar (OPT_Node x); +export void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y); +export void OPB_OptIf (OPT_Node *x); +export void OPB_Param (OPT_Node ap, OPT_Object fp); +export void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar); +export void OPB_Return (OPT_Node *x, OPT_Object proc); +export void OPB_SetElem (OPT_Node *x); +static void OPB_SetIntType (OPT_Node node); +export void OPB_SetRange (OPT_Node *x, OPT_Node y); +export void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno); +export void OPB_StPar0 (OPT_Node *par0, INTEGER fctno); +export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno); +export void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n); +export void OPB_StaticLink (SHORTINT dlev); +export void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard); +static void OPB_err (INTEGER n); +static LONGINT OPB_log (LONGINT x); + + +static void OPB_err (INTEGER n) +{ + OPM_err(n); +} + +OPT_Node OPB_NewLeaf (OPT_Object obj) +{ + OPT_Node _o_result; + OPT_Node node = NIL; + switch (obj->mode) { + case 1: + node = OPT_NewNode(0); + node->readonly = (obj->vis == 2 && obj->mnolev < 0); + break; + case 2: + node = OPT_NewNode(1); + break; + case 3: + node = OPT_NewNode(7); + node->conval = OPT_NewConst(); + __GUARDEQP(node->conval, OPT_ConstDesc) = *obj->conval; + break; + case 5: + node = OPT_NewNode(8); + break; + case 6: case 7: case 8: case 9: case 10: + node = OPT_NewNode(9); + break; + default: + OPB_err(127); + node = OPT_NewNode(0); + break; + } + node->obj = obj; + node->typ = obj->typ; + _o_result = node; + return _o_result; +} + +void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y) +{ + OPT_Node node = NIL; + node = OPT_NewNode(class); + node->typ = OPT_notyp; + node->left = *x; + node->right = y; + *x = node; +} + +void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y) +{ + if (*x == NIL) { + *x = y; + } else { + (*last)->link = y; + } + while (y->link != NIL) { + y = y->link; + } + *last = y; +} + +static LONGINT OPB_BoolToInt (BOOLEAN b) +{ + LONGINT _o_result; + if (b) { + _o_result = 1; + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +static BOOLEAN OPB_IntToBool (LONGINT i) +{ + BOOLEAN _o_result; + if (i == 0) { + _o_result = 0; + return _o_result; + } else { + _o_result = 1; + return _o_result; + } + __RETCHK; +} + +OPT_Node OPB_NewBoolConst (BOOLEAN boolval) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->typ = OPT_booltyp; + x->conval = OPT_NewConst(); + x->conval->intval = OPB_BoolToInt(boolval); + _o_result = x; + return _o_result; +} + +void OPB_OptIf (OPT_Node *x) +{ + OPT_Node if_ = NIL, pred = NIL; + if_ = (*x)->left; + while (if_->left->class == 7) { + if (OPB_IntToBool(if_->left->conval->intval)) { + *x = if_->right; + return; + } else if (if_->link == NIL) { + *x = (*x)->right; + return; + } else { + if_ = if_->link; + (*x)->left = if_; + } + } + pred = if_; + if_ = if_->link; + while (if_ != NIL) { + if (if_->left->class == 7) { + if (OPB_IntToBool(if_->left->conval->intval)) { + pred->link = NIL; + (*x)->right = if_->right; + return; + } else { + if_ = if_->link; + pred->link = if_; + } + } else { + pred = if_; + if_ = if_->link; + } + } +} + +OPT_Node OPB_Nil (void) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->typ = OPT_niltyp; + x->conval = OPT_NewConst(); + x->conval->intval = 0; + _o_result = x; + return _o_result; +} + +OPT_Node OPB_EmptySet (void) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->typ = OPT_settyp; + x->conval = OPT_NewConst(); + x->conval->setval = 0x0; + _o_result = x; + return _o_result; +} + +static void OPB_SetIntType (OPT_Node node) +{ + LONGINT v; + v = node->conval->intval; + if ((OPM_MinSInt <= (LONGINT)v && (LONGINT)v <= OPM_MaxSInt)) { + node->typ = OPT_sinttyp; + } else if ((OPM_MinInt <= (LONGINT)v && (LONGINT)v <= OPM_MaxInt)) { + node->typ = OPT_inttyp; + } else if ((OPM_MinLInt <= v && v <= OPM_MaxLInt)) { + node->typ = OPT_linttyp; + } else { + OPB_err(203); + node->typ = OPT_sinttyp; + node->conval->intval = 1; + } +} + +OPT_Node OPB_NewIntConst (LONGINT intval) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->conval = OPT_NewConst(); + x->conval->intval = intval; + OPB_SetIntType(x); + _o_result = x; + return _o_result; +} + +OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->conval = OPT_NewConst(); + x->conval->realval = realval; + x->typ = typ; + x->conval->intval = -1; + _o_result = x; + return _o_result; +} + +OPT_Node OPB_NewString (OPS_String str, LONGINT len) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->conval = OPT_NewConst(); + x->typ = OPT_stringtyp; + x->conval->intval = -1; + x->conval->intval2 = len; + x->conval->ext = OPT_NewExt(); + __COPY(str, *x->conval->ext, ((LONGINT)(256))); + _o_result = x; + return _o_result; +} + +static void OPB_CharToString (OPT_Node n) +{ + CHAR ch; + n->typ = OPT_stringtyp; + ch = (CHAR)n->conval->intval; + n->conval->ext = OPT_NewExt(); + if (ch == 0x00) { + n->conval->intval2 = 1; + } else { + n->conval->intval2 = 2; + (*n->conval->ext)[1] = 0x00; + } + (*n->conval->ext)[0] = ch; + n->conval->intval = -1; + n->obj = NIL; +} + +static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node y) +{ + OPT_Node node = NIL; + node = OPT_NewNode(class); + node->typ = typ; + node->left = *x; + node->right = y; + *x = node; +} + +static BOOLEAN OPB_NotVar (OPT_Node x) +{ + BOOLEAN _o_result; + _o_result = (x->class >= 7 && ((x->class != 11 || x->subcl != 29) || x->left->class >= 7)); + return _o_result; +} + +void OPB_DeRef (OPT_Node *x) +{ + OPT_Object strobj = NIL, bstrobj = NIL; + OPT_Struct typ = NIL, btyp = NIL; + typ = (*x)->typ; + if ((*x)->class >= 7) { + OPB_err(78); + } else if (typ->form == 13) { + if (typ == OPT_sysptrtyp) { + OPB_err(57); + } + btyp = typ->BaseTyp; + strobj = typ->strobj; + bstrobj = btyp->strobj; + if ((((((strobj != NIL && strobj->name[0] != 0x00)) && bstrobj != NIL)) && bstrobj->name[0] != 0x00)) { + btyp->pbused = 1; + } + OPB_BindNodes(3, btyp, &*x, NIL); + } else { + OPB_err(84); + } +} + +void OPB_Index (OPT_Node *x, OPT_Node y) +{ + INTEGER f; + OPT_Struct typ = NIL; + f = y->typ->form; + if ((*x)->class >= 7) { + OPB_err(79); + } else if (!__IN(f, 0x70) || __IN(y->class, 0x0300)) { + OPB_err(80); + y->typ = OPT_inttyp; + } + if ((*x)->typ->comp == 2) { + typ = (*x)->typ->BaseTyp; + if ((y->class == 7 && (y->conval->intval < 0 || y->conval->intval >= (*x)->typ->n))) { + OPB_err(81); + } + } else if ((*x)->typ->comp == 3) { + typ = (*x)->typ->BaseTyp; + if ((y->class == 7 && y->conval->intval < 0)) { + OPB_err(81); + } + } else { + OPB_err(82); + typ = OPT_undftyp; + } + OPB_BindNodes(4, typ, &*x, y); + (*x)->readonly = (*x)->left->readonly; +} + +void OPB_Field (OPT_Node *x, OPT_Object y) +{ + if ((*x)->class >= 7) { + OPB_err(77); + } + if ((y != NIL && __IN(y->mode, 0x2010))) { + OPB_BindNodes(2, y->typ, &*x, NIL); + (*x)->obj = y; + (*x)->readonly = (*x)->left->readonly || (y->vis == 2 && y->mnolev < 0); + } else { + OPB_err(83); + (*x)->typ = OPT_undftyp; + } +} + +static struct TypTest__57 { + OPT_Node *x; + OPT_Object *obj; + BOOLEAN *guard; + struct TypTest__57 *lnk; +} *TypTest__57_s; + +static void GTT__58 (OPT_Struct t0, OPT_Struct t1); + +static void GTT__58 (OPT_Struct t0, OPT_Struct t1) +{ + OPT_Node node = NIL; + OPT_Struct t = NIL; + t = t0; + while ((((t != NIL && t != t1)) && t != OPT_undftyp)) { + t = t->BaseTyp; + } + if (t != t1) { + while ((((t1 != NIL && t1 != t0)) && t1 != OPT_undftyp)) { + t1 = t1->BaseTyp; + } + if (t1 == t0 || t0->form == 0) { + if (*TypTest__57_s->guard) { + OPB_BindNodes(5, NIL, &*TypTest__57_s->x, NIL); + (*TypTest__57_s->x)->readonly = (*TypTest__57_s->x)->left->readonly; + } else { + node = OPT_NewNode(11); + node->subcl = 16; + node->left = *TypTest__57_s->x; + node->obj = *TypTest__57_s->obj; + *TypTest__57_s->x = node; + } + } else { + OPB_err(85); + } + } else if (t0 != t1) { + OPB_err(85); + } else if (!*TypTest__57_s->guard) { + if ((*TypTest__57_s->x)->class == 5) { + node = OPT_NewNode(11); + node->subcl = 16; + node->left = *TypTest__57_s->x; + node->obj = *TypTest__57_s->obj; + *TypTest__57_s->x = node; + } else { + *TypTest__57_s->x = OPB_NewBoolConst(1); + } + } +} + +void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard) +{ + struct TypTest__57 _s; + _s.x = x; + _s.obj = &obj; + _s.guard = &guard; + _s.lnk = TypTest__57_s; + TypTest__57_s = &_s; + if (OPB_NotVar(*x)) { + OPB_err(112); + } else if ((*x)->typ->form == 13) { + if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) { + OPB_err(85); + } else if (obj->typ->form == 13) { + GTT__58((*x)->typ->BaseTyp, obj->typ->BaseTyp); + } else { + OPB_err(86); + } + } else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) { + GTT__58((*x)->typ, obj->typ); + } else { + OPB_err(87); + } + if (guard) { + (*x)->typ = obj->typ; + } else { + (*x)->typ = OPT_booltyp; + } + TypTest__57_s = _s.lnk; +} + +void OPB_In (OPT_Node *x, OPT_Node y) +{ + INTEGER f; + LONGINT k; + f = (*x)->typ->form; + if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) { + OPB_err(126); + } else if ((__IN(f, 0x70) && y->typ->form == 9)) { + if ((*x)->class == 7) { + k = (*x)->conval->intval; + if (k < 0 || k > (LONGINT)OPM_MaxSet) { + OPB_err(202); + } else if (y->class == 7) { + (*x)->conval->intval = OPB_BoolToInt(__IN(k, y->conval->setval)); + (*x)->obj = NIL; + } else { + OPB_BindNodes(12, OPT_booltyp, &*x, y); + (*x)->subcl = 15; + } + } else { + OPB_BindNodes(12, OPT_booltyp, &*x, y); + (*x)->subcl = 15; + } + } else { + OPB_err(92); + } + (*x)->typ = OPT_booltyp; +} + +static LONGINT OPB_log (LONGINT x) +{ + LONGINT _o_result; + OPB_exp = 0; + if (x > 0) { + while (!__ODD(x)) { + x = __ASHR(x, 1); + OPB_exp += 1; + } + } + _o_result = x; + return _o_result; +} + +static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x) +{ + LONGREAL min, max, r; + if (f == 7) { + min = OPM_MinReal; + max = OPM_MaxReal; + } else { + min = OPM_MinLReal; + max = OPM_MaxLReal; + } + r = __ABS(x->realval); + if (r > max || r < min) { + OPB_err(nr); + x->realval = (LONGREAL)1; + } else if (f == 7) { + x->realval = x->realval; + } + x->intval = -1; +} + +static struct MOp__28 { + struct MOp__28 *lnk; +} *MOp__28_s; + +static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z); + +static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z) +{ + OPT_Node _o_result; + OPT_Node node = NIL; + node = OPT_NewNode(11); + node->subcl = op; + node->typ = typ; + node->left = z; + _o_result = node; + return _o_result; +} + +void OPB_MOp (SHORTINT op, OPT_Node *x) +{ + INTEGER f; + OPT_Struct typ = NIL; + OPT_Node z = NIL; + struct MOp__28 _s; + _s.lnk = MOp__28_s; + MOp__28_s = &_s; + z = *x; + if (z->class == 8 || z->class == 9) { + OPB_err(126); + } else { + typ = z->typ; + f = typ->form; + switch (op) { + case 33: + if (f == 2) { + if (z->class == 7) { + z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval)); + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(98); + } + break; + case 6: + if (!__IN(f, 0x01f0)) { + OPB_err(96); + } + break; + case 7: + if (__IN(f, 0x03f0)) { + if (z->class == 7) { + if (__IN(f, 0x70)) { + if (z->conval->intval == (-2147483647-1)) { + OPB_err(203); + } else { + z->conval->intval = -z->conval->intval; + OPB_SetIntType(z); + } + } else if (__IN(f, 0x0180)) { + z->conval->realval = -z->conval->realval; + } else { + z->conval->setval = ~z->conval->setval; + } + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(97); + } + break; + case 21: + if (__IN(f, 0x01f0)) { + if (z->class == 7) { + if (__IN(f, 0x70)) { + if (z->conval->intval == (-2147483647-1)) { + OPB_err(203); + } else { + z->conval->intval = __ABS(z->conval->intval); + OPB_SetIntType(z); + } + } else { + z->conval->realval = __ABS(z->conval->realval); + } + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(111); + } + break; + case 22: + if (f == 3) { + if (z->class == 7) { + z->conval->intval = (int)__CAP((CHAR)z->conval->intval); + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(111); + z->typ = OPT_chartyp; + } + break; + case 23: + if (__IN(f, 0x70)) { + if (z->class == 7) { + z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval)); + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(111); + } + z->typ = OPT_booltyp; + break; + case 24: + if ((((z->class == 7 && f == 3)) && z->conval->intval >= 32)) { + OPB_CharToString(z); + f = 10; + } + if (z->class < 7 || f == 10) { + z = NewOp__29(op, typ, z); + } else { + OPB_err(127); + } + z->typ = OPT_linttyp; + break; + case 25: + if ((__IN(f, 0x70) && z->class == 7)) { + if ((0 <= z->conval->intval && z->conval->intval <= -1)) { + z = NewOp__29(op, typ, z); + } else { + OPB_err(219); + } + } else { + OPB_err(69); + } + z->typ = OPT_booltyp; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.MOp, op = ", (LONGINT)33); + OPM_LogWNum(op, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } + *x = z; + MOp__28_s = _s.lnk; +} + +static void OPB_CheckPtr (OPT_Node x, OPT_Node y) +{ + INTEGER g; + OPT_Struct p = NIL, q = NIL, t = NIL; + g = y->typ->form; + if (g == 13) { + p = x->typ->BaseTyp; + q = y->typ->BaseTyp; + if ((p->comp == 4 && q->comp == 4)) { + if (p->extlev < q->extlev) { + t = p; + p = q; + q = t; + } + while ((((p != q && p != NIL)) && p != OPT_undftyp)) { + p = p->BaseTyp; + } + if (p == NIL) { + OPB_err(100); + } + } else { + OPB_err(100); + } + } else if (g != 11) { + OPB_err(100); + } +} + +void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames) +{ + OPT_Struct ft = NIL, at = NIL; + while (fp != NIL) { + if (ap != NIL) { + ft = fp->typ; + at = ap->typ; + while ((ft->comp == 3 && at->comp == 3)) { + ft = ft->BaseTyp; + at = at->BaseTyp; + } + if (ft != at) { + if ((ft->form == 14 && at->form == 14)) { + if (ft->BaseTyp == at->BaseTyp) { + OPB_CheckParameters(ft->link, at->link, 0); + } else { + OPB_err(117); + } + } else { + OPB_err(115); + } + } + if (fp->mode != ap->mode || (checkNames && __STRCMP(fp->name, ap->name) != 0)) { + OPB_err(115); + } + ap = ap->link; + } else { + OPB_err(116); + } + fp = fp->link; + } + if (ap != NIL) { + OPB_err(116); + } +} + +static void OPB_CheckProc (OPT_Struct x, OPT_Object y) +{ + if (__IN(y->mode, 0x04c0)) { + if (y->mode == 6) { + if (y->mnolev == 0) { + y->mode = 7; + } else { + OPB_err(73); + } + } + if (x->BaseTyp == y->typ) { + OPB_CheckParameters(x->link, y->link, 0); + } else { + OPB_err(117); + } + } else { + OPB_err(113); + } +} + +static struct ConstOp__13 { + OPT_Node *x; + INTEGER *f; + OPT_Const *xval, *yval; + struct ConstOp__13 *lnk; +} *ConstOp__13_s; + +static INTEGER ConstCmp__14 (void); + +static INTEGER ConstCmp__14 (void) +{ + INTEGER _o_result; + INTEGER res; + switch (*ConstOp__13_s->f) { + case 0: + res = 9; + break; + case 1: case 3: case 4: case 5: case 6: + if ((*ConstOp__13_s->xval)->intval < (*ConstOp__13_s->yval)->intval) { + res = 11; + } else if ((*ConstOp__13_s->xval)->intval > (*ConstOp__13_s->yval)->intval) { + res = 13; + } else { + res = 9; + } + break; + case 7: case 8: + if ((*ConstOp__13_s->xval)->realval < (*ConstOp__13_s->yval)->realval) { + res = 11; + } else if ((*ConstOp__13_s->xval)->realval > (*ConstOp__13_s->yval)->realval) { + res = 13; + } else { + res = 9; + } + break; + case 2: + if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) { + res = 10; + } else { + res = 9; + } + break; + case 9: + if ((*ConstOp__13_s->xval)->setval != (*ConstOp__13_s->yval)->setval) { + res = 10; + } else { + res = 9; + } + break; + case 10: + if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) < 0) { + res = 11; + } else if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) > 0) { + res = 13; + } else { + res = 9; + } + break; + case 11: case 13: case 14: + if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) { + res = 10; + } else { + res = 9; + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", (LONGINT)37); + OPM_LogWNum(*ConstOp__13_s->f, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + (*ConstOp__13_s->x)->typ = OPT_booltyp; + _o_result = res; + return _o_result; +} + +static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y) +{ + INTEGER f, g; + OPT_Const xval = NIL, yval = NIL; + LONGINT xv, yv; + BOOLEAN temp; + struct ConstOp__13 _s; + _s.x = &x; + _s.f = &f; + _s.xval = &xval; + _s.yval = &yval; + _s.lnk = ConstOp__13_s; + ConstOp__13_s = &_s; + f = x->typ->form; + g = y->typ->form; + xval = x->conval; + yval = y->conval; + if (f != g) { + switch (f) { + case 3: + if (g == 10) { + OPB_CharToString(x); + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 4: + if (__IN(g, 0x70)) { + x->typ = y->typ; + } else if (g == 7) { + x->typ = OPT_realtyp; + xval->realval = xval->intval; + } else if (g == 8) { + x->typ = OPT_lrltyp; + xval->realval = xval->intval; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 5: + if (g == 4) { + y->typ = OPT_inttyp; + } else if (__IN(g, 0x70)) { + x->typ = y->typ; + } else if (g == 7) { + x->typ = OPT_realtyp; + xval->realval = xval->intval; + } else if (g == 8) { + x->typ = OPT_lrltyp; + xval->realval = xval->intval; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 6: + if (__IN(g, 0x70)) { + y->typ = OPT_linttyp; + } else if (g == 7) { + x->typ = OPT_realtyp; + xval->realval = xval->intval; + } else if (g == 8) { + x->typ = OPT_lrltyp; + xval->realval = xval->intval; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 7: + if (__IN(g, 0x70)) { + y->typ = x->typ; + yval->realval = yval->intval; + } else if (g == 8) { + x->typ = OPT_lrltyp; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 8: + if (__IN(g, 0x70)) { + y->typ = x->typ; + yval->realval = yval->intval; + } else if (g == 7) { + y->typ = OPT_lrltyp; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 10: + if (g == 3) { + OPB_CharToString(y); + g = 10; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 11: + if (!__IN(g, 0x6000)) { + OPB_err(100); + } + break; + case 13: + OPB_CheckPtr(x, y); + break; + case 14: + if (g != 11) { + OPB_err(100); + } + break; + default: + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + break; + } + f = x->typ->form; + } + switch (op) { + case 1: + if (__IN(f, 0x70)) { + xv = xval->intval; + yv = yval->intval; + if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(2147483647, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-2147483647-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-2147483647-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-2147483647-1))) && yv != (-2147483647-1))) && -xv <= __DIV(2147483647, -yv))) { + xval->intval = xv * yv; + OPB_SetIntType(x); + } else { + OPB_err(204); + } + } else if (__IN(f, 0x0180)) { + temp = __ABS(yval->realval) <= (LONGREAL)1; + if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 / (LONGREAL)__ABS(yval->realval)) { + xval->realval = xval->realval * yval->realval; + OPB_CheckRealType(f, 204, xval); + } else { + OPB_err(204); + } + } else if (f == 9) { + xval->setval = (xval->setval & yval->setval); + } else if (f != 0) { + OPB_err(101); + } + break; + case 2: + if (__IN(f, 0x70)) { + if (yval->intval != 0) { + xval->realval = xval->intval / (REAL)yval->intval; + OPB_CheckRealType(7, 205, xval); + } else { + OPB_err(205); + xval->realval = (LONGREAL)1; + } + x->typ = OPT_realtyp; + } else if (__IN(f, 0x0180)) { + temp = __ABS(yval->realval) >= (LONGREAL)1; + if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 * __ABS(yval->realval)) { + xval->realval = xval->realval / yval->realval; + OPB_CheckRealType(f, 205, xval); + } else { + OPB_err(205); + } + } else if (f == 9) { + xval->setval = xval->setval ^ yval->setval; + } else if (f != 0) { + OPB_err(102); + } + break; + case 3: + if (__IN(f, 0x70)) { + if (yval->intval != 0) { + xval->intval = __DIV(xval->intval, yval->intval); + OPB_SetIntType(x); + } else { + OPB_err(205); + } + } else if (f != 0) { + OPB_err(103); + } + break; + case 4: + if (__IN(f, 0x70)) { + if (yval->intval != 0) { + xval->intval = __MOD(xval->intval, yval->intval); + OPB_SetIntType(x); + } else { + OPB_err(205); + } + } else if (f != 0) { + OPB_err(104); + } + break; + case 5: + if (f == 2) { + xval->intval = OPB_BoolToInt((OPB_IntToBool(xval->intval) && OPB_IntToBool(yval->intval))); + } else { + OPB_err(94); + } + break; + case 6: + if (__IN(f, 0x70)) { + temp = (yval->intval >= 0 && xval->intval <= 2147483647 - yval->intval); + if (temp || (yval->intval < 0 && xval->intval >= (-2147483647-1) - yval->intval)) { + xval->intval += yval->intval; + OPB_SetIntType(x); + } else { + OPB_err(206); + } + } else if (__IN(f, 0x0180)) { + temp = (yval->realval >= (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 - yval->realval); + if (temp || (yval->realval < (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 - yval->realval)) { + xval->realval = xval->realval + yval->realval; + OPB_CheckRealType(f, 206, xval); + } else { + OPB_err(206); + } + } else if (f == 9) { + xval->setval = xval->setval | yval->setval; + } else if (f != 0) { + OPB_err(105); + } + break; + case 7: + if (__IN(f, 0x70)) { + if ((yval->intval >= 0 && xval->intval >= (-2147483647-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 2147483647 + yval->intval)) { + xval->intval -= yval->intval; + OPB_SetIntType(x); + } else { + OPB_err(207); + } + } else if (__IN(f, 0x0180)) { + temp = (yval->realval >= (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 + yval->realval); + if (temp || (yval->realval < (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 + yval->realval)) { + xval->realval = xval->realval - yval->realval; + OPB_CheckRealType(f, 207, xval); + } else { + OPB_err(207); + } + } else if (f == 9) { + xval->setval = (xval->setval & ~yval->setval); + } else if (f != 0) { + OPB_err(106); + } + break; + case 8: + if (f == 2) { + xval->intval = OPB_BoolToInt(OPB_IntToBool(xval->intval) || OPB_IntToBool(yval->intval)); + } else { + OPB_err(95); + } + break; + case 9: + xval->intval = OPB_BoolToInt(ConstCmp__14() == 9); + break; + case 10: + xval->intval = OPB_BoolToInt(ConstCmp__14() != 9); + break; + case 11: + if (__IN(f, 0x2a04)) { + OPB_err(108); + } else { + xval->intval = OPB_BoolToInt(ConstCmp__14() == 11); + } + break; + case 12: + if (__IN(f, 0x2a04)) { + OPB_err(108); + } else { + xval->intval = OPB_BoolToInt(ConstCmp__14() != 13); + } + break; + case 13: + if (__IN(f, 0x2a04)) { + OPB_err(108); + } else { + xval->intval = OPB_BoolToInt(ConstCmp__14() == 13); + } + break; + case 14: + if (__IN(f, 0x2a04)) { + OPB_err(108); + } else { + xval->intval = OPB_BoolToInt(ConstCmp__14() != 11); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstOp, op = ", (LONGINT)37); + OPM_LogWNum(op, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + ConstOp__13_s = _s.lnk; +} + +static void OPB_Convert (OPT_Node *x, OPT_Struct typ) +{ + OPT_Node node = NIL; + INTEGER f, g; + LONGINT k; + LONGREAL r; + f = (*x)->typ->form; + g = typ->form; + if ((*x)->class == 7) { + if (__IN(f, 0x70)) { + if (__IN(g, 0x70)) { + if (f > g) { + OPB_SetIntType(*x); + if ((int)(*x)->typ->form > g) { + OPB_err(203); + (*x)->conval->intval = 1; + } + } + } else if (__IN(g, 0x0180)) { + (*x)->conval->realval = (*x)->conval->intval; + (*x)->conval->intval = -1; + } else { + k = (*x)->conval->intval; + if (0 > k || k > 255) { + OPB_err(220); + } + } + } else if (__IN(f, 0x0180)) { + if (__IN(g, 0x0180)) { + OPB_CheckRealType(g, 203, (*x)->conval); + } else { + r = (*x)->conval->realval; + if (r < -2.14748364800000e+009 || r > 2.14748364700000e+009) { + OPB_err(203); + r = (LONGREAL)1; + } + (*x)->conval->intval = __ENTIER(r); + OPB_SetIntType(*x); + } + } + (*x)->obj = NIL; + } else if (((((*x)->class == 11 && (*x)->subcl == 20)) && ((int)(*x)->left->typ->form < f || f > g))) { + if ((*x)->left->typ == typ) { + *x = (*x)->left; + } + } else { + node = OPT_NewNode(11); + node->subcl = 20; + node->left = *x; + *x = node; + } + (*x)->typ = typ; +} + +static struct Op__38 { + INTEGER *f, *g; + struct Op__38 *lnk; +} *Op__38_s; + +static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y); +static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y); + +static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y) +{ + OPT_Node node = NIL; + node = OPT_NewNode(12); + node->subcl = op; + node->typ = typ; + node->left = *x; + node->right = y; + *x = node; +} + +static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y) +{ + BOOLEAN _o_result; + BOOLEAN ok, xCharArr, yCharArr; + xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 10; + yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 10; + if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) { + OPB_CharToString(*y); + *Op__38_s->g = 10; + yCharArr = 1; + } + if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) { + OPB_CharToString(*x); + *Op__38_s->f = 10; + xCharArr = 1; + } + ok = (xCharArr && yCharArr); + if (ok) { + if ((*Op__38_s->f == 10 && (*x)->conval->intval2 == 1)) { + (*x)->typ = OPT_chartyp; + (*x)->conval->intval = 0; + OPB_Index(&*y, OPB_NewIntConst(((LONGINT)(0)))); + } else if ((*Op__38_s->g == 10 && (*y)->conval->intval2 == 1)) { + (*y)->typ = OPT_chartyp; + (*y)->conval->intval = 0; + OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0)))); + } + } + _o_result = ok; + return _o_result; +} + +void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y) +{ + INTEGER f, g; + OPT_Node t = NIL, z = NIL; + OPT_Struct typ = NIL; + BOOLEAN do_; + LONGINT val; + struct Op__38 _s; + _s.f = &f; + _s.g = &g; + _s.lnk = Op__38_s; + Op__38_s = &_s; + z = *x; + if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) { + OPB_err(126); + } else if ((z->class == 7 && y->class == 7)) { + OPB_ConstOp(op, z, y); + z->obj = NIL; + } else { + if (z->typ != y->typ) { + g = y->typ->form; + switch (z->typ->form) { + case 3: + if (z->class == 7) { + OPB_CharToString(z); + } else { + OPB_err(100); + } + break; + case 4: + if (__IN(g, 0x01f0)) { + OPB_Convert(&z, y->typ); + } else { + OPB_err(100); + } + break; + case 5: + if (g == 4) { + OPB_Convert(&y, z->typ); + } else if (__IN(g, 0x01f0)) { + OPB_Convert(&z, y->typ); + } else { + OPB_err(100); + } + break; + case 6: + if (__IN(g, 0x70)) { + OPB_Convert(&y, z->typ); + } else if (__IN(g, 0x0180)) { + OPB_Convert(&z, y->typ); + } else { + OPB_err(100); + } + break; + case 7: + if (__IN(g, 0x70)) { + OPB_Convert(&y, z->typ); + } else if (__IN(g, 0x0180)) { + OPB_Convert(&z, y->typ); + } else { + OPB_err(100); + } + break; + case 8: + if (__IN(g, 0x01f0)) { + OPB_Convert(&y, z->typ); + } else if (__IN(g, 0x0180)) { + OPB_Convert(&y, z->typ); + } else { + OPB_err(100); + } + break; + case 11: + if (!__IN(g, 0x6000)) { + OPB_err(100); + } + break; + case 13: + OPB_CheckPtr(z, y); + break; + case 14: + if (g != 11) { + OPB_err(100); + } + break; + case 10: + break; + case 15: + if (z->typ->comp == 4) { + OPB_err(100); + } + break; + default: + OPB_err(100); + break; + } + } + typ = z->typ; + f = typ->form; + g = y->typ->form; + switch (op) { + case 1: + do_ = 1; + if (__IN(f, 0x70)) { + if (z->class == 7) { + val = z->conval->intval; + if (val == 1) { + do_ = 0; + z = y; + } else if (val == 0) { + do_ = 0; + } else if (OPB_log(val) == 1) { + t = y; + y = z; + z = t; + op = 17; + y->typ = OPT_sinttyp; + y->conval->intval = OPB_exp; + y->obj = NIL; + } + } else if (y->class == 7) { + val = y->conval->intval; + if (val == 1) { + do_ = 0; + } else if (val == 0) { + do_ = 0; + z = y; + } else if (OPB_log(val) == 1) { + op = 17; + y->typ = OPT_sinttyp; + y->conval->intval = OPB_exp; + y->obj = NIL; + } + } + } else if (!__IN(f, 0x0381)) { + OPB_err(105); + typ = OPT_undftyp; + } + if (do_) { + NewOp__39(op, typ, &z, y); + } + break; + case 2: + if (__IN(f, 0x70)) { + if ((y->class == 7 && y->conval->intval == 0)) { + OPB_err(205); + } + OPB_Convert(&z, OPT_realtyp); + OPB_Convert(&y, OPT_realtyp); + typ = OPT_realtyp; + } else if (__IN(f, 0x0180)) { + if ((y->class == 7 && y->conval->realval == (LONGREAL)0)) { + OPB_err(205); + } + } else if ((f != 9 && f != 0)) { + OPB_err(102); + typ = OPT_undftyp; + } + NewOp__39(op, typ, &z, y); + break; + case 3: + do_ = 1; + if (__IN(f, 0x70)) { + if (y->class == 7) { + val = y->conval->intval; + if (val == 0) { + OPB_err(205); + } else if (val == 1) { + do_ = 0; + } else if (OPB_log(val) == 1) { + op = 17; + y->typ = OPT_sinttyp; + y->conval->intval = -OPB_exp; + y->obj = NIL; + } + } + } else if (f != 0) { + OPB_err(103); + typ = OPT_undftyp; + } + if (do_) { + NewOp__39(op, typ, &z, y); + } + break; + case 4: + if (__IN(f, 0x70)) { + if (y->class == 7) { + if (y->conval->intval == 0) { + OPB_err(205); + } else if (OPB_log(y->conval->intval) == 1) { + op = 18; + y->conval->intval = __ASH(-1, OPB_exp); + y->obj = NIL; + } + } + } else if (f != 0) { + OPB_err(104); + typ = OPT_undftyp; + } + NewOp__39(op, typ, &z, y); + break; + case 5: + if (f == 2) { + if (z->class == 7) { + if (OPB_IntToBool(z->conval->intval)) { + z = y; + } + } else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) { + } else { + NewOp__39(op, typ, &z, y); + } + } else if (f != 0) { + OPB_err(94); + z->typ = OPT_undftyp; + } + break; + case 6: + if (!__IN(f, 0x03f1)) { + OPB_err(105); + typ = OPT_undftyp; + } + do_ = 1; + if (__IN(f, 0x70)) { + if ((z->class == 7 && z->conval->intval == 0)) { + do_ = 0; + z = y; + } + if ((y->class == 7 && y->conval->intval == 0)) { + do_ = 0; + } + } + if (do_) { + NewOp__39(op, typ, &z, y); + } + break; + case 7: + if (!__IN(f, 0x03f1)) { + OPB_err(106); + typ = OPT_undftyp; + } + if ((!__IN(f, 0x70) || y->class != 7) || y->conval->intval != 0) { + NewOp__39(op, typ, &z, y); + } + break; + case 8: + if (f == 2) { + if (z->class == 7) { + if (!OPB_IntToBool(z->conval->intval)) { + z = y; + } + } else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) { + } else { + NewOp__39(op, typ, &z, y); + } + } else if (f != 0) { + OPB_err(95); + z->typ = OPT_undftyp; + } + break; + case 9: case 10: + if (__IN(f, 0x6bff) || strings__41(&z, &y)) { + typ = OPT_booltyp; + } else { + OPB_err(107); + typ = OPT_undftyp; + } + NewOp__39(op, typ, &z, y); + break; + case 11: case 12: case 13: case 14: + if (__IN(f, 0x01f9) || strings__41(&z, &y)) { + typ = OPT_booltyp; + } else { + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"ELSE in Op()", (LONGINT)13); + OPM_LogWLn(); + OPB_err(108); + typ = OPT_undftyp; + } + NewOp__39(op, typ, &z, y); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", (LONGINT)32); + OPM_LogWNum(op, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } + *x = z; + Op__38_s = _s.lnk; +} + +void OPB_SetRange (OPT_Node *x, OPT_Node y) +{ + LONGINT k, l; + if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) { + OPB_err(126); + } else if ((__IN((*x)->typ->form, 0x70) && __IN(y->typ->form, 0x70))) { + if ((*x)->class == 7) { + k = (*x)->conval->intval; + if (0 > k || k > (LONGINT)OPM_MaxSet) { + OPB_err(202); + } + } + if (y->class == 7) { + l = y->conval->intval; + if (0 > l || l > (LONGINT)OPM_MaxSet) { + OPB_err(202); + } + } + if (((*x)->class == 7 && y->class == 7)) { + if (k <= l) { + (*x)->conval->setval = __SETRNG(k, l); + } else { + OPB_err(201); + (*x)->conval->setval = __SETRNG(l, k); + } + (*x)->obj = NIL; + } else { + OPB_BindNodes(10, OPT_settyp, &*x, y); + } + } else { + OPB_err(93); + } + (*x)->typ = OPT_settyp; +} + +void OPB_SetElem (OPT_Node *x) +{ + LONGINT k; + if ((*x)->class == 8 || (*x)->class == 9) { + OPB_err(126); + } else if (!__IN((*x)->typ->form, 0x70)) { + OPB_err(93); + } else if ((*x)->class == 7) { + k = (*x)->conval->intval; + if ((0 <= k && k <= (LONGINT)OPM_MaxSet)) { + (*x)->conval->setval = __SETOF(k); + } else { + OPB_err(202); + } + (*x)->obj = NIL; + } else { + OPB_Convert(&*x, OPT_settyp); + } + (*x)->typ = OPT_settyp; +} + +static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode) +{ + INTEGER f, g; + OPT_Struct y = NIL, p = NIL, q = NIL; + if (OPM_Verbose) { + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"PROCEDURE CheckAssign", (LONGINT)22); + OPM_LogWLn(); + } + y = ynode->typ; + f = x->form; + g = y->form; + if (OPM_Verbose) { + OPM_LogWStr((CHAR*)"y.form = ", (LONGINT)10); + OPM_LogWNum(y->form, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"f = ", (LONGINT)5); + OPM_LogWNum(f, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"g = ", (LONGINT)5); + OPM_LogWNum(g, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"ynode.typ.syze = ", (LONGINT)18); + OPM_LogWNum(ynode->typ->size, ((LONGINT)(0))); + OPM_LogWLn(); + } + if (ynode->class == 8 || (ynode->class == 9 && f != 14)) { + OPB_err(126); + } + switch (f) { + case 0: case 10: + break; + case 1: + if (!__IN(g, 0x1a)) { + OPB_err(113); + } + break; + case 2: case 3: case 4: case 9: + if (g != f) { + OPB_err(113); + } + break; + case 5: + if (!__IN(g, 0x30)) { + OPB_err(113); + } + break; + case 6: + if (OPM_LIntSize == 4) { + if (!__IN(g, 0x70)) { + OPB_err(113); + } + } else { + if (!__IN(g, 0x70)) { + OPB_err(113); + } + } + break; + case 7: + if (!__IN(g, 0xf0)) { + OPB_err(113); + } + break; + case 8: + if (!__IN(g, 0x01f0)) { + OPB_err(113); + } + break; + case 13: + if ((x == y || g == 11) || (x == OPT_sysptrtyp && g == 13)) { + } else if (g == 13) { + p = x->BaseTyp; + q = y->BaseTyp; + if ((p->comp == 4 && q->comp == 4)) { + while ((((q != p && q != NIL)) && q != OPT_undftyp)) { + q = q->BaseTyp; + } + if (q == NIL) { + OPB_err(113); + } + } else { + OPB_err(113); + } + } else { + OPB_err(113); + } + break; + case 14: + if (ynode->class == 9) { + OPB_CheckProc(x, ynode->obj); + } else if (x == y || g == 11) { + } else { + OPB_err(113); + } + break; + case 12: case 11: + OPB_err(113); + break; + case 15: + x->pvused = 1; + if (x->comp == 2) { + if ((ynode->class == 7 && g == 3)) { + OPB_CharToString(ynode); + y = ynode->typ; + g = 10; + } + if (x == y) { + } else if (x->BaseTyp == OPT_chartyp) { + if (g == 10) { + if (ynode->conval->intval2 > x->n) { + OPB_err(114); + } + } else if ((__IN(y->comp, 0x0c) && y->BaseTyp == OPT_chartyp)) { + } else { + OPB_err(113); + } + } else { + OPB_err(113); + } + } else if ((x->comp == 3 && x->BaseTyp == OPT_chartyp)) { + if ((__IN(y->comp, 0x0c) && y->BaseTyp == OPT_chartyp)) { + } else { + OPB_err(113); + } + } else if (x->comp == 4) { + if (x == y) { + } else if (y->comp == 4) { + q = y->BaseTyp; + while ((((q != NIL && q != x)) && q != OPT_undftyp)) { + q = q->BaseTyp; + } + if (q == NIL) { + OPB_err(113); + } + } else { + OPB_err(113); + } + } else { + OPB_err(113); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.CheckAssign, f = ", (LONGINT)40); + OPM_LogWNum(f, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + if ((((((ynode->class == 7 && g < f)) && __IN(g, 0xf0))) && __IN(f, 0x01e0))) { + OPB_Convert(&ynode, x); + } +} + +static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo) +{ +} + +void OPB_StPar0 (OPT_Node *par0, INTEGER fctno) +{ + INTEGER f; + OPT_Struct typ = NIL; + OPT_Node x = NIL; + x = *par0; + f = x->typ->form; + switch (fctno) { + case 0: + if ((__IN(f, 0x70) && x->class == 7)) { + if ((0 <= x->conval->intval && x->conval->intval <= 255)) { + OPB_BindNodes(28, OPT_notyp, &x, x); + } else { + OPB_err(218); + } + } else { + OPB_err(69); + } + x->typ = OPT_notyp; + break; + case 1: + typ = OPT_notyp; + if (OPB_NotVar(x)) { + OPB_err(112); + } else if (f == 13) { + if (x->readonly) { + OPB_err(76); + } + f = x->typ->BaseTyp->comp; + if (__IN(f, 0x1c)) { + if (f == 3) { + typ = x->typ->BaseTyp; + } + OPB_BindNodes(19, OPT_notyp, &x, NIL); + x->subcl = 1; + } else { + OPB_err(111); + } + } else { + OPB_err(111); + } + x->typ = typ; + break; + case 2: + OPB_MOp(21, &x); + break; + case 3: + OPB_MOp(22, &x); + break; + case 4: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (f == 3) { + OPB_Convert(&x, OPT_inttyp); + } else { + OPB_err(111); + } + x->typ = OPT_inttyp; + break; + case 5: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x0180)) { + OPB_Convert(&x, OPT_linttyp); + } else { + OPB_err(111); + } + x->typ = OPT_linttyp; + break; + case 6: + OPB_MOp(23, &x); + break; + case 7: + if (x->class == 8) { + switch (f) { + case 2: + x = OPB_NewBoolConst(0); + break; + case 3: + x = OPB_NewIntConst(((LONGINT)(0))); + x->typ = OPT_chartyp; + break; + case 4: + x = OPB_NewIntConst(OPM_MinSInt); + break; + case 5: + x = OPB_NewIntConst(OPM_MinInt); + break; + case 6: + x = OPB_NewIntConst(OPM_MinLInt); + break; + case 9: + x = OPB_NewIntConst(((LONGINT)(0))); + x->typ = OPT_inttyp; + break; + case 7: + x = OPB_NewRealConst(OPM_MinReal, OPT_realtyp); + break; + case 8: + x = OPB_NewRealConst(OPM_MinLReal, OPT_lrltyp); + break; + default: + OPB_err(111); + break; + } + } else { + OPB_err(110); + } + break; + case 8: + if (x->class == 8) { + switch (f) { + case 2: + x = OPB_NewBoolConst(1); + break; + case 3: + x = OPB_NewIntConst(((LONGINT)(255))); + x->typ = OPT_chartyp; + break; + case 4: + x = OPB_NewIntConst(OPM_MaxSInt); + break; + case 5: + x = OPB_NewIntConst(OPM_MaxInt); + break; + case 6: + x = OPB_NewIntConst(OPM_MaxLInt); + break; + case 9: + x = OPB_NewIntConst(OPM_MaxSet); + x->typ = OPT_inttyp; + break; + case 7: + x = OPB_NewRealConst(OPM_MaxReal, OPT_realtyp); + break; + case 8: + x = OPB_NewRealConst(OPM_MaxLReal, OPT_lrltyp); + break; + default: + OPB_err(111); + break; + } + } else { + OPB_err(110); + } + break; + case 9: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x71)) { + OPB_Convert(&x, OPT_chartyp); + } else { + OPB_err(111); + x->typ = OPT_chartyp; + } + break; + case 10: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (f == 5) { + OPB_Convert(&x, OPT_sinttyp); + } else if (f == 6) { + OPB_Convert(&x, OPT_inttyp); + } else if (f == 8) { + OPB_Convert(&x, OPT_realtyp); + } else { + OPB_err(111); + } + break; + case 11: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (f == 4) { + OPB_Convert(&x, OPT_inttyp); + } else if (f == 5) { + OPB_Convert(&x, OPT_linttyp); + } else if (f == 7) { + OPB_Convert(&x, OPT_lrltyp); + } else if (f == 3) { + OPB_Convert(&x, OPT_linttyp); + } else { + OPB_err(111); + } + break; + case 13: case 14: + if (OPB_NotVar(x)) { + OPB_err(112); + } else if (!__IN(f, 0x70)) { + OPB_err(111); + } else if (x->readonly) { + OPB_err(76); + } + break; + case 15: case 16: + if (OPB_NotVar(x)) { + OPB_err(112); + } else if (x->typ != OPT_settyp) { + OPB_err(111); + x->typ = OPT_settyp; + } else if (x->readonly) { + OPB_err(76); + } + break; + case 17: + if (!__IN(x->typ->comp, 0x0c)) { + OPB_err(131); + } + break; + case 18: + if ((x->class == 7 && f == 3)) { + OPB_CharToString(x); + f = 10; + } + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (((!__IN(x->typ->comp, 0x0c) || x->typ->BaseTyp->form != 3) && f != 10)) { + OPB_err(111); + } + break; + case 19: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + if (f != 6) { + OPB_Convert(&x, OPT_linttyp); + } + } else { + OPB_err(111); + x->typ = OPT_linttyp; + } + break; + case 20: + OPB_CheckLeaf(x, 0); + OPB_MOp(24, &x); + break; + case 12: + if (x->class != 8) { + OPB_err(110); + x = OPB_NewIntConst(((LONGINT)(1))); + } else if (__IN(f, 0x63fe) || __IN(x->typ->comp, 0x14)) { + (*OPB_typSize)(x->typ); + x->typ->pvused = 1; + x = OPB_NewIntConst(x->typ->size); + } else { + OPB_err(111); + x = OPB_NewIntConst(((LONGINT)(1))); + } + break; + case 21: + OPB_MOp(25, &x); + break; + case 22: case 23: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (!__IN(f, 0x027a)) { + OPB_err(111); + } + break; + case 24: case 25: case 28: case 31: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if ((x->class == 7 && __IN(f, 0x30))) { + OPB_Convert(&x, OPT_linttyp); + } else if (!__IN(f, 0x2040)) { + OPB_err(111); + x->typ = OPT_linttyp; + } + break; + case 26: case 27: + if ((__IN(f, 0x70) && x->class == 7)) { + if (x->conval->intval < 0 || x->conval->intval > -1) { + OPB_err(220); + } + } else { + OPB_err(69); + } + break; + case 29: + if (x->class != 8) { + OPB_err(110); + } else if (__IN(f, 0x1401) || x->typ->comp == 3) { + OPB_err(111); + } + break; + case 30: + if (OPB_NotVar(x)) { + OPB_err(112); + } else if (f == 13) { + } else { + OPB_err(111); + } + break; + case 32: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + x = OPB_NewBoolConst(0); + } else if (f != 2) { + OPB_err(120); + x = OPB_NewBoolConst(0); + } else { + OPB_MOp(33, &x); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.StPar0, fctno = ", (LONGINT)39); + OPM_LogWNum(fctno, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + *par0 = x; +} + +static struct StPar1__52 { + struct StPar1__52 *lnk; +} *StPar1__52_s; + +static OPT_Node NewOp__53 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right); + +static OPT_Node NewOp__53 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right) +{ + OPT_Node _o_result; + OPT_Node node = NIL; + node = OPT_NewNode(class); + node->subcl = subcl; + node->left = left; + node->right = right; + _o_result = node; + return _o_result; +} + +void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno) +{ + INTEGER f, L; + OPT_Struct typ = NIL; + OPT_Node p = NIL, t = NIL; + struct StPar1__52 _s; + _s.lnk = StPar1__52_s; + StPar1__52_s = &_s; + p = *par0; + f = x->typ->form; + switch (fctno) { + case 13: case 14: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + p->typ = OPT_notyp; + } else { + if (x->typ != p->typ) { + if ((x->class == 7 && __IN(f, 0x70))) { + OPB_Convert(&x, p->typ); + } else { + OPB_err(111); + } + } + p = NewOp__53(19, fctno, p, x); + p->typ = OPT_notyp; + } + break; + case 15: case 16: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (LONGINT)OPM_MaxSet))) { + OPB_err(202); + } + p = NewOp__53(19, fctno, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + break; + case 17: + if (!__IN(f, 0x70) || x->class != 7) { + OPB_err(69); + } else if (f == 4) { + L = (int)x->conval->intval; + typ = p->typ; + while ((L > 0 && __IN(typ->comp, 0x0c))) { + typ = typ->BaseTyp; + L -= 1; + } + if (L != 0 || !__IN(typ->comp, 0x0c)) { + OPB_err(132); + } else { + x->obj = NIL; + if (typ->comp == 3) { + while (p->class == 4) { + p = p->left; + x->conval->intval += 1; + } + p = NewOp__53(12, 19, p, x); + p->typ = OPT_linttyp; + } else { + p = x; + p->conval->intval = typ->n; + OPB_SetIntType(p); + } + } + } else { + OPB_err(132); + } + break; + case 18: + if (OPB_NotVar(x)) { + OPB_err(112); + } else if ((__IN(x->typ->comp, 0x0c) && x->typ->BaseTyp->form == 3)) { + if (x->readonly) { + OPB_err(76); + } + t = x; + x = p; + p = t; + p = NewOp__53(19, 18, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + break; + case 19: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + if ((p->class == 7 && x->class == 7)) { + if (-OPB_maxExp > x->conval->intval || x->conval->intval > OPB_maxExp) { + OPB_err(208); + p->conval->intval = 1; + } else if (x->conval->intval >= 0) { + if (__ABS(p->conval->intval) <= __DIV(2147483647, __ASH(1, x->conval->intval))) { + p->conval->intval = p->conval->intval * __ASH(1, x->conval->intval); + } else { + OPB_err(208); + p->conval->intval = 1; + } + } else { + p->conval->intval = __ASH(p->conval->intval, x->conval->intval); + } + p->obj = NIL; + } else { + p = NewOp__53(12, 17, p, x); + p->typ = OPT_linttyp; + } + } else { + OPB_err(111); + } + break; + case 1: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (p->typ->comp == 3) { + if (__IN(f, 0x70)) { + if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) { + OPB_err(63); + } + } else { + OPB_err(111); + } + p->right = x; + p->typ = p->typ->BaseTyp; + } else { + OPB_err(64); + } + break; + case 22: case 23: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (!__IN(f, 0x70)) { + OPB_err(111); + } else { + if (fctno == 22) { + p = NewOp__53(12, 27, p, x); + } else { + p = NewOp__53(12, 28, p, x); + } + p->typ = p->left->typ; + } + break; + case 24: case 25: case 26: case 27: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x63ff)) { + if (fctno == 24 || fctno == 26) { + if (OPB_NotVar(x)) { + OPB_err(112); + } + t = x; + x = p; + p = t; + } + p = NewOp__53(19, fctno, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + break; + case 28: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + p = NewOp__53(12, 26, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_booltyp; + break; + case 29: + if (((x->class == 8 || x->class == 9) || __IN(f, 0x1401)) || x->typ->comp == 3) { + OPB_err(126); + } + t = OPT_NewNode(11); + t->subcl = 29; + t->left = x; + x = t; + x->typ = p->typ; + p = x; + break; + case 30: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + p = NewOp__53(19, 30, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + break; + case 31: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if ((x->class == 7 && __IN(f, 0x30))) { + OPB_Convert(&x, OPT_linttyp); + } else if (!__IN(f, 0x2040)) { + OPB_err(111); + x->typ = OPT_linttyp; + } + p->link = x; + break; + case 32: + if ((__IN(f, 0x70) && x->class == 7)) { + if ((0 <= x->conval->intval && x->conval->intval <= 255)) { + OPB_BindNodes(28, OPT_notyp, &x, x); + x->conval = OPT_NewConst(); + x->conval->intval = OPM_errpos; + OPB_Construct(15, &p, x); + p->conval = OPT_NewConst(); + p->conval->intval = OPM_errpos; + OPB_Construct(20, &p, NIL); + OPB_OptIf(&p); + if (p == NIL) { + } else if (p->class == 28) { + OPB_err(99); + } else { + p->subcl = 32; + } + } else { + OPB_err(218); + } + } else { + OPB_err(69); + } + break; + default: + OPB_err(64); + break; + } + *par0 = p; + StPar1__52_s = _s.lnk; +} + +void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n) +{ + OPT_Node node = NIL; + INTEGER f; + OPT_Node p = NIL; + p = *par0; + f = x->typ->form; + if (fctno == 1) { + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (p->typ->comp != 3) { + OPB_err(64); + } else if (__IN(f, 0x70)) { + if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) { + OPB_err(63); + } + node = p->right; + while (node->link != NIL) { + node = node->link; + } + node->link = x; + p->typ = p->typ->BaseTyp; + } else { + OPB_err(111); + } + } else if ((fctno == 31 && n == 2)) { + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + node = OPT_NewNode(19); + node->subcl = 31; + node->right = p; + node->left = p->link; + p->link = x; + p = node; + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + } else { + OPB_err(64); + } + *par0 = p; +} + +void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno) +{ + INTEGER dim; + OPT_Node x = NIL, p = NIL; + p = *par0; + if (fctno <= 19) { + if ((fctno == 1 && p->typ != OPT_notyp)) { + if (p->typ->comp == 3) { + OPB_err(65); + } + p->typ = OPT_notyp; + } else if (fctno <= 12) { + if (parno < 1) { + OPB_err(65); + } + } else { + if (((fctno == 13 || fctno == 14) && parno == 1)) { + OPB_BindNodes(19, OPT_notyp, &p, OPB_NewIntConst(((LONGINT)(1)))); + p->subcl = fctno; + p->right->typ = p->left->typ; + } else if ((fctno == 17 && parno == 1)) { + if (p->typ->comp == 3) { + dim = 0; + while (p->class == 4) { + p = p->left; + dim += 1; + } + OPB_BindNodes(12, OPT_linttyp, &p, OPB_NewIntConst(dim)); + p->subcl = 19; + } else { + p = OPB_NewIntConst(p->typ->n); + } + } else if (parno < 2) { + OPB_err(65); + } + } + } else if (fctno == 32) { + if (parno == 1) { + x = NIL; + OPB_BindNodes(28, OPT_notyp, &x, OPB_NewIntConst(((LONGINT)(0)))); + x->conval = OPT_NewConst(); + x->conval->intval = OPM_errpos; + OPB_Construct(15, &p, x); + p->conval = OPT_NewConst(); + p->conval->intval = OPM_errpos; + OPB_Construct(20, &p, NIL); + OPB_OptIf(&p); + if (p == NIL) { + } else if (p->class == 28) { + OPB_err(99); + } else { + p->subcl = 32; + } + } else if (parno < 1) { + OPB_err(65); + } + } else { + if ((parno < 1 || (fctno > 21 && parno < 2)) || (fctno == 31 && parno < 3)) { + OPB_err(65); + } + } + *par0 = p; +} + +static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar) +{ + INTEGER f; + f = atyp->comp; + ftyp = ftyp->BaseTyp; + atyp = atyp->BaseTyp; + if ((fvarpar && ftyp == OPT_bytetyp)) { + if (!__IN(f, 0x0c) || !__IN(atyp->form, 0x1e)) { + if (__IN(18, OPM_opt)) { + OPB_err(-301); + } + } + } else if (__IN(f, 0x0c)) { + if (ftyp->comp == 3) { + OPB_DynArrParCheck(ftyp, atyp, fvarpar); + } else if (ftyp != atyp) { + if ((((!fvarpar && ftyp->form == 13)) && atyp->form == 13)) { + ftyp = ftyp->BaseTyp; + atyp = atyp->BaseTyp; + if ((ftyp->comp == 4 && atyp->comp == 4)) { + while ((((ftyp != atyp && atyp != NIL)) && atyp != OPT_undftyp)) { + atyp = atyp->BaseTyp; + } + if (atyp == NIL) { + OPB_err(113); + } + } else { + OPB_err(66); + } + } else { + OPB_err(66); + } + } + } else { + OPB_err(67); + } +} + +static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp) +{ + if (fp->typ->form == 13) { + if ((*x)->class == 3) { + *x = (*x)->left; + } else { + OPB_err(71); + } + } +} + +void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar) +{ + if (((*x)->obj != NIL && __IN((*x)->obj->mode, 0x22c0))) { + *fpar = (*x)->obj->link; + if ((*x)->obj->mode == 13) { + OPB_CheckReceiver(&(*x)->left, *fpar); + *fpar = (*fpar)->link; + } + } else if (((((*x)->class != 8 && (*x)->typ != NIL)) && (*x)->typ->form == 14)) { + *fpar = (*x)->typ->link; + } else { + OPB_err(121); + *fpar = NIL; + (*x)->typ = OPT_undftyp; + } +} + +void OPB_Param (OPT_Node ap, OPT_Object fp) +{ + OPT_Struct q = NIL; + if (fp->typ->form != 0) { + if (fp->mode == 2) { + if (OPB_NotVar(ap)) { + OPB_err(122); + } else { + OPB_CheckLeaf(ap, 0); + } + if (ap->readonly) { + OPB_err(76); + } + if (fp->typ->comp == 3) { + OPB_DynArrParCheck(fp->typ, ap->typ, 1); + } else if ((fp->typ->comp == 4 && ap->typ->comp == 4)) { + q = ap->typ; + while ((((q != fp->typ && q != NIL)) && q != OPT_undftyp)) { + q = q->BaseTyp; + } + if (q == NIL) { + OPB_err(111); + } + } else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 13)) { + } else if ((ap->typ != fp->typ && !((fp->typ->form == 1 && __IN(ap->typ->form, 0x18))))) { + OPB_err(123); + } else if ((fp->typ->form == 13 && ap->class == 5)) { + OPB_err(123); + } + } else if (fp->typ->comp == 3) { + if ((ap->class == 7 && ap->typ->form == 3)) { + OPB_CharToString(ap); + } + if ((ap->typ->form == 10 && fp->typ->BaseTyp->form == 3)) { + } else if (ap->class >= 7) { + OPB_err(59); + } else { + OPB_DynArrParCheck(fp->typ, ap->typ, 0); + } + } else { + OPB_CheckAssign(fp->typ, ap); + } + } +} + +void OPB_StaticLink (SHORTINT dlev) +{ + OPT_Object scope = NIL; + scope = OPT_topScope; + while (dlev > 0) { + dlev -= 1; + scope->link->conval->setval |= __SETOF(3); + scope = scope->left; + } +} + +void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp) +{ + OPT_Struct typ = NIL; + OPT_Node p = NIL; + SHORTINT lev; + if ((*x)->class == 9) { + typ = (*x)->typ; + lev = (*x)->obj->mnolev; + if (lev > 0) { + OPB_StaticLink(OPT_topScope->mnolev - lev); + } + if ((*x)->obj->mode == 10) { + OPB_err(121); + } + } else if (((*x)->class == 2 && (*x)->obj->mode == 13)) { + typ = (*x)->typ; + (*x)->class = 9; + p = (*x)->left; + (*x)->left = NIL; + p->link = apar; + apar = p; + fp = (*x)->obj->link; + } else { + typ = (*x)->typ->BaseTyp; + } + OPB_BindNodes(13, typ, &*x, apar); + (*x)->obj = fp; +} + +void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc) +{ + OPT_Node x = NIL; + x = OPT_NewNode(18); + x->typ = OPT_notyp; + x->obj = proc; + x->left = *procdec; + x->right = stat; + *procdec = x; +} + +void OPB_Return (OPT_Node *x, OPT_Object proc) +{ + OPT_Node node = NIL; + if (proc == NIL) { + if (*x != NIL) { + OPB_err(124); + } + } else { + if (*x != NIL) { + OPB_CheckAssign(proc->typ, *x); + } else if (proc->typ != OPT_notyp) { + OPB_err(124); + } + } + node = OPT_NewNode(26); + node->typ = OPT_notyp; + node->obj = proc; + node->left = *x; + *x = node; +} + +void OPB_Assign (OPT_Node *x, OPT_Node y) +{ + OPT_Node z = NIL; + SHORTINT subcl; + if ((*x)->class >= 7) { + OPB_err(56); + } + OPB_CheckAssign((*x)->typ, y); + if ((*x)->readonly) { + OPB_err(76); + } + if ((*x)->typ->comp == 4) { + if ((*x)->class == 5) { + z = (*x)->left; + } else { + z = *x; + } + if ((z->class == 3 && z->left->class == 5)) { + z->left = z->left->left; + } + if (((*x)->typ->strobj != NIL && (z->class == 3 || z->class == 1))) { + OPB_BindNodes(6, (*x)->typ, &z, NIL); + *x = z; + } + } else if (((((((*x)->typ->comp == 2 && (*x)->typ->BaseTyp == OPT_chartyp)) && y->typ->form == 10)) && y->conval->intval2 == 1)) { + y->typ = OPT_chartyp; + y->conval->intval = 0; + OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0)))); + } + if ((((((__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp == OPT_chartyp)) && __IN(y->typ->comp, 0x0c))) && y->typ->BaseTyp == OPT_chartyp)) { + subcl = 18; + } else { + subcl = 0; + } + OPB_BindNodes(19, OPT_notyp, &*x, y); + (*x)->subcl = subcl; +} + +void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ) +{ + OPT_Node node = NIL; + node = OPT_NewNode(14); + node->typ = typ; + node->conval = OPT_NewConst(); + node->conval->intval = typ->txtpos; + if (*inittd == NIL) { + *inittd = node; + } else { + (*last)->link = node; + } + *last = node; +} + + +export void *OPB__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPS); + __MODULE_IMPORT(OPT); + __REGMOD("OPB", 0); +/* BEGIN */ + OPB_maxExp = OPB_log(1073741824); + OPB_maxExp = OPB_exp; + __ENDMOD; +} diff --git a/bootstrap/unix-44/OPB.h b/bootstrap/unix-44/OPB.h new file mode 100644 index 00000000..8cd47ee6 --- /dev/null +++ b/bootstrap/unix-44/OPB.h @@ -0,0 +1,49 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPB__h +#define OPB__h + +#include "SYSTEM.h" +#include "OPS.h" +#include "OPT.h" + + +import void (*OPB_typSize)(OPT_Struct); + + +import void OPB_Assign (OPT_Node *x, OPT_Node y); +import void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp); +import void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames); +import void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y); +import void OPB_DeRef (OPT_Node *x); +import OPT_Node OPB_EmptySet (void); +import void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc); +import void OPB_Field (OPT_Node *x, OPT_Object y); +import void OPB_In (OPT_Node *x, OPT_Node y); +import void OPB_Index (OPT_Node *x, OPT_Node y); +import void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ); +import void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y); +import void OPB_MOp (SHORTINT op, OPT_Node *x); +import OPT_Node OPB_NewBoolConst (BOOLEAN boolval); +import OPT_Node OPB_NewIntConst (LONGINT intval); +import OPT_Node OPB_NewLeaf (OPT_Object obj); +import OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ); +import OPT_Node OPB_NewString (OPS_String str, LONGINT len); +import OPT_Node OPB_Nil (void); +import void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y); +import void OPB_OptIf (OPT_Node *x); +import void OPB_Param (OPT_Node ap, OPT_Object fp); +import void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar); +import void OPB_Return (OPT_Node *x, OPT_Object proc); +import void OPB_SetElem (OPT_Node *x); +import void OPB_SetRange (OPT_Node *x, OPT_Node y); +import void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno); +import void OPB_StPar0 (OPT_Node *par0, INTEGER fctno); +import void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno); +import void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n); +import void OPB_StaticLink (SHORTINT dlev); +import void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard); +import void *OPB__init(void); + + +#endif diff --git a/bootstrap/unix-44/OPC.c b/bootstrap/unix-44/OPC.c new file mode 100644 index 00000000..32a1496f --- /dev/null +++ b/bootstrap/unix-44/OPC.c @@ -0,0 +1,2108 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "Configuration.h" +#include "OPM.h" +#include "OPT.h" + + +static INTEGER OPC_indentLevel; +static BOOLEAN OPC_ptrinit, OPC_mainprog, OPC_ansi; +static SHORTINT OPC_hashtab[105]; +static CHAR OPC_keytab[36][9]; +static BOOLEAN OPC_GlbPtrs; +static CHAR OPC_BodyNameExt[13]; + + +export void OPC_Align (LONGINT *adr, LONGINT base); +export void OPC_Andent (OPT_Struct typ); +static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames); +export LONGINT OPC_Base (OPT_Struct typ); +export OPT_Object OPC_BaseTProc (OPT_Object obj); +export void OPC_BegBlk (void); +export void OPC_BegStat (void); +static void OPC_CProcDefs (OPT_Object obj, INTEGER vis); +export void OPC_Case (LONGINT caseVal, INTEGER form); +export void OPC_Cmp (INTEGER rel); +export void OPC_CompleteIdent (OPT_Object obj); +export void OPC_Constant (OPT_Const con, INTEGER form); +static void OPC_DeclareBase (OPT_Object dcl); +static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef); +static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro); +static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty); +static void OPC_DefAnonRecs (OPT_Node n); +export void OPC_DefineInter (OPT_Object proc); +static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty); +static void OPC_DefineTProcTypes (OPT_Object obj); +static void OPC_DefineType (OPT_Struct str); +export void OPC_EndBlk (void); +export void OPC_EndBlk0 (void); +export void OPC_EndStat (void); +export void OPC_EnterBody (void); +export void OPC_EnterProc (OPT_Object proc); +export void OPC_ExitBody (void); +export void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet); +static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *n, LONGINT *curAlign); +static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign); +export void OPC_GenBdy (OPT_Node n); +static void OPC_GenDynTypes (OPT_Node n, INTEGER vis); +export void OPC_GenEnumPtrs (OPT_Object var); +export void OPC_GenHdr (OPT_Node n); +export void OPC_GenHdrIncludes (void); +static void OPC_GenHeaderMsg (void); +export void OPC_Halt (LONGINT n); +export void OPC_Ident (OPT_Object obj); +static void OPC_IdentList (OPT_Object obj, INTEGER vis); +static void OPC_Include (CHAR *name, LONGINT name__len); +static void OPC_IncludeImports (OPT_Object obj, INTEGER vis); +export void OPC_Increment (BOOLEAN decrement); +export void OPC_Indent (INTEGER count); +export void OPC_Init (void); +static void OPC_InitImports (OPT_Object obj); +static void OPC_InitKeywords (void); +export void OPC_InitTDesc (OPT_Struct typ); +static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj); +export void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim); +static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName); +static INTEGER OPC_Length (CHAR *s, LONGINT s__len); +export LONGINT OPC_NofPtrs (OPT_Struct typ); +static INTEGER OPC_PerfectHash (CHAR *s, LONGINT s__len); +static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len); +static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define); +static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis); +static void OPC_PutBase (OPT_Struct typ); +static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt); +static void OPC_RegCmds (OPT_Object obj); +export void OPC_SetInclude (BOOLEAN exclude); +static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause); +static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x); +export void OPC_TDescDecl (OPT_Struct typ); +export void OPC_TypeDefs (OPT_Object obj, INTEGER vis); +export void OPC_TypeOf (OPT_Object ap); +static BOOLEAN OPC_Undefined (OPT_Object obj); + + +void OPC_Init (void) +{ + OPC_indentLevel = 0; + OPC_ptrinit = __IN(5, OPM_opt); + OPC_mainprog = OPM_mainProg || OPM_mainLinkStat; + OPC_ansi = __IN(6, OPM_opt); + if (OPC_ansi) { + __MOVE("__init(void)", OPC_BodyNameExt, 13); + } else { + __MOVE("__init()", OPC_BodyNameExt, 9); + } +} + +void OPC_Indent (INTEGER count) +{ + OPC_indentLevel += count; +} + +void OPC_BegStat (void) +{ + INTEGER i; + i = OPC_indentLevel; + while (i > 0) { + OPM_Write(0x09); + i -= 1; + } +} + +void OPC_EndStat (void) +{ + OPM_Write(';'); + OPM_WriteLn(); +} + +void OPC_BegBlk (void) +{ + OPM_Write('{'); + OPM_WriteLn(); + OPC_indentLevel += 1; +} + +void OPC_EndBlk (void) +{ + OPC_indentLevel -= 1; + OPC_BegStat(); + OPM_Write('}'); + OPM_WriteLn(); +} + +void OPC_EndBlk0 (void) +{ + OPC_indentLevel -= 1; + OPC_BegStat(); + OPM_Write('}'); +} + +static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x) +{ + CHAR ch; + INTEGER i; + __DUP(s, s__len, CHAR); + ch = s[0]; + i = 0; + while (ch != 0x00) { + if (ch == '#') { + OPM_WriteInt(x); + } else { + OPM_Write(ch); + } + i += 1; + ch = s[__X(i, s__len)]; + } + __DEL(s); +} + +static INTEGER OPC_Length (CHAR *s, LONGINT s__len) +{ + INTEGER _o_result; + INTEGER i; + i = 0; + while (s[__X(i, s__len)] != 0x00) { + i += 1; + } + _o_result = i; + return _o_result; +} + +static INTEGER OPC_PerfectHash (CHAR *s, LONGINT s__len) +{ + INTEGER _o_result; + INTEGER i, h; + i = 0; + h = 0; + while ((s[__X(i, s__len)] != 0x00 && i < 5)) { + h = 3 * h + (int)s[__X(i, s__len)]; + i += 1; + } + _o_result = (int)__MOD(h, 105); + return _o_result; +} + +void OPC_Ident (OPT_Object obj) +{ + INTEGER mode, level, h; + mode = obj->mode; + level = obj->mnolev; + if ((__IN(mode, 0x62) && level > 0) || __IN(mode, 0x14)) { + OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256))); + h = OPC_PerfectHash((void*)obj->name, ((LONGINT)(256))); + if (OPC_hashtab[__X(h, ((LONGINT)(105)))] >= 0) { + if (__STRCMP(OPC_keytab[__X(OPC_hashtab[__X(h, ((LONGINT)(105)))], ((LONGINT)(36)))], obj->name) == 0) { + OPM_Write('_'); + } + } + } else { + if (mode != 5 || obj->linkadr != 2) { + if (mode == 13) { + OPC_Ident(obj->link->typ->strobj); + } else if (level < 0) { + OPM_WriteStringVar((void*)OPT_GlbMod[__X(-level, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + if (OPM_currFile == 0) { + OPT_GlbMod[__X(-level, ((LONGINT)(64)))]->vis = 1; + } + } else { + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + } + OPM_Write('_'); + } else if (obj == OPT_sysptrtyp->strobj || obj == OPT_bytetyp->strobj) { + OPM_WriteString((CHAR*)"SYSTEM_", (LONGINT)8); + } + OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256))); + } +} + +static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause) +{ + INTEGER pointers; + *openClause = 0; + if (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->comp != 4)) { + if (__IN(typ->comp, 0x0c)) { + OPC_Stars(typ->BaseTyp, &*openClause); + *openClause = typ->comp == 2; + } else if (typ->form == 14) { + OPM_Write('('); + OPM_Write('*'); + } else { + pointers = 0; + while (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->form == 13)) { + pointers += 1; + typ = typ->BaseTyp; + } + if (pointers > 0) { + if (typ->comp != 3) { + OPC_Stars(typ, &*openClause); + } + if (*openClause) { + OPM_Write('('); + *openClause = 0; + } + while (pointers > 0) { + OPM_Write('*'); + pointers -= 1; + } + } + } + } +} + +static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef) +{ + OPT_Struct typ = NIL; + BOOLEAN varPar, openClause; + INTEGER form, comp; + typ = dcl->typ; + varPar = ((dcl->mode == 2 && typ->comp != 2) || typ->comp == 3) || scopeDef; + OPC_Stars(typ, &openClause); + if (varPar) { + if (openClause) { + OPM_Write('('); + } + OPM_Write('*'); + } + if (dcl->name[0] != 0x00) { + OPC_Ident(dcl); + } + if ((varPar && openClause)) { + OPM_Write(')'); + } + openClause = 0; + for (;;) { + form = typ->form; + comp = typ->comp; + if (((typ->strobj != NIL && typ->strobj->name[0] != 0x00) || form == 12) || comp == 4) { + break; + } else if ((form == 13 && typ->BaseTyp->comp != 3)) { + openClause = 1; + } else if (form == 14 || __IN(comp, 0x0c)) { + if (openClause) { + OPM_Write(')'); + openClause = 0; + } + if (form == 14) { + if (OPC_ansi) { + OPM_Write(')'); + OPC_AnsiParamList(typ->link, 0); + } else { + OPM_WriteString((CHAR*)")()", (LONGINT)4); + } + break; + } else if (comp == 2) { + OPM_Write('['); + OPM_WriteInt(typ->n); + OPM_Write(']'); + } + } else { + break; + } + typ = typ->BaseTyp; + } +} + +void OPC_Andent (OPT_Struct typ) +{ + if (typ->strobj == NIL || typ->align >= 65536) { + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + OPC_Str1((CHAR*)"__#", (LONGINT)4, __ASHR(typ->align, 16)); + } else { + OPC_Ident(typ->strobj); + } +} + +static BOOLEAN OPC_Undefined (OPT_Object obj) +{ + BOOLEAN _o_result; + _o_result = (((obj->mnolev >= 0 && obj->linkadr != (LONGINT)(3 + OPM_currFile))) && obj->linkadr != 2) || obj->name[0] == 0x00; + return _o_result; +} + +static void OPC_DeclareBase (OPT_Object dcl) +{ + OPT_Struct typ = NIL, prev = NIL; + OPT_Object obj = NIL; + INTEGER nofdims; + LONGINT off, n, dummy; + typ = dcl->typ; + prev = typ; + while ((((((((typ->strobj == NIL || typ->comp == 3) || OPC_Undefined(typ->strobj)) && typ->comp != 4)) && typ->form != 12)) && !((typ->form == 13 && typ->BaseTyp->comp == 3)))) { + prev = typ; + typ = typ->BaseTyp; + } + obj = typ->strobj; + if (typ->form == 12) { + OPM_WriteString((CHAR*)"void", (LONGINT)5); + } else if ((obj != NIL && !OPC_Undefined(obj))) { + OPC_Ident(obj); + } else if (typ->comp == 4) { + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPC_Andent(typ); + if ((prev->form != 13 && (obj != NIL || dcl->name[0] == 0x00))) { + if ((typ->BaseTyp != NIL && typ->BaseTyp->strobj->vis != 0)) { + OPM_WriteString((CHAR*)" { /* ", (LONGINT)7); + OPC_Ident(typ->BaseTyp->strobj); + OPM_WriteString((CHAR*)" */", (LONGINT)4); + OPM_WriteLn(); + OPC_Indent(1); + } else { + OPM_Write(' '); + OPC_BegBlk(); + } + OPC_FieldList(typ, 1, &off, &n, &dummy); + OPC_EndBlk0(); + } + } else if ((typ->form == 13 && typ->BaseTyp->comp == 3)) { + typ = typ->BaseTyp->BaseTyp; + nofdims = 1; + while (typ->comp == 3) { + nofdims += 1; + typ = typ->BaseTyp; + } + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPC_BegBlk(); + OPC_BegStat(); + OPC_Str1((CHAR*)"LONGINT len[#]", (LONGINT)15, nofdims); + OPC_EndStat(); + OPC_BegStat(); + __NEW(obj, OPT_ObjDesc); + __NEW(obj->typ, OPT_StrDesc); + obj->typ->form = 15; + obj->typ->comp = 2; + obj->typ->n = 1; + obj->typ->BaseTyp = typ; + obj->mode = 4; + __MOVE("data", obj->name, 5); + obj->linkadr = 0; + OPC_DeclareBase(obj); + OPM_Write(' '); + OPC_DeclareObj(obj, 0); + OPC_EndStat(); + OPC_EndBlk0(); + } +} + +LONGINT OPC_NofPtrs (OPT_Struct typ) +{ + LONGINT _o_result; + OPT_Object fld = NIL; + OPT_Struct btyp = NIL; + LONGINT n; + if ((typ->form == 13 && typ->sysflag == 0)) { + _o_result = 1; + return _o_result; + } else if ((typ->comp == 4 && __MASK(typ->sysflag, -256) == 0)) { + btyp = typ->BaseTyp; + if (btyp != NIL) { + n = OPC_NofPtrs(btyp); + } else { + n = 0; + } + fld = typ->link; + while ((fld != NIL && fld->mode == 4)) { + if (__STRCMP(fld->name, "@ptr") != 0) { + n = n + OPC_NofPtrs(fld->typ); + } else { + n += 1; + } + fld = fld->link; + } + _o_result = n; + return _o_result; + } else if (typ->comp == 2) { + btyp = typ->BaseTyp; + n = typ->n; + while (btyp->comp == 2) { + n = btyp->n * n; + btyp = btyp->BaseTyp; + } + _o_result = OPC_NofPtrs(btyp) * n; + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt) +{ + OPT_Object fld = NIL; + OPT_Struct btyp = NIL; + LONGINT n, i; + if ((typ->form == 13 && typ->sysflag == 0)) { + OPM_WriteInt(adr); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + *cnt += 1; + if (__MASK(*cnt, -16) == 0) { + OPM_WriteLn(); + OPM_Write(0x09); + } + } else if ((typ->comp == 4 && __MASK(typ->sysflag, -256) == 0)) { + btyp = typ->BaseTyp; + if (btyp != NIL) { + OPC_PutPtrOffsets(btyp, adr, &*cnt); + } + fld = typ->link; + while ((fld != NIL && fld->mode == 4)) { + if (__STRCMP(fld->name, "@ptr") != 0) { + OPC_PutPtrOffsets(fld->typ, adr + fld->adr, &*cnt); + } else { + OPM_WriteInt(adr + fld->adr); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + *cnt += 1; + if (__MASK(*cnt, -16) == 0) { + OPM_WriteLn(); + OPM_Write(0x09); + } + } + fld = fld->link; + } + } else if (typ->comp == 2) { + btyp = typ->BaseTyp; + n = typ->n; + while (btyp->comp == 2) { + n = btyp->n * n; + btyp = btyp->BaseTyp; + } + if (OPC_NofPtrs(btyp) > 0) { + i = 0; + while (i < n) { + OPC_PutPtrOffsets(btyp, adr + i * btyp->size, &*cnt); + i += 1; + } + } + } +} + +static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj) +{ + if (obj != NIL) { + OPC_InitTProcs(typ, obj->left); + if (obj->mode == 13) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"__INITBP(", (LONGINT)10); + OPC_Ident(typ); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(obj); + OPC_Str1((CHAR*)", #)", (LONGINT)5, __ASHR(obj->adr, 16)); + OPC_EndStat(); + } + OPC_InitTProcs(typ, obj->right); + } +} + +static void OPC_PutBase (OPT_Struct typ) +{ + if (typ != NIL) { + OPC_PutBase(typ->BaseTyp); + OPC_Ident(typ->strobj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + } +} + +static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName) +{ + OPT_Struct typ = NIL; + INTEGER dim; + if (showParamName) { + OPC_Ident(par); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + } + dim = 1; + typ = par->typ->BaseTyp; + while (typ->comp == 3) { + if (ansiDefine) { + OPM_WriteString((CHAR*)", LONGINT ", (LONGINT)11); + } else { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + } + if (showParamName) { + OPC_Ident(par); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + OPM_WriteInt(dim); + } + typ = typ->BaseTyp; + dim += 1; + } +} + +static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro) +{ + OPM_Write('('); + while (par != NIL) { + if (macro) { + OPM_WriteStringVar((void*)par->name, ((LONGINT)(256))); + } else { + if ((par->mode == 1 && par->typ->form == 7)) { + OPM_Write('_'); + } + OPC_Ident(par); + } + if (par->typ->comp == 3) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_LenList(par, 0, 1); + } else if ((par->mode == 2 && par->typ->comp == 4)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteStringVar((void*)par->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } + par = par->link; + if (par != NIL) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + } + } + OPM_Write(')'); +} + +static void OPC_DefineTProcTypes (OPT_Object obj) +{ + OPT_Object par = NIL; + if (obj->typ != OPT_notyp) { + OPC_DefineType(obj->typ); + } + if (OPC_ansi) { + par = obj->link; + while (par != NIL) { + OPC_DefineType(par->typ); + par = par->link; + } + } +} + +static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty) +{ + if (obj != NIL) { + OPC_DeclareTProcs(obj->left, &*empty); + if (obj->mode == 13) { + if (obj->typ != OPT_notyp) { + OPC_DefineType(obj->typ); + } + if (OPM_currFile == 0) { + if (obj->vis == 1) { + OPC_DefineTProcTypes(obj); + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + *empty = 0; + OPC_ProcHeader(obj, 0); + } + } else { + *empty = 0; + OPC_DefineTProcTypes(obj); + if (obj->vis == 0) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + } + OPC_ProcHeader(obj, 0); + } + } + OPC_DeclareTProcs(obj->right, &*empty); + } +} + +OPT_Object OPC_BaseTProc (OPT_Object obj) +{ + OPT_Object _o_result; + OPT_Struct typ = NIL, base = NIL; + LONGINT mno; + typ = obj->link->typ; + if (typ->form == 13) { + typ = typ->BaseTyp; + } + base = typ->BaseTyp; + mno = __ASHR(obj->adr, 16); + while ((base != NIL && mno < base->n)) { + typ = base; + base = typ->BaseTyp; + } + OPT_FindField(obj->name, typ, &obj); + _o_result = obj; + return _o_result; +} + +static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty) +{ + if (obj != NIL) { + OPC_DefineTProcMacros(obj->left, &*empty); + if ((((obj->mode == 13 && obj == OPC_BaseTProc(obj))) && (OPM_currFile != 0 || obj->vis == 1))) { + OPM_WriteString((CHAR*)"#define __", (LONGINT)11); + OPC_Ident(obj); + OPC_DeclareParams(obj->link, 1); + OPM_WriteString((CHAR*)" __SEND(", (LONGINT)9); + if (obj->link->typ->form == 13) { + OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10); + OPC_Ident(obj->link); + OPM_Write(')'); + } else { + OPC_Ident(obj->link); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } + OPC_Str1((CHAR*)", #, ", (LONGINT)6, __ASHR(obj->adr, 16)); + if (obj->typ == OPT_notyp) { + OPM_WriteString((CHAR*)"void", (LONGINT)5); + } else { + OPC_Ident(obj->typ->strobj); + } + OPM_WriteString((CHAR*)"(*)", (LONGINT)4); + if (OPC_ansi) { + OPC_AnsiParamList(obj->link, 0); + } else { + OPM_WriteString((CHAR*)"()", (LONGINT)3); + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_DeclareParams(obj->link, 1); + OPM_Write(')'); + OPM_WriteLn(); + } + OPC_DefineTProcMacros(obj->right, &*empty); + } +} + +static void OPC_DefineType (OPT_Struct str) +{ + OPT_Object obj = NIL, field = NIL, par = NIL; + BOOLEAN empty; + if (OPM_currFile == 1 || str->ref < 255) { + obj = str->strobj; + if (obj == NIL || OPC_Undefined(obj)) { + if (obj != NIL) { + if (obj->linkadr == 1) { + if (str->form != 13) { + OPM_Mark(244, str->txtpos); + obj->linkadr = 2; + } + } else { + obj->linkadr = 1; + } + } + if (str->comp == 4) { + if (str->BaseTyp != NIL) { + OPC_DefineType(str->BaseTyp); + } + field = str->link; + while ((field != NIL && field->mode == 4)) { + if (field->vis != 0 || OPM_currFile == 1) { + OPC_DefineType(field->typ); + } + field = field->link; + } + } else if (str->form == 13) { + if (str->BaseTyp->comp != 4) { + OPC_DefineType(str->BaseTyp); + } + } else if (__IN(str->comp, 0x0c)) { + OPC_DefineType(str->BaseTyp); + } else if (str->form == 14) { + if (str->BaseTyp != OPT_notyp) { + OPC_DefineType(str->BaseTyp); + } + field = str->link; + while (field != NIL) { + OPC_DefineType(field->typ); + field = field->link; + } + } + } + if ((obj != NIL && OPC_Undefined(obj))) { + OPM_WriteString((CHAR*)"typedef", (LONGINT)8); + OPM_WriteLn(); + OPM_Write(0x09); + OPC_Indent(1); + obj->linkadr = 1; + OPC_DeclareBase(obj); + OPM_Write(' '); + obj->typ->strobj = NIL; + OPC_DeclareObj(obj, 0); + obj->typ->strobj = obj; + obj->linkadr = 3 + OPM_currFile; + OPC_EndStat(); + OPC_Indent(-1); + OPM_WriteLn(); + if (obj->typ->comp == 4) { + empty = 1; + OPC_DeclareTProcs(str->link, &empty); + OPC_DefineTProcMacros(str->link, &empty); + if (!empty) { + OPM_WriteLn(); + } + } + } + } +} + +static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len) +{ + BOOLEAN _o_result; + INTEGER i; + BOOLEAN r; + __DUP(y, y__len, CHAR); + i = 0; + while ((*x)[__X(i + 1, ((LONGINT)(256)))] == y[__X(i, y__len)]) { + i += 1; + } + r = y[__X(i, y__len)] == 0x00; + _o_result = r; + __DEL(y); + return _o_result; +} + +static void OPC_CProcDefs (OPT_Object obj, INTEGER vis) +{ + INTEGER i; + OPT_ConstExt ext = NIL; + INTEGER _for__9; + if (obj != NIL) { + OPC_CProcDefs(obj->left, vis); + if ((((obj->mode == 9 && (int)obj->vis >= vis)) && obj->adr == 1)) { + ext = obj->conval->ext; + i = 1; + if (((*ext)[1] != '#' && !(OPC_Prefixed(ext, (CHAR*)"extern ", (LONGINT)8) || OPC_Prefixed(ext, (CHAR*)"import ", (LONGINT)8)))) { + OPM_WriteString((CHAR*)"#define ", (LONGINT)9); + OPC_Ident(obj); + OPC_DeclareParams(obj->link, 1); + OPM_Write(0x09); + } + _for__9 = (int)(*obj->conval->ext)[0]; + i = i; + while (i <= _for__9) { + OPM_Write((*obj->conval->ext)[__X(i, ((LONGINT)(256)))]); + i += 1; + } + OPM_WriteLn(); + } + OPC_CProcDefs(obj->right, vis); + } +} + +void OPC_TypeDefs (OPT_Object obj, INTEGER vis) +{ + if (obj != NIL) { + OPC_TypeDefs(obj->left, vis); + if ((obj->mode == 5 && obj->typ->txtpos > 0)) { + OPC_DefineType(obj->typ); + } + OPC_TypeDefs(obj->right, vis); + } +} + +static void OPC_DefAnonRecs (OPT_Node n) +{ + OPT_Object o = NIL; + OPT_Struct typ = NIL; + while ((n != NIL && n->class == 14)) { + typ = n->typ; + if ((typ->strobj == NIL && (OPM_currFile == 1 || typ->ref < 255))) { + OPC_DefineType(typ); + __NEW(o, OPT_ObjDesc); + o->typ = typ; + o->name[0] = 0x00; + OPC_DeclareBase(o); + OPC_EndStat(); + OPM_WriteLn(); + } + n = n->link; + } +} + +void OPC_TDescDecl (OPT_Struct typ) +{ + LONGINT nofptrs; + OPT_Object o = NIL; + OPC_BegStat(); + OPM_WriteString((CHAR*)"__TDESC(", (LONGINT)9); + OPC_Andent(typ); + OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1); + OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ)); + OPM_Write('\"'); + if (typ->strobj != NIL) { + OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256))); + } + OPC_Str1((CHAR*)"\", #), {", (LONGINT)9, typ->size); + nofptrs = 0; + OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs); + OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (LONGINT)OPM_LIntSize)); + OPC_EndStat(); +} + +void OPC_InitTDesc (OPT_Struct typ) +{ + OPC_BegStat(); + OPM_WriteString((CHAR*)"__INITYP(", (LONGINT)10); + OPC_Andent(typ); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (typ->BaseTyp != NIL) { + OPC_Andent(typ->BaseTyp); + } else { + OPC_Andent(typ); + } + OPC_Str1((CHAR*)", #)", (LONGINT)5, typ->extlev); + OPC_EndStat(); + if (typ->strobj != NIL) { + OPC_InitTProcs(typ->strobj, typ->link); + } +} + +void OPC_Align (LONGINT *adr, LONGINT base) +{ + switch (base) { + case 2: + *adr += __MASK(*adr, -2); + break; + case 4: + *adr += __MASK(-*adr, -4); + break; + case 8: + *adr += __MASK(-*adr, -8); + break; + case 16: + *adr += __MASK(-*adr, -16); + break; + default: + break; + } +} + +LONGINT OPC_Base (OPT_Struct typ) +{ + LONGINT _o_result; + switch (typ->form) { + case 1: + _o_result = 1; + return _o_result; + break; + case 3: + _o_result = OPM_CharAlign; + return _o_result; + break; + case 2: + _o_result = OPM_BoolAlign; + return _o_result; + break; + case 4: + _o_result = OPM_SIntAlign; + return _o_result; + break; + case 5: + _o_result = OPM_IntAlign; + return _o_result; + break; + case 6: + _o_result = OPM_LIntAlign; + return _o_result; + break; + case 7: + _o_result = OPM_RealAlign; + return _o_result; + break; + case 8: + _o_result = OPM_LRealAlign; + return _o_result; + break; + case 9: + _o_result = OPM_SetAlign; + return _o_result; + break; + case 13: + _o_result = OPM_PointerAlign; + return _o_result; + break; + case 14: + _o_result = OPM_ProcAlign; + return _o_result; + break; + case 15: + if (typ->comp == 4) { + _o_result = __MASK(typ->align, -65536); + return _o_result; + } else { + _o_result = OPC_Base(typ->BaseTyp); + return _o_result; + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPC.Base, typ^form = ", (LONGINT)40); + OPM_LogWNum(typ->form, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + __RETCHK; +} + +static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign) +{ + LONGINT adr; + adr = off; + OPC_Align(&adr, align); + if ((*curAlign < align && gap - (adr - off) >= align)) { + gap -= (adr - off) + align; + OPC_BegStat(); + if (align == (LONGINT)OPM_IntSize) { + OPM_WriteString((CHAR*)"INTEGER", (LONGINT)8); + } else if (align == (LONGINT)OPM_LIntSize) { + OPM_WriteString((CHAR*)"LONGINT", (LONGINT)8); + } else if (align == (LONGINT)OPM_LRealSize) { + OPM_WriteString((CHAR*)"LONGREAL", (LONGINT)9); + } + OPC_Str1((CHAR*)" _prvt#", (LONGINT)8, *n); + *n += 1; + OPC_EndStat(); + *curAlign = align; + } + if (gap > 0) { + OPC_BegStat(); + OPC_Str1((CHAR*)"char _prvt#", (LONGINT)12, *n); + *n += 1; + OPC_Str1((CHAR*)"[#]", (LONGINT)4, gap); + OPC_EndStat(); + } +} + +static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *n, LONGINT *curAlign) +{ + OPT_Object fld = NIL; + OPT_Struct base = NIL; + LONGINT gap, adr, align, fldAlign; + fld = typ->link; + align = __MASK(typ->align, -65536); + if (typ->BaseTyp != NIL) { + OPC_FieldList(typ->BaseTyp, 0, &*off, &*n, &*curAlign); + } else { + *off = 0; + *n = 0; + *curAlign = 1; + } + while ((fld != NIL && fld->mode == 4)) { + if ((OPM_currFile == 0 && fld->vis == 0) || (((OPM_currFile == 1 && fld->vis == 0)) && typ->mno != 0)) { + fld = fld->link; + while ((((fld != NIL && fld->mode == 4)) && fld->vis == 0)) { + fld = fld->link; + } + } else { + adr = *off; + fldAlign = OPC_Base(fld->typ); + OPC_Align(&adr, fldAlign); + gap = fld->adr - adr; + if (fldAlign > *curAlign) { + *curAlign = fldAlign; + } + if (gap > 0) { + OPC_FillGap(gap, *off, align, &*n, &*curAlign); + } + OPC_BegStat(); + OPC_DeclareBase(fld); + OPM_Write(' '); + OPC_DeclareObj(fld, 0); + *off = fld->adr + fld->typ->size; + base = fld->typ; + fld = fld->link; + while ((((((((fld != NIL && fld->mode == 4)) && fld->typ == base)) && fld->adr == *off)) && ((OPM_currFile == 1 || fld->vis != 0) || fld->typ->strobj == NIL))) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_DeclareObj(fld, 0); + *off = fld->adr + fld->typ->size; + fld = fld->link; + } + OPC_EndStat(); + } + } + if (last) { + adr = typ->size - (LONGINT)__ASHR(typ->sysflag, 8); + if (adr == 0) { + gap = 1; + } else { + gap = adr - *off; + } + if (gap > 0) { + OPC_FillGap(gap, *off, align, &*n, &*curAlign); + } + } +} + +static void OPC_IdentList (OPT_Object obj, INTEGER vis) +{ + OPT_Struct base = NIL; + BOOLEAN first; + INTEGER lastvis; + base = NIL; + first = 1; + while ((obj != NIL && obj->mode != 13)) { + if ((__IN(vis, 0x05) || (vis == 1 && obj->vis != 0)) || (vis == 3 && !obj->leaf)) { + if (obj->typ != base || (int)obj->vis != lastvis) { + if (!first) { + OPC_EndStat(); + } + first = 0; + base = obj->typ; + lastvis = obj->vis; + OPC_BegStat(); + if ((vis == 1 && obj->vis != 0)) { + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + } else if ((obj->mnolev == 0 && vis == 0)) { + if (obj->vis == 0) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + } + } + if ((((vis == 2 && obj->mode == 1)) && base->form == 7)) { + OPM_WriteString((CHAR*)"double", (LONGINT)7); + } else { + OPC_DeclareBase(obj); + } + } else { + OPM_Write(','); + } + OPM_Write(' '); + if ((((vis == 2 && obj->mode == 1)) && base->form == 7)) { + OPM_Write('_'); + } + OPC_DeclareObj(obj, vis == 3); + if (obj->typ->comp == 3) { + OPC_EndStat(); + OPC_BegStat(); + base = OPT_linttyp; + OPM_WriteString((CHAR*)"LONGINT ", (LONGINT)9); + OPC_LenList(obj, 0, 1); + } else if ((obj->mode == 2 && obj->typ->comp == 4)) { + OPC_EndStat(); + OPC_BegStat(); + OPM_WriteString((CHAR*)"LONGINT *", (LONGINT)10); + OPC_Ident(obj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + base = NIL; + } else if ((((((OPC_ptrinit && vis == 0)) && obj->mnolev > 0)) && obj->typ->form == 13)) { + OPM_WriteString((CHAR*)" = NIL", (LONGINT)7); + } + } + obj = obj->link; + } + if (!first) { + OPC_EndStat(); + } +} + +static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames) +{ + CHAR name[32]; + OPM_Write('('); + if (obj == NIL || obj->mode == 13) { + OPM_WriteString((CHAR*)"void", (LONGINT)5); + } else { + for (;;) { + OPC_DeclareBase(obj); + if (showParamNames) { + OPM_Write(' '); + OPC_DeclareObj(obj, 0); + } else { + __COPY(obj->name, name, ((LONGINT)(32))); + obj->name[0] = 0x00; + OPC_DeclareObj(obj, 0); + __COPY(name, obj->name, ((LONGINT)(256))); + } + if (obj->typ->comp == 3) { + OPM_WriteString((CHAR*)", LONGINT ", (LONGINT)11); + OPC_LenList(obj, 1, showParamNames); + } else if ((obj->mode == 2 && obj->typ->comp == 4)) { + OPM_WriteString((CHAR*)", LONGINT *", (LONGINT)12); + if (showParamNames) { + OPC_Ident(obj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } + } + if (obj->link == NIL || obj->link->mode == 13) { + break; + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + obj = obj->link; + } + } + OPM_Write(')'); +} + +static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define) +{ + if (proc->typ == OPT_notyp) { + OPM_WriteString((CHAR*)"void", (LONGINT)5); + } else { + OPC_Ident(proc->typ->strobj); + } + OPM_Write(' '); + OPC_Ident(proc); + OPM_Write(' '); + if (OPC_ansi) { + OPC_AnsiParamList(proc->link, 1); + if (!define) { + OPM_Write(';'); + } + OPM_WriteLn(); + } else if (define) { + OPC_DeclareParams(proc->link, 0); + OPM_WriteLn(); + OPC_Indent(1); + OPC_IdentList(proc->link, 2); + OPC_Indent(-1); + } else { + OPM_WriteString((CHAR*)"();", (LONGINT)4); + OPM_WriteLn(); + } +} + +static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis) +{ + if (obj != NIL) { + OPC_ProcPredefs(obj->left, vis); + if ((((__IN(obj->mode, 0xc0) && obj->vis >= vis)) && (obj->history != 4 || obj->mode == 6))) { + if (vis == 1) { + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + } else if (obj->vis == 0) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + } + OPC_ProcHeader(obj, 0); + } + OPC_ProcPredefs(obj->right, vis); + } +} + +static void OPC_Include (CHAR *name, LONGINT name__len) +{ + __DUP(name, name__len, CHAR); + OPM_WriteString((CHAR*)"#include ", (LONGINT)10); + OPM_Write('\"'); + OPM_WriteStringVar((void*)name, name__len); + OPM_WriteString((CHAR*)".h", (LONGINT)3); + OPM_Write('\"'); + OPM_WriteLn(); + __DEL(name); +} + +static void OPC_IncludeImports (OPT_Object obj, INTEGER vis) +{ + if (obj != NIL) { + OPC_IncludeImports(obj->left, vis); + if ((((obj->mode == 11 && obj->mnolev != 0)) && (int)OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->vis >= vis)) { + OPC_Include(OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + } + OPC_IncludeImports(obj->right, vis); + } +} + +static void OPC_GenDynTypes (OPT_Node n, INTEGER vis) +{ + OPT_Struct typ = NIL; + while ((n != NIL && n->class == 14)) { + typ = n->typ; + if (vis == 0 || typ->ref < 255) { + OPC_BegStat(); + if (vis == 1) { + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + } else if ((typ->strobj != NIL && typ->strobj->mnolev > 0)) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + } + OPM_WriteString((CHAR*)"LONGINT *", (LONGINT)10); + OPC_Andent(typ); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPC_EndStat(); + } + n = n->link; + } +} + +void OPC_GenHdr (OPT_Node n) +{ + OPM_currFile = 0; + OPC_DefAnonRecs(n); + OPC_TypeDefs(OPT_topScope->right, 1); + OPM_WriteLn(); + OPC_IdentList(OPT_topScope->scope, 1); + OPM_WriteLn(); + OPC_GenDynTypes(n, 1); + OPM_WriteLn(); + OPC_ProcPredefs(OPT_topScope->right, 1); + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + OPM_WriteString((CHAR*)"void *", (LONGINT)7); + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + OPM_WriteString(OPC_BodyNameExt, ((LONGINT)(13))); + OPC_EndStat(); + OPM_WriteLn(); + OPC_CProcDefs(OPT_topScope->right, 1); + OPM_WriteLn(); + OPM_WriteString((CHAR*)"#endif", (LONGINT)7); + OPM_WriteLn(); +} + +static void OPC_GenHeaderMsg (void) +{ + INTEGER i; + OPM_WriteString((CHAR*)"/*", (LONGINT)3); + OPM_WriteString((CHAR*)" voc ", (LONGINT)6); + OPM_Write(' '); + OPM_WriteString((CHAR*)"1.2 [2016/06/15] for gcc LP64 on cygwin", (LONGINT)40); + OPM_Write(' '); + i = 0; + while (i <= 31) { + if (__IN(i, OPM_glbopt)) { + switch (i) { + case 0: + OPM_Write('x'); + break; + case 2: + OPM_Write('r'); + break; + case 3: + OPM_Write('t'); + break; + case 4: + OPM_Write('s'); + break; + case 5: + OPM_Write('p'); + break; + case 6: + OPM_Write('k'); + break; + case 7: + OPM_Write('a'); + break; + case 9: + OPM_Write('e'); + break; + case 10: + OPM_Write('m'); + break; + case 13: + OPM_Write('S'); + break; + case 14: + OPM_Write('c'); + break; + case 15: + OPM_Write('M'); + break; + case 16: + OPM_Write('f'); + break; + case 17: + OPM_Write('F'); + break; + case 18: + OPM_Write('v'); + break; + default: + OPM_LogWStr((CHAR*)"( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg", (LONGINT)126); + OPM_LogWLn(); + break; + } + } + i += 1; + } + OPM_WriteString((CHAR*)" */", (LONGINT)4); + OPM_WriteLn(); +} + +void OPC_GenHdrIncludes (void) +{ + OPM_currFile = 2; + OPC_GenHeaderMsg(); + OPM_WriteLn(); + OPM_WriteString((CHAR*)"#ifndef ", (LONGINT)9); + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + OPM_WriteString((CHAR*)"__h", (LONGINT)4); + OPM_WriteLn(); + OPM_WriteString((CHAR*)"#define ", (LONGINT)9); + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + OPM_WriteString((CHAR*)"__h", (LONGINT)4); + OPM_WriteLn(); + OPM_WriteLn(); + if (OPM_LIntSize == 8) { + OPM_WriteString((CHAR*)"#define LARGE", (LONGINT)14); + OPM_WriteLn(); + } + OPC_Include((CHAR*)"SYSTEM", (LONGINT)7); + OPC_IncludeImports(OPT_topScope->right, 1); + OPM_WriteLn(); +} + +void OPC_GenBdy (OPT_Node n) +{ + OPM_currFile = 1; + OPC_GenHeaderMsg(); + if (OPM_LIntSize == 8) { + OPM_WriteString((CHAR*)"#define LARGE", (LONGINT)14); + OPM_WriteLn(); + } + OPC_Include((CHAR*)"SYSTEM", (LONGINT)7); + OPC_IncludeImports(OPT_topScope->right, 0); + OPM_WriteLn(); + OPC_DefAnonRecs(n); + OPC_TypeDefs(OPT_topScope->right, 0); + OPM_WriteLn(); + OPC_IdentList(OPT_topScope->scope, 0); + OPM_WriteLn(); + OPC_GenDynTypes(n, 0); + OPM_WriteLn(); + OPC_ProcPredefs(OPT_topScope->right, 0); + OPM_WriteLn(); + OPC_CProcDefs(OPT_topScope->right, 0); + OPM_WriteLn(); +} + +static void OPC_RegCmds (OPT_Object obj) +{ + if (obj != NIL) { + OPC_RegCmds(obj->left); + if ((obj->mode == 7 && obj->history != 4)) { + if ((((obj->vis != 0 && obj->link == NIL)) && obj->typ == OPT_notyp)) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"__REGCMD(\"", (LONGINT)11); + OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"\", ", (LONGINT)4); + OPC_Ident(obj); + OPM_Write(')'); + OPC_EndStat(); + } + } + OPC_RegCmds(obj->right); + } +} + +static void OPC_InitImports (OPT_Object obj) +{ + if (obj != NIL) { + OPC_InitImports(obj->left); + if ((obj->mode == 11 && obj->mnolev != 0)) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"__MODULE_IMPORT(", (LONGINT)17); + OPM_WriteStringVar((void*)OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + OPM_Write(')'); + OPC_EndStat(); + } + OPC_InitImports(obj->right); + } +} + +void OPC_GenEnumPtrs (OPT_Object var) +{ + OPT_Struct typ = NIL; + LONGINT n; + OPC_GlbPtrs = 0; + while (var != NIL) { + typ = var->typ; + if (OPC_NofPtrs(typ) > 0) { + if (!OPC_GlbPtrs) { + OPC_GlbPtrs = 1; + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + if (OPC_ansi) { + OPM_WriteString((CHAR*)"void EnumPtrs(void (*P)(void*))", (LONGINT)32); + } else { + OPM_WriteString((CHAR*)"void EnumPtrs(P)", (LONGINT)17); + OPM_WriteLn(); + OPM_Write(0x09); + OPM_WriteString((CHAR*)"void (*P)();", (LONGINT)13); + } + OPM_WriteLn(); + OPC_BegBlk(); + } + OPC_BegStat(); + if (typ->form == 13) { + OPM_WriteString((CHAR*)"P(", (LONGINT)3); + OPC_Ident(var); + OPM_Write(')'); + } else if (typ->comp == 4) { + OPM_WriteString((CHAR*)"__ENUMR(&", (LONGINT)10); + OPC_Ident(var); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(typ); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPC_Str1((CHAR*)", #", (LONGINT)4, typ->size); + OPM_WriteString((CHAR*)", 1, P)", (LONGINT)8); + } else if (typ->comp == 2) { + n = typ->n; + typ = typ->BaseTyp; + while (typ->comp == 2) { + n = n * typ->n; + typ = typ->BaseTyp; + } + if (typ->form == 13) { + OPM_WriteString((CHAR*)"__ENUMP(", (LONGINT)9); + OPC_Ident(var); + OPC_Str1((CHAR*)", #, P)", (LONGINT)8, n); + } else if (typ->comp == 4) { + OPM_WriteString((CHAR*)"__ENUMR(", (LONGINT)9); + OPC_Ident(var); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(typ); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPC_Str1((CHAR*)", #", (LONGINT)4, typ->size); + OPC_Str1((CHAR*)", #, P)", (LONGINT)8, n); + } + } + OPC_EndStat(); + } + var = var->link; + } + if (OPC_GlbPtrs) { + OPC_EndBlk(); + OPM_WriteLn(); + } +} + +void OPC_EnterBody (void) +{ + OPM_WriteLn(); + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + if (OPC_mainprog) { + if (OPC_ansi) { + OPM_WriteString((CHAR*)"int main(int argc, char **argv)", (LONGINT)32); + OPM_WriteLn(); + } else { + OPM_WriteString((CHAR*)"main(argc, argv)", (LONGINT)17); + OPM_WriteLn(); + OPM_Write(0x09); + OPM_WriteString((CHAR*)"int argc; char **argv;", (LONGINT)23); + OPM_WriteLn(); + } + } else { + OPM_WriteString((CHAR*)"void *", (LONGINT)7); + OPM_WriteString(OPM_modName, ((LONGINT)(32))); + OPM_WriteString(OPC_BodyNameExt, ((LONGINT)(13))); + OPM_WriteLn(); + } + OPC_BegBlk(); + OPC_BegStat(); + if (OPC_mainprog) { + OPM_WriteString((CHAR*)"__INIT(argc, argv)", (LONGINT)19); + } else { + OPM_WriteString((CHAR*)"__DEFMOD", (LONGINT)9); + } + OPC_EndStat(); + if ((OPC_mainprog && 0)) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"/*don`t do it!*/ printf(\"DEMO VERSION: DO NOT USE THIS PROGRAM FOR ANY COMMERCIAL PURPOSE\\n\")", (LONGINT)94); + OPC_EndStat(); + } + OPC_InitImports(OPT_topScope->right); + OPC_BegStat(); + if (OPC_mainprog) { + OPM_WriteString((CHAR*)"__REGMAIN(\"", (LONGINT)12); + } else { + OPM_WriteString((CHAR*)"__REGMOD(\"", (LONGINT)11); + } + OPM_WriteString(OPM_modName, ((LONGINT)(32))); + if (OPC_GlbPtrs) { + OPM_WriteString((CHAR*)"\", EnumPtrs)", (LONGINT)13); + } else { + OPM_WriteString((CHAR*)"\", 0)", (LONGINT)6); + } + OPC_EndStat(); + if (__STRCMP(OPM_modName, "SYSTEM") != 0) { + OPC_RegCmds(OPT_topScope); + } +} + +void OPC_ExitBody (void) +{ + OPC_BegStat(); + if (OPC_mainprog) { + OPM_WriteString((CHAR*)"__FINI;", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ENDMOD;", (LONGINT)10); + } + OPM_WriteLn(); + OPC_EndBlk(); +} + +void OPC_DefineInter (OPT_Object proc) +{ + OPT_Object scope = NIL; + scope = proc->scope; + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_Write(' '); + OPC_BegBlk(); + OPC_IdentList(proc->link, 3); + OPC_IdentList(scope->scope, 3); + OPC_BegStat(); + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_Write(' '); + OPM_Write('*'); + OPM_WriteString((CHAR*)"lnk", (LONGINT)4); + OPC_EndStat(); + OPC_EndBlk0(); + OPM_Write(' '); + OPM_Write('*'); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPC_EndStat(); + OPM_WriteLn(); + OPC_ProcPredefs(scope->right, 0); + OPM_WriteLn(); +} + +void OPC_EnterProc (OPT_Object proc) +{ + OPT_Object var = NIL, scope = NIL; + OPT_Struct typ = NIL; + INTEGER dim; + if (proc->vis != 1) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } + OPC_ProcHeader(proc, 1); + OPC_BegBlk(); + if (proc->typ != OPT_notyp) { + OPC_BegStat(); + OPC_Ident(proc->typ->strobj); + OPM_WriteString((CHAR*)" _o_result;", (LONGINT)12); + OPM_WriteLn(); + } + scope = proc->scope; + OPC_IdentList(scope->scope, 0); + if (!scope->leaf) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_Write(' '); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPC_EndStat(); + } + var = proc->link; + while (var != NIL) { + if ((var->typ->comp == 2 && var->mode == 1)) { + OPC_BegStat(); + if (var->typ->strobj == NIL) { + OPM_Mark(200, var->typ->txtpos); + } else { + OPC_Ident(var->typ->strobj); + } + OPM_Write(' '); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__copy", (LONGINT)7); + OPC_EndStat(); + } + var = var->link; + } + if (!OPC_ansi) { + var = proc->link; + while (var != NIL) { + if ((var->typ->form == 7 && var->mode == 1)) { + OPC_BegStat(); + OPC_Ident(var->typ->strobj); + OPM_Write(' '); + OPC_Ident(var); + OPM_WriteString((CHAR*)" = _", (LONGINT)5); + OPC_Ident(var); + OPC_EndStat(); + } + var = var->link; + } + } + var = proc->link; + while (var != NIL) { + if ((((__IN(var->typ->comp, 0x0c) && var->mode == 1)) && var->typ->sysflag == 0)) { + OPC_BegStat(); + if (var->typ->comp == 2) { + OPM_WriteString((CHAR*)"__DUPARR(", (LONGINT)10); + OPC_Ident(var); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (var->typ->strobj == NIL) { + OPM_Mark(200, var->typ->txtpos); + } else { + OPC_Ident(var->typ->strobj); + } + } else { + OPM_WriteString((CHAR*)"__DUP(", (LONGINT)7); + OPC_Ident(var); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + typ = var->typ->BaseTyp; + dim = 1; + while (typ->comp == 3) { + OPM_WriteString((CHAR*)" * ", (LONGINT)4); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + OPM_WriteInt(dim); + typ = typ->BaseTyp; + dim += 1; + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (typ->strobj == NIL) { + OPM_Mark(200, typ->txtpos); + } else { + OPC_Ident(typ->strobj); + } + } + OPM_Write(')'); + OPC_EndStat(); + } + var = var->link; + } + if (!scope->leaf) { + var = proc->link; + while (var != NIL) { + if (!var->leaf) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPC_Ident(var); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + if (__IN(var->typ->comp, 0x0c)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } else if (var->mode != 2) { + OPM_Write('&'); + } + OPC_Ident(var); + if (var->typ->comp == 3) { + typ = var->typ; + dim = 0; + do { + OPM_WriteString((CHAR*)"; ", (LONGINT)3); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + if (dim != 0) { + OPM_WriteInt(dim); + } + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + if (dim != 0) { + OPM_WriteInt(dim); + } + typ = typ->BaseTyp; + } while (!(typ->comp != 3)); + } else if ((var->mode == 2 && var->typ->comp == 4)) { + OPM_WriteString((CHAR*)"; ", (LONGINT)3); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } + OPC_EndStat(); + } + var = var->link; + } + var = scope->scope; + while (var != NIL) { + if (!var->leaf) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPC_Ident(var); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + if (var->typ->comp != 2) { + OPM_Write('&'); + } else { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } + OPC_Ident(var); + OPC_EndStat(); + } + var = var->link; + } + OPC_BegStat(); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPM_WriteString((CHAR*)"lnk", (LONGINT)4); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPC_EndStat(); + OPC_BegStat(); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPM_Write('&'); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPC_EndStat(); + } +} + +void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet) +{ + OPT_Object var = NIL; + BOOLEAN indent; + indent = eoBlock; + if ((implicitRet && proc->typ != OPT_notyp)) { + OPM_Write(0x09); + OPM_WriteString((CHAR*)"__RETCHK;", (LONGINT)10); + OPM_WriteLn(); + } else if (!eoBlock || implicitRet) { + if (!proc->scope->leaf) { + if (indent) { + OPC_BegStat(); + } else { + indent = 1; + } + OPM_WriteStringVar((void*)proc->scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPM_WriteString((CHAR*)"lnk", (LONGINT)4); + OPC_EndStat(); + } + var = proc->link; + while (var != NIL) { + if ((((var->typ->comp == 3 && var->mode == 1)) && var->typ->sysflag == 0)) { + if (indent) { + OPC_BegStat(); + } else { + indent = 1; + } + OPM_WriteString((CHAR*)"__DEL(", (LONGINT)7); + OPC_Ident(var); + OPM_Write(')'); + OPC_EndStat(); + } + var = var->link; + } + } + if (eoBlock) { + OPC_EndBlk(); + OPM_WriteLn(); + } else if (indent) { + OPC_BegStat(); + } +} + +void OPC_CompleteIdent (OPT_Object obj) +{ + INTEGER comp, level; + level = obj->mnolev; + if (obj->adr == 1) { + if (obj->typ->comp == 4) { + OPC_Ident(obj); + OPM_WriteString((CHAR*)"__", (LONGINT)3); + } else { + OPM_WriteString((CHAR*)"((", (LONGINT)3); + OPC_Ident(obj->typ->strobj); + OPM_Write(')'); + OPC_Ident(obj); + OPM_Write(')'); + } + } else if ((level != OPM_level && level > 0)) { + comp = obj->typ->comp; + if ((obj->mode != 2 && comp != 3)) { + OPM_Write('*'); + } + OPM_WriteStringVar((void*)obj->scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_WriteString((CHAR*)"->", (LONGINT)3); + OPC_Ident(obj); + } else { + OPC_Ident(obj); + } +} + +void OPC_TypeOf (OPT_Object ap) +{ + INTEGER i; + __ASSERT(ap->typ->comp == 4, 0); + if (ap->mode == 2) { + if ((int)ap->mnolev != OPM_level) { + OPM_WriteStringVar((void*)ap->scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s->", (LONGINT)5); + OPC_Ident(ap); + } else { + OPC_Ident(ap); + } + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } else if (ap->typ->strobj != NIL) { + OPC_Ident(ap->typ->strobj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } else { + OPC_Andent(ap->typ); + } +} + +void OPC_Cmp (INTEGER rel) +{ + switch (rel) { + case 9: + OPM_WriteString((CHAR*)" == ", (LONGINT)5); + break; + case 10: + OPM_WriteString((CHAR*)" != ", (LONGINT)5); + break; + case 11: + OPM_WriteString((CHAR*)" < ", (LONGINT)4); + break; + case 12: + OPM_WriteString((CHAR*)" <= ", (LONGINT)5); + break; + case 13: + OPM_WriteString((CHAR*)" > ", (LONGINT)4); + break; + case 14: + OPM_WriteString((CHAR*)" >= ", (LONGINT)5); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPC.Cmp, rel = ", (LONGINT)34); + OPM_LogWNum(rel, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } +} + +void OPC_Case (LONGINT caseVal, INTEGER form) +{ + CHAR ch; + OPM_WriteString((CHAR*)"case ", (LONGINT)6); + switch (form) { + case 3: + ch = (CHAR)caseVal; + if ((ch >= ' ' && ch <= '~')) { + OPM_Write('\''); + if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') { + OPM_Write('\\'); + OPM_Write(ch); + } else { + OPM_Write(ch); + } + OPM_Write('\''); + } else { + OPM_WriteString((CHAR*)"0x", (LONGINT)3); + OPM_WriteHex(caseVal); + } + break; + case 4: case 5: case 6: + OPM_WriteInt(caseVal); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPC.Case, form = ", (LONGINT)36); + OPM_LogWNum(form, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + OPM_WriteString((CHAR*)": ", (LONGINT)3); +} + +void OPC_SetInclude (BOOLEAN exclude) +{ + if (exclude) { + OPM_WriteString((CHAR*)" &= ~", (LONGINT)6); + } else { + OPM_WriteString((CHAR*)" |= ", (LONGINT)5); + } +} + +void OPC_Increment (BOOLEAN decrement) +{ + if (decrement) { + OPM_WriteString((CHAR*)" -= ", (LONGINT)5); + } else { + OPM_WriteString((CHAR*)" += ", (LONGINT)5); + } +} + +void OPC_Halt (LONGINT n) +{ + OPC_Str1((CHAR*)"__HALT(#)", (LONGINT)10, n); +} + +void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim) +{ + if (array->comp == 3) { + OPC_CompleteIdent(obj); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + if (dim != 0) { + OPM_WriteInt(dim); + } + } else { + while (dim > 0) { + array = array->BaseTyp; + dim -= 1; + } + OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12); + OPM_WriteInt(array->n); + OPM_WriteString((CHAR*)"))", (LONGINT)3); + } +} + +void OPC_Constant (OPT_Const con, INTEGER form) +{ + INTEGER i, len; + CHAR ch; + SET s; + LONGINT hex; + BOOLEAN skipLeading; + switch (form) { + case 1: + OPM_WriteInt(con->intval); + break; + case 2: + OPM_WriteInt(con->intval); + break; + case 3: + ch = (CHAR)con->intval; + if ((ch >= ' ' && ch <= '~')) { + OPM_Write('\''); + if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') { + OPM_Write('\\'); + } + OPM_Write(ch); + OPM_Write('\''); + } else { + OPM_WriteString((CHAR*)"0x", (LONGINT)3); + OPM_WriteHex(con->intval); + } + break; + case 4: case 5: case 6: + OPM_WriteInt(con->intval); + break; + case 7: + OPM_WriteReal(con->realval, 'f'); + break; + case 8: + OPM_WriteReal(con->realval, 0x00); + break; + case 9: + OPM_WriteString((CHAR*)"0x", (LONGINT)3); + skipLeading = 1; + s = con->setval; + i = 32; + do { + hex = 0; + do { + i -= 1; + hex = __ASHL(hex, 1); + if (__IN(i, s)) { + hex += 1; + } + } while (!(__MASK(i, -8) == 0)); + if (hex != 0 || !skipLeading) { + OPM_WriteHex(hex); + skipLeading = 0; + } + } while (!(i == 0)); + if (skipLeading) { + OPM_Write('0'); + } + break; + case 10: + OPM_Write('\"'); + len = (int)con->intval2 - 1; + i = 0; + while (i < len) { + ch = (*con->ext)[__X(i, ((LONGINT)(256)))]; + if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') { + OPM_Write('\\'); + } + OPM_Write(ch); + i += 1; + } + OPM_Write('\"'); + break; + case 11: + OPM_WriteString((CHAR*)"NIL", (LONGINT)4); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPC.Constant, form = ", (LONGINT)40); + OPM_LogWNum(form, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } +} + +static struct InitKeywords__47 { + SHORTINT *n; + struct InitKeywords__47 *lnk; +} *InitKeywords__47_s; + +static void Enter__48 (CHAR *s, LONGINT s__len); + +static void Enter__48 (CHAR *s, LONGINT s__len) +{ + INTEGER h; + __DUP(s, s__len, CHAR); + h = OPC_PerfectHash((void*)s, s__len); + OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__47_s->n; + __COPY(s, OPC_keytab[__X(*InitKeywords__47_s->n, ((LONGINT)(36)))], ((LONGINT)(9))); + *InitKeywords__47_s->n += 1; + __DEL(s); +} + +static void OPC_InitKeywords (void) +{ + SHORTINT n, i; + struct InitKeywords__47 _s; + _s.n = &n; + _s.lnk = InitKeywords__47_s; + InitKeywords__47_s = &_s; + n = 0; + i = 0; + while (i <= 104) { + OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1; + i += 1; + } + Enter__48((CHAR*)"asm", (LONGINT)4); + Enter__48((CHAR*)"auto", (LONGINT)5); + Enter__48((CHAR*)"break", (LONGINT)6); + Enter__48((CHAR*)"case", (LONGINT)5); + Enter__48((CHAR*)"char", (LONGINT)5); + Enter__48((CHAR*)"const", (LONGINT)6); + Enter__48((CHAR*)"continue", (LONGINT)9); + Enter__48((CHAR*)"default", (LONGINT)8); + Enter__48((CHAR*)"do", (LONGINT)3); + Enter__48((CHAR*)"double", (LONGINT)7); + Enter__48((CHAR*)"else", (LONGINT)5); + Enter__48((CHAR*)"enum", (LONGINT)5); + Enter__48((CHAR*)"extern", (LONGINT)7); + Enter__48((CHAR*)"export", (LONGINT)7); + Enter__48((CHAR*)"float", (LONGINT)6); + Enter__48((CHAR*)"for", (LONGINT)4); + Enter__48((CHAR*)"fortran", (LONGINT)8); + Enter__48((CHAR*)"goto", (LONGINT)5); + Enter__48((CHAR*)"if", (LONGINT)3); + Enter__48((CHAR*)"import", (LONGINT)7); + Enter__48((CHAR*)"int", (LONGINT)4); + Enter__48((CHAR*)"long", (LONGINT)5); + Enter__48((CHAR*)"register", (LONGINT)9); + Enter__48((CHAR*)"return", (LONGINT)7); + Enter__48((CHAR*)"short", (LONGINT)6); + Enter__48((CHAR*)"signed", (LONGINT)7); + Enter__48((CHAR*)"sizeof", (LONGINT)7); + Enter__48((CHAR*)"static", (LONGINT)7); + Enter__48((CHAR*)"struct", (LONGINT)7); + Enter__48((CHAR*)"switch", (LONGINT)7); + Enter__48((CHAR*)"typedef", (LONGINT)8); + Enter__48((CHAR*)"union", (LONGINT)6); + Enter__48((CHAR*)"unsigned", (LONGINT)9); + Enter__48((CHAR*)"void", (LONGINT)5); + Enter__48((CHAR*)"volatile", (LONGINT)9); + Enter__48((CHAR*)"while", (LONGINT)6); + InitKeywords__47_s = _s.lnk; +} + + +export void *OPC__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPT); + __REGMOD("OPC", 0); + __REGCMD("BegBlk", OPC_BegBlk); + __REGCMD("BegStat", OPC_BegStat); + __REGCMD("EndBlk", OPC_EndBlk); + __REGCMD("EndBlk0", OPC_EndBlk0); + __REGCMD("EndStat", OPC_EndStat); + __REGCMD("EnterBody", OPC_EnterBody); + __REGCMD("ExitBody", OPC_ExitBody); + __REGCMD("GenHdrIncludes", OPC_GenHdrIncludes); + __REGCMD("Init", OPC_Init); +/* BEGIN */ + OPC_InitKeywords(); + __ENDMOD; +} diff --git a/bootstrap/unix-44/OPC.h b/bootstrap/unix-44/OPC.h new file mode 100644 index 00000000..713ea3b2 --- /dev/null +++ b/bootstrap/unix-44/OPC.h @@ -0,0 +1,49 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPC__h +#define OPC__h + +#include "SYSTEM.h" +#include "OPT.h" + + + + +import void OPC_Align (LONGINT *adr, LONGINT base); +import void OPC_Andent (OPT_Struct typ); +import LONGINT OPC_Base (OPT_Struct typ); +import OPT_Object OPC_BaseTProc (OPT_Object obj); +import void OPC_BegBlk (void); +import void OPC_BegStat (void); +import void OPC_Case (LONGINT caseVal, INTEGER form); +import void OPC_Cmp (INTEGER rel); +import void OPC_CompleteIdent (OPT_Object obj); +import void OPC_Constant (OPT_Const con, INTEGER form); +import void OPC_DefineInter (OPT_Object proc); +import void OPC_EndBlk (void); +import void OPC_EndBlk0 (void); +import void OPC_EndStat (void); +import void OPC_EnterBody (void); +import void OPC_EnterProc (OPT_Object proc); +import void OPC_ExitBody (void); +import void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet); +import void OPC_GenBdy (OPT_Node n); +import void OPC_GenEnumPtrs (OPT_Object var); +import void OPC_GenHdr (OPT_Node n); +import void OPC_GenHdrIncludes (void); +import void OPC_Halt (LONGINT n); +import void OPC_Ident (OPT_Object obj); +import void OPC_Increment (BOOLEAN decrement); +import void OPC_Indent (INTEGER count); +import void OPC_Init (void); +import void OPC_InitTDesc (OPT_Struct typ); +import void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim); +import LONGINT OPC_NofPtrs (OPT_Struct typ); +import void OPC_SetInclude (BOOLEAN exclude); +import void OPC_TDescDecl (OPT_Struct typ); +import void OPC_TypeDefs (OPT_Object obj, INTEGER vis); +import void OPC_TypeOf (OPT_Object ap); +import void *OPC__init(void); + + +#endif diff --git a/bootstrap/unix-44/OPM.c b/bootstrap/unix-44/OPM.c new file mode 100644 index 00000000..3d68d2be --- /dev/null +++ b/bootstrap/unix-44/OPM.c @@ -0,0 +1,1091 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "Configuration.h" +#include "Console.h" +#include "Files.h" +#include "Platform.h" +#include "Strings.h" +#include "Texts.h" +#include "errors.h" +#include "vt100.h" + +typedef + CHAR OPM_FileName[32]; + + +static CHAR OPM_SourceFileName[256]; +export INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_CharAlign, OPM_BoolAlign, OPM_SIntAlign, OPM_IntAlign, OPM_LIntAlign, OPM_SetAlign, OPM_RealAlign, OPM_LRealAlign, OPM_PointerAlign, OPM_ProcAlign, OPM_RecAlign, OPM_MaxSet; +export LONGINT OPM_MinSInt, OPM_MinInt, OPM_MinLInt, OPM_MaxSInt, OPM_MaxInt, OPM_MaxLInt, OPM_MaxIndex; +export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; +export BOOLEAN OPM_noerr; +export LONGINT OPM_curpos, OPM_errpos, OPM_breakpc; +export INTEGER OPM_currFile, OPM_level, OPM_pc, OPM_entno; +export CHAR OPM_modName[32]; +export CHAR OPM_objname[64]; +export SET OPM_opt, OPM_glbopt; +static LONGINT OPM_ErrorLineStartPos, OPM_ErrorLineLimitPos, OPM_ErrorLineNumber, OPM_lasterrpos; +static Texts_Reader OPM_inR; +static Texts_Text OPM_Log; +static Texts_Writer OPM_W; +static Files_Rider OPM_oldSF, OPM_newSF; +static Files_Rider OPM_R[3]; +static Files_File OPM_oldSFile, OPM_newSFile, OPM_HFile, OPM_BFile, OPM_HIFile; +static INTEGER OPM_S; +export BOOLEAN OPM_dontAsm, OPM_dontLink, OPM_mainProg, OPM_mainLinkStat, OPM_notColorOutput, OPM_forceNewSym, OPM_Verbose; +static CHAR OPM_OBERON[1024]; +static CHAR OPM_MODULES[1024]; + + +static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F); +export void OPM_CloseFiles (void); +export void OPM_CloseOldSym (void); +export void OPM_DeleteNewSym (void); +export void OPM_FPrint (LONGINT *fp, LONGINT val); +export void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr); +export void OPM_FPrintReal (LONGINT *fp, REAL real); +export void OPM_FPrintSet (LONGINT *fp, SET set); +static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT pos); +export void OPM_Get (CHAR *ch); +static void OPM_GetProperties (void); +static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align); +export void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len); +export void OPM_InitOptions (void); +static void OPM_LogErrMsg (INTEGER n); +export void OPM_LogW (CHAR ch); +export void OPM_LogWLn (void); +export void OPM_LogWNum (LONGINT i, LONGINT len); +export void OPM_LogWStr (CHAR *s, LONGINT s__len); +static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len); +export void OPM_Mark (INTEGER n, LONGINT pos); +static INTEGER OPM_Min (INTEGER a, INTEGER b); +export void OPM_NewSym (CHAR *modName, LONGINT modName__len); +export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done); +export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len); +export BOOLEAN OPM_OpenPar (void); +export void OPM_RegisterNewSym (void); +static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt); +static void OPM_ShowLine (LONGINT pos); +export void OPM_SymRCh (CHAR *ch); +export LONGINT OPM_SymRInt (void); +export void OPM_SymRLReal (LONGREAL *lr); +export void OPM_SymRReal (REAL *r); +export void OPM_SymRSet (SET *s); +export void OPM_SymWCh (CHAR ch); +export void OPM_SymWInt (LONGINT i); +export void OPM_SymWLReal (LONGREAL lr); +export void OPM_SymWReal (REAL r); +export void OPM_SymWSet (SET s); +static void OPM_VerboseListSizes (void); +export void OPM_Write (CHAR ch); +export void OPM_WriteHex (LONGINT i); +export void OPM_WriteInt (LONGINT i); +export void OPM_WriteLn (void); +export void OPM_WriteReal (LONGREAL r, CHAR suffx); +export void OPM_WriteString (CHAR *s, LONGINT s__len); +export void OPM_WriteStringVar (CHAR *s, LONGINT s__len); +export BOOLEAN OPM_eofSF (void); +export void OPM_err (INTEGER n); +static LONGINT OPM_minus (LONGINT i); +static LONGINT OPM_power0 (LONGINT i, LONGINT j); + + +void OPM_LogW (CHAR ch) +{ + Console_Char(ch); +} + +void OPM_LogWStr (CHAR *s, LONGINT s__len) +{ + __DUP(s, s__len, CHAR); + Console_String(s, s__len); + __DEL(s); +} + +void OPM_LogWNum (LONGINT i, LONGINT len) +{ + Console_Int(i, len); +} + +void OPM_LogWLn (void) +{ + Console_Ln(); +} + +static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt) +{ + INTEGER i; + i = 1; + while (s[__X(i, s__len)] != 0x00) { + switch (s[__X(i, s__len)]) { + case 'e': + *opt = *opt ^ 0x0200; + break; + case 's': + *opt = *opt ^ 0x10; + break; + case 'm': + *opt = *opt ^ 0x0400; + break; + case 'x': + *opt = *opt ^ 0x01; + break; + case 'r': + *opt = *opt ^ 0x04; + break; + case 't': + *opt = *opt ^ 0x08; + break; + case 'a': + *opt = *opt ^ 0x80; + break; + case 'k': + *opt = *opt ^ 0x40; + break; + case 'p': + *opt = *opt ^ 0x20; + break; + case 'S': + *opt = *opt ^ 0x2000; + break; + case 'c': + *opt = *opt ^ 0x4000; + break; + case 'M': + *opt = *opt ^ 0x8000; + break; + case 'f': + *opt = *opt ^ 0x010000; + break; + case 'F': + *opt = *opt ^ 0x020000; + break; + case 'V': + *opt = *opt ^ 0x040000; + break; + case 'B': + if (s[__X(i + 1, s__len)] != 0x00) { + i += 1; + OPM_IntSize = (int)s[__X(i, s__len)] - 48; + } + if (s[__X(i + 1, s__len)] != 0x00) { + i += 1; + OPM_PointerSize = (int)s[__X(i, s__len)] - 48; + } + if (s[__X(i + 1, s__len)] != 0x00) { + i += 1; + OPM_Alignment = (int)s[__X(i, s__len)] - 48; + } + __ASSERT(OPM_IntSize == 2 || OPM_IntSize == 4, 0); + __ASSERT(OPM_PointerSize == 4 || OPM_PointerSize == 8, 0); + __ASSERT(OPM_Alignment == 4 || OPM_Alignment == 8, 0); + break; + default: + OPM_LogWStr((CHAR*)" warning: option ", (LONGINT)19); + OPM_LogW('-'); + OPM_LogW(s[__X(i, s__len)]); + OPM_LogWStr((CHAR*)" ignored", (LONGINT)9); + OPM_LogWLn(); + break; + } + i += 1; + } +} + +BOOLEAN OPM_OpenPar (void) +{ + BOOLEAN _o_result; + CHAR s[256]; + if (Platform_ArgCount == 1) { + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Vishap Oberon-2 compiler v", (LONGINT)27); + OPM_LogWStr((CHAR*)"1.2 [2016/06/15] for gcc LP64 on cygwin", (LONGINT)40); + OPM_LogW('.'); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Based on Ofront by Software Templ OEG, continued by Norayr Chilingarian and others.", (LONGINT)84); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Usage:", (LONGINT)7); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + OPM_LogWStr((CHAR*)"voc", (LONGINT)4); + OPM_LogWStr((CHAR*)" options {files {options}}.", (LONGINT)28); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Where options = [\"-\" {option} ].", (LONGINT)33); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" m - generate code for main module", (LONGINT)36); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" M - generate code for main module and link object statically", (LONGINT)63); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" s - generate new symbol file", (LONGINT)31); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" e - allow extending the module interface", (LONGINT)43); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" r - check value ranges", (LONGINT)25); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" a - don\'t check ASSERTs at runtime, use this option in tested production code", (LONGINT)80); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" t - don\'t check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" S - don\'t call external assembler/compiler, only generate C code", (LONGINT)67); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" c - don\'t call linker", (LONGINT)24); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" f - don\'t use color output", (LONGINT)29); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" V - verbose output", (LONGINT)21); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Initial options specify defaults for all files.", (LONGINT)48); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Options following a filename are specific to that file.", (LONGINT)56); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Repeating an option toggles its value.", (LONGINT)39); + OPM_LogWLn(); + _o_result = 0; + return _o_result; + } else { + OPM_S = 1; + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + OPM_glbopt = 0xe9; + while (s[0] == '-') { + OPM_ScanOptions((void*)s, ((LONGINT)(256)), &OPM_glbopt); + OPM_S += 1; + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + } + _o_result = 1; + return _o_result; + } + __RETCHK; +} + +void OPM_InitOptions (void) +{ + CHAR s[256]; + OPM_opt = OPM_glbopt; + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + while (s[0] == '-') { + OPM_ScanOptions((void*)s, ((LONGINT)(256)), &OPM_opt); + OPM_S += 1; + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + } + OPM_dontAsm = __IN(13, OPM_opt); + OPM_dontLink = __IN(14, OPM_opt); + OPM_mainProg = __IN(10, OPM_opt); + OPM_mainLinkStat = __IN(15, OPM_opt); + OPM_notColorOutput = __IN(16, OPM_opt); + OPM_forceNewSym = __IN(17, OPM_opt); + OPM_Verbose = __IN(18, OPM_opt); + if (OPM_mainLinkStat) { + OPM_glbopt |= __SETOF(10); + } + OPM_GetProperties(); +} + +void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len) +{ + Texts_Text T = NIL; + LONGINT beg, end, time; + CHAR s[256]; + *done = 0; + OPM_curpos = 0; + if (OPM_S >= Platform_ArgCount) { + return; + } + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + __NEW(T, Texts_TextDesc); + Texts_Open(T, s, ((LONGINT)(256))); + OPM_LogWStr(s, ((LONGINT)(256))); + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + __COPY(s, mname, mname__len); + __COPY(s, OPM_SourceFileName, ((LONGINT)(256))); + if (T->len == 0) { + OPM_LogWStr(s, ((LONGINT)(256))); + OPM_LogWStr((CHAR*)" not found.", (LONGINT)12); + OPM_LogWLn(); + } else { + Texts_OpenReader(&OPM_inR, Texts_Reader__typ, T, ((LONGINT)(0))); + *done = 1; + } + OPM_S += 1; + OPM_level = 0; + OPM_noerr = 1; + OPM_errpos = OPM_curpos; + OPM_lasterrpos = OPM_curpos - 10; + OPM_ErrorLineStartPos = 0; + OPM_ErrorLineLimitPos = 0; + OPM_ErrorLineNumber = 0; +} + +void OPM_Get (CHAR *ch) +{ + Texts_Read(&OPM_inR, Texts_Reader__typ, &*ch); + if (*ch == 0x0d) { + OPM_curpos = Texts_Pos(&OPM_inR, Texts_Reader__typ); + } else { + OPM_curpos += 1; + } + if ((*ch < 0x09 && !OPM_inR.eot)) { + *ch = ' '; + } +} + +static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len) +{ + INTEGER i, j; + CHAR ch; + __DUP(ext, ext__len, CHAR); + i = 0; + for (;;) { + ch = name[__X(i, name__len)]; + if (ch == 0x00) { + break; + } + FName[__X(i, FName__len)] = ch; + i += 1; + } + j = 0; + do { + ch = ext[__X(j, ext__len)]; + FName[__X(i, FName__len)] = ch; + i += 1; + j += 1; + } while (!(ch == 0x00)); + __DEL(ext); +} + +static void OPM_LogErrMsg (INTEGER n) +{ + Texts_Scanner S; + Texts_Text T = NIL; + CHAR ch; + INTEGER i; + CHAR buf[1024]; + if (n >= 0) { + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"31m", (LONGINT)4); + } + OPM_LogWStr((CHAR*)" err ", (LONGINT)7); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + } else { + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"35m", (LONGINT)4); + } + OPM_LogWStr((CHAR*)" warning ", (LONGINT)11); + n = -n; + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + } + OPM_LogWNum(n, ((LONGINT)(1))); + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + OPM_LogWStr(errors_errors[__X(n, ((LONGINT)(350)))], ((LONGINT)(128))); +} + +static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT pos) +{ + CHAR ch, cheol; + if (pos < OPM_ErrorLineStartPos) { + OPM_ErrorLineStartPos = 0; + OPM_ErrorLineLimitPos = 0; + OPM_ErrorLineNumber = 0; + } + if (pos < OPM_ErrorLineLimitPos) { + Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos); + return; + } + Files_Set(&*r, r__typ, f, OPM_ErrorLineLimitPos); + Files_Read(&*r, r__typ, (void*)&ch); + while ((OPM_ErrorLineLimitPos < pos && !(*r).eof)) { + OPM_ErrorLineStartPos = OPM_ErrorLineLimitPos; + OPM_ErrorLineNumber += 1; + while ((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) { + Files_Read(&*r, r__typ, (void*)&ch); + OPM_ErrorLineLimitPos += 1; + } + cheol = ch; + Files_Read(&*r, r__typ, (void*)&ch); + OPM_ErrorLineLimitPos += 1; + if ((cheol == 0x0d && ch == 0x0a)) { + OPM_ErrorLineLimitPos += 1; + Files_Read(&*r, r__typ, (void*)&ch); + } + } + Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos); +} + +static void OPM_ShowLine (LONGINT pos) +{ + Files_File f = NIL; + Files_Rider r; + CHAR line[1023]; + INTEGER i; + CHAR ch; + f = Files_Old(OPM_SourceFileName, ((LONGINT)(256))); + OPM_FindLine(f, &r, Files_Rider__typ, pos); + i = 0; + Files_Read(&r, Files_Rider__typ, (void*)&ch); + while ((((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) && i < 1022)) { + line[__X(i, ((LONGINT)(1023)))] = ch; + i += 1; + Files_Read(&r, Files_Rider__typ, (void*)&ch); + } + line[__X(i, ((LONGINT)(1023)))] = 0x00; + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWNum(OPM_ErrorLineNumber, ((LONGINT)(4))); + OPM_LogWStr((CHAR*)": ", (LONGINT)3); + OPM_LogWStr(line, ((LONGINT)(1023))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" ", (LONGINT)7); + if (pos >= OPM_ErrorLineLimitPos) { + pos = OPM_ErrorLineLimitPos - 1; + } + i = (int)(pos - OPM_ErrorLineStartPos); + while (i > 0) { + OPM_LogW(' '); + i -= 1; + } + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"32m", (LONGINT)4); + } + OPM_LogW('^'); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + Files_Close(f); +} + +void OPM_Mark (INTEGER n, LONGINT pos) +{ + if (pos == -1) { + pos = 0; + } + if (n >= 0) { + OPM_noerr = 0; + if (pos < OPM_lasterrpos || OPM_lasterrpos + 9 < pos) { + OPM_lasterrpos = pos; + OPM_ShowLine(pos); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + if (n < 249) { + OPM_LogWStr((CHAR*)" pos", (LONGINT)6); + OPM_LogWNum(pos, ((LONGINT)(6))); + OPM_LogErrMsg(n); + } else if (n == 255) { + OPM_LogWStr((CHAR*)"pos", (LONGINT)4); + OPM_LogWNum(pos, ((LONGINT)(6))); + OPM_LogWStr((CHAR*)" pc ", (LONGINT)6); + OPM_LogWNum(OPM_breakpc, ((LONGINT)(1))); + } else if (n == 254) { + OPM_LogWStr((CHAR*)"pc not found", (LONGINT)13); + } else { + OPM_LogWStr(OPM_objname, ((LONGINT)(64))); + if (n == 253) { + OPM_LogWStr((CHAR*)" is new, compile with option e", (LONGINT)31); + } else if (n == 252) { + OPM_LogWStr((CHAR*)" is redefined, compile with option s", (LONGINT)37); + } else if (n == 251) { + OPM_LogWStr((CHAR*)" is redefined (private part only), compile with option s", (LONGINT)57); + } else if (n == 250) { + OPM_LogWStr((CHAR*)" is no longer visible, compile with option s", (LONGINT)45); + } else if (n == 249) { + OPM_LogWStr((CHAR*)" is not consistently imported, recompile imports", (LONGINT)49); + } + } + } + } else { + if (pos >= 0) { + OPM_ShowLine(pos); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" pos", (LONGINT)6); + OPM_LogWNum(pos, ((LONGINT)(6))); + } + OPM_LogErrMsg(n); + if (pos < 0) { + OPM_LogWLn(); + } + } +} + +void OPM_err (INTEGER n) +{ + OPM_Mark(n, OPM_errpos); +} + +void OPM_FPrint (LONGINT *fp, LONGINT val) +{ + *fp = __ROTL((LONGINT)((SET)*fp ^ (SET)val), 1, LONGINT); +} + +void OPM_FPrintSet (LONGINT *fp, SET set) +{ + OPM_FPrint(&*fp, (LONGINT)set); +} + +void OPM_FPrintReal (LONGINT *fp, REAL real) +{ + OPM_FPrint(&*fp, __VAL(LONGINT, real)); +} + +void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr) +{ + LONGINT l, h; + __GET((LONGINT)(uintptr_t)&lr, l, LONGINT); + __GET((LONGINT)(uintptr_t)&lr + 4, h, LONGINT); + OPM_FPrint(&*fp, l); + OPM_FPrint(&*fp, h); +} + +static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align) +{ + __DUP(name, name__len, CHAR); + if (((*S).class == 1 && __STRCMP((*S).s, name) == 0)) { + Texts_Scan(&*S, S__typ); + if ((*S).class == 3) { + *size = (int)(*S).i; + Texts_Scan(&*S, S__typ); + } else { + OPM_Mark(-157, ((LONGINT)(-1))); + } + if ((*S).class == 3) { + *align = (int)(*S).i; + Texts_Scan(&*S, S__typ); + } else { + OPM_Mark(-157, ((LONGINT)(-1))); + } + } else { + OPM_Mark(-157, ((LONGINT)(-1))); + } + __DEL(name); +} + +static LONGINT OPM_minus (LONGINT i) +{ + LONGINT _o_result; + _o_result = -i; + return _o_result; +} + +static LONGINT OPM_power0 (LONGINT i, LONGINT j) +{ + LONGINT _o_result; + LONGINT k, p; + k = 1; + p = i; + do { + p = p * i; + k += 1; + } while (!(k == j)); + _o_result = p; + return _o_result; +} + +static void OPM_VerboseListSizes (void) +{ + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Type Size Alignement", (LONGINT)29); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"CHAR ", (LONGINT)14); + OPM_LogWNum(OPM_CharSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_CharAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"BOOLEAN ", (LONGINT)14); + OPM_LogWNum(OPM_BoolSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_BoolAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"SHORTINT ", (LONGINT)14); + OPM_LogWNum(OPM_SIntSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_SIntAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"INTEGER ", (LONGINT)14); + OPM_LogWNum(OPM_IntSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_IntAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"LONGINT ", (LONGINT)14); + OPM_LogWNum(OPM_LIntSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_LIntAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"SET ", (LONGINT)14); + OPM_LogWNum(OPM_SetSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_SetAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"REAL ", (LONGINT)14); + OPM_LogWNum(OPM_RealSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_RealAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"LONGREAL ", (LONGINT)14); + OPM_LogWNum(OPM_LRealSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_LRealAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"PTR ", (LONGINT)14); + OPM_LogWNum(OPM_PointerSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_PointerAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"PROC ", (LONGINT)14); + OPM_LogWNum(OPM_ProcSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_ProcAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"RECORD ", (LONGINT)14); + OPM_LogWNum(OPM_RecSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_RecAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Min shortint ", (LONGINT)14); + OPM_LogWNum(OPM_MinSInt, ((LONGINT)(4))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Max shortint ", (LONGINT)14); + OPM_LogWNum(OPM_MaxSInt, ((LONGINT)(4))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Min integer ", (LONGINT)14); + OPM_LogWNum(OPM_MinInt, ((LONGINT)(4))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Max integer ", (LONGINT)14); + OPM_LogWNum(OPM_MaxInt, ((LONGINT)(4))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Min longint ", (LONGINT)14); + OPM_LogWNum(OPM_MinLInt, ((LONGINT)(4))); + OPM_LogWLn(); +} + +static INTEGER OPM_Min (INTEGER a, INTEGER b) +{ + INTEGER _o_result; + if (a < b) { + _o_result = a; + return _o_result; + } else { + _o_result = b; + return _o_result; + } + __RETCHK; +} + +static void OPM_GetProperties (void) +{ + LONGINT base; + OPM_ProcSize = OPM_PointerSize; + OPM_LIntSize = __ASHL(OPM_IntSize, 1); + OPM_SetSize = OPM_LIntSize; + OPM_CharAlign = OPM_Min(OPM_Alignment, OPM_CharSize); + OPM_BoolAlign = OPM_Min(OPM_Alignment, OPM_BoolSize); + OPM_SIntAlign = OPM_Min(OPM_Alignment, OPM_SIntSize); + OPM_RecAlign = OPM_Min(OPM_Alignment, OPM_RecSize); + OPM_RealAlign = OPM_Min(OPM_Alignment, OPM_RealSize); + OPM_LRealAlign = OPM_Min(OPM_Alignment, OPM_LRealSize); + OPM_PointerAlign = OPM_Min(OPM_Alignment, OPM_PointerSize); + OPM_ProcAlign = OPM_Min(OPM_Alignment, OPM_ProcSize); + OPM_IntAlign = OPM_Min(OPM_Alignment, OPM_IntSize); + OPM_LIntAlign = OPM_Min(OPM_Alignment, OPM_LIntSize); + OPM_SetAlign = OPM_Min(OPM_Alignment, OPM_SetSize); + base = -2; + OPM_MinSInt = __ASH(base, __ASHL(OPM_SIntSize, 3) - 2); + OPM_MaxSInt = OPM_minus(OPM_MinSInt + 1); + OPM_MinInt = __ASH(base, __ASHL(OPM_IntSize, 3) - 2); + OPM_MaxInt = OPM_minus(OPM_MinInt + 1); + OPM_MinLInt = __ASH(base, __ASHL(OPM_LIntSize, 3) - 2); + OPM_MaxLInt = OPM_minus(OPM_MinLInt + 1); + if (OPM_RealSize == 4) { + OPM_MaxReal = 3.40282346000000e+038; + } else if (OPM_RealSize == 8) { + OPM_MaxReal = 1.79769296342094e+308; + } + if (OPM_LRealSize == 4) { + OPM_MaxLReal = 3.40282346000000e+038; + } else if (OPM_LRealSize == 8) { + OPM_MaxLReal = 1.79769296342094e+308; + } + OPM_MinReal = -OPM_MaxReal; + OPM_MinLReal = -OPM_MaxLReal; + OPM_MaxSet = __ASHL(OPM_SetSize, 3) - 1; + OPM_MaxIndex = OPM_MaxLInt; + if (OPM_Verbose) { + OPM_VerboseListSizes(); + } +} + +void OPM_SymRCh (CHAR *ch) +{ + Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&*ch); +} + +LONGINT OPM_SymRInt (void) +{ + LONGINT _o_result; + LONGINT k; + Files_ReadNum(&OPM_oldSF, Files_Rider__typ, &k); + _o_result = k; + return _o_result; +} + +void OPM_SymRSet (SET *s) +{ + Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (LONGINT*)&*s); +} + +void OPM_SymRReal (REAL *r) +{ + Files_ReadReal(&OPM_oldSF, Files_Rider__typ, &*r); +} + +void OPM_SymRLReal (LONGREAL *lr) +{ + Files_ReadLReal(&OPM_oldSF, Files_Rider__typ, &*lr); +} + +void OPM_CloseOldSym (void) +{ +} + +void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done) +{ + CHAR ch; + OPM_FileName fileName; + OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5); + OPM_oldSFile = Files_Old(fileName, ((LONGINT)(32))); + *done = OPM_oldSFile != NIL; + if (*done) { + Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, ((LONGINT)(0))); + Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ch); + if (ch != 0xf7) { + OPM_err(-306); + OPM_CloseOldSym(); + *done = 0; + } + } +} + +BOOLEAN OPM_eofSF (void) +{ + BOOLEAN _o_result; + _o_result = OPM_oldSF.eof; + return _o_result; +} + +void OPM_SymWCh (CHAR ch) +{ + Files_Write(&OPM_newSF, Files_Rider__typ, ch); +} + +void OPM_SymWInt (LONGINT i) +{ + Files_WriteNum(&OPM_newSF, Files_Rider__typ, i); +} + +void OPM_SymWSet (SET s) +{ + Files_WriteNum(&OPM_newSF, Files_Rider__typ, (LONGINT)s); +} + +void OPM_SymWReal (REAL r) +{ + Files_WriteReal(&OPM_newSF, Files_Rider__typ, r); +} + +void OPM_SymWLReal (LONGREAL lr) +{ + Files_WriteLReal(&OPM_newSF, Files_Rider__typ, lr); +} + +void OPM_RegisterNewSym (void) +{ + if (__STRCMP(OPM_modName, "SYSTEM") != 0 || __IN(10, OPM_opt)) { + Files_Register(OPM_newSFile); + } +} + +void OPM_DeleteNewSym (void) +{ +} + +void OPM_NewSym (CHAR *modName, LONGINT modName__len) +{ + OPM_FileName fileName; + OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5); + OPM_newSFile = Files_New(fileName, ((LONGINT)(32))); + if (OPM_newSFile != NIL) { + Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, ((LONGINT)(0))); + Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7); + } else { + OPM_err(153); + } +} + +void OPM_Write (CHAR ch) +{ + Files_Write(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, ch); +} + +void OPM_WriteString (CHAR *s, LONGINT s__len) +{ + INTEGER i; + i = 0; + while (s[__X(i, s__len)] != 0x00) { + i += 1; + } + Files_WriteBytes(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, (void*)s, s__len * ((LONGINT)(1)), i); +} + +void OPM_WriteStringVar (CHAR *s, LONGINT s__len) +{ + INTEGER i; + i = 0; + while (s[__X(i, s__len)] != 0x00) { + i += 1; + } + Files_WriteBytes(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, (void*)s, s__len * ((LONGINT)(1)), i); +} + +void OPM_WriteHex (LONGINT i) +{ + CHAR s[3]; + INTEGER digit; + digit = __ASHR((int)i, 4); + if (digit < 10) { + s[0] = (CHAR)(48 + digit); + } else { + s[0] = (CHAR)(87 + digit); + } + digit = __MASK((int)i, -16); + if (digit < 10) { + s[1] = (CHAR)(48 + digit); + } else { + s[1] = (CHAR)(87 + digit); + } + s[2] = 0x00; + OPM_WriteString(s, ((LONGINT)(3))); +} + +void OPM_WriteInt (LONGINT i) +{ + CHAR s[20]; + LONGINT i1, k; + if (i == OPM_MinInt || i == OPM_MinLInt) { + OPM_Write('('); + OPM_WriteInt(i + 1); + OPM_WriteString((CHAR*)"-1)", (LONGINT)4); + } else { + i1 = __ABS(i); + s[0] = (CHAR)(__MOD(i1, 10) + 48); + i1 = __DIV(i1, 10); + k = 1; + while (i1 > 0) { + s[__X(k, ((LONGINT)(20)))] = (CHAR)(__MOD(i1, 10) + 48); + i1 = __DIV(i1, 10); + k += 1; + } + if (i < 0) { + s[__X(k, ((LONGINT)(20)))] = '-'; + k += 1; + } + while (k > 0) { + k -= 1; + OPM_Write(s[__X(k, ((LONGINT)(20)))]); + } + } +} + +void OPM_WriteReal (LONGREAL r, CHAR suffx) +{ + Texts_Writer W; + Texts_Text T = NIL; + Texts_Reader R; + CHAR s[32]; + CHAR ch; + INTEGER i; + if ((((r < OPM_MaxLInt && r > OPM_MinLInt)) && r == (__ENTIER(r)))) { + if (suffx == 'f') { + OPM_WriteString((CHAR*)"(REAL)", (LONGINT)7); + } else { + OPM_WriteString((CHAR*)"(LONGREAL)", (LONGINT)11); + } + OPM_WriteInt(__ENTIER(r)); + } else { + Texts_OpenWriter(&W, Texts_Writer__typ); + if (suffx == 'f') { + Texts_WriteLongReal(&W, Texts_Writer__typ, r, 16); + } else { + Texts_WriteLongReal(&W, Texts_Writer__typ, r, 23); + } + __NEW(T, Texts_TextDesc); + Texts_Open(T, (CHAR*)"", (LONGINT)1); + Texts_Append(T, W.buf); + Texts_OpenReader(&R, Texts_Reader__typ, T, ((LONGINT)(0))); + i = 0; + Texts_Read(&R, Texts_Reader__typ, &ch); + while (ch != 0x00) { + s[__X(i, ((LONGINT)(32)))] = ch; + i += 1; + Texts_Read(&R, Texts_Reader__typ, &ch); + } + s[__X(i, ((LONGINT)(32)))] = 0x00; + i = 0; + ch = s[0]; + while ((ch != 'D' && ch != 0x00)) { + i += 1; + ch = s[__X(i, ((LONGINT)(32)))]; + } + if (ch == 'D') { + s[__X(i, ((LONGINT)(32)))] = 'e'; + } + OPM_WriteString(s, ((LONGINT)(32))); + } +} + +void OPM_WriteLn (void) +{ + Files_Write(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, 0x0a); +} + +static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F) +{ + Files_Rider R1; + CHAR buffer[4096]; + if (F != NIL) { + Files_Set(&R1, Files_Rider__typ, F, ((LONGINT)(0))); + Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, ((LONGINT)(4096)), ((LONGINT)(4096))); + while (4096 - R1.res > 0) { + Files_WriteBytes(&*R, R__typ, (void*)buffer, ((LONGINT)(4096)), 4096 - R1.res); + Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, ((LONGINT)(4096)), ((LONGINT)(4096))); + } + } +} + +void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len) +{ + CHAR FName[32]; + __COPY(moduleName, OPM_modName, ((LONGINT)(32))); + OPM_HFile = Files_New((CHAR*)"", (LONGINT)1); + if (OPM_HFile != NIL) { + Files_Set(&OPM_R[0], Files_Rider__typ, OPM_HFile, ((LONGINT)(0))); + } else { + OPM_err(153); + } + OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, ((LONGINT)(32)), (CHAR*)".c", (LONGINT)3); + OPM_BFile = Files_New(FName, ((LONGINT)(32))); + if (OPM_BFile != NIL) { + Files_Set(&OPM_R[1], Files_Rider__typ, OPM_BFile, ((LONGINT)(0))); + } else { + OPM_err(153); + } + OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, ((LONGINT)(32)), (CHAR*)".h", (LONGINT)3); + OPM_HIFile = Files_New(FName, ((LONGINT)(32))); + if (OPM_HIFile != NIL) { + Files_Set(&OPM_R[2], Files_Rider__typ, OPM_HIFile, ((LONGINT)(0))); + } else { + OPM_err(153); + } +} + +void OPM_CloseFiles (void) +{ + CHAR FName[32]; + INTEGER res; + if (OPM_noerr) { + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + OPM_LogWNum(Files_Pos(&OPM_R[1], Files_Rider__typ), ((LONGINT)(0))); + OPM_LogWStr((CHAR*)" chars.", (LONGINT)8); + } + if (OPM_noerr) { + if (__STRCMP(OPM_modName, "SYSTEM") == 0) { + if (!__IN(10, OPM_opt)) { + Files_Register(OPM_BFile); + } + } else if (!__IN(10, OPM_opt)) { + OPM_Append(&OPM_R[2], Files_Rider__typ, OPM_HFile); + Files_Register(OPM_HIFile); + Files_Register(OPM_BFile); + } else { + OPM_MakeFileName((void*)OPM_modName, ((LONGINT)(32)), (void*)FName, ((LONGINT)(32)), (CHAR*)".h", (LONGINT)3); + Files_Delete(FName, ((LONGINT)(32)), &res); + OPM_MakeFileName((void*)OPM_modName, ((LONGINT)(32)), (void*)FName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5); + Files_Delete(FName, ((LONGINT)(32)), &res); + Files_Register(OPM_BFile); + } + } + OPM_HFile = NIL; + OPM_BFile = NIL; + OPM_HIFile = NIL; + OPM_newSFile = NIL; + OPM_oldSFile = NIL; + Files_Set(&OPM_R[0], Files_Rider__typ, NIL, ((LONGINT)(0))); + Files_Set(&OPM_R[1], Files_Rider__typ, NIL, ((LONGINT)(0))); + Files_Set(&OPM_R[2], Files_Rider__typ, NIL, ((LONGINT)(0))); + Files_Set(&OPM_newSF, Files_Rider__typ, NIL, ((LONGINT)(0))); + Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, ((LONGINT)(0))); +} + +static void EnumPtrs(void (*P)(void*)) +{ + __ENUMR(&OPM_inR, Texts_Reader__typ, 48, 1, P); + P(OPM_Log); + __ENUMR(&OPM_W, Texts_Writer__typ, 36, 1, P); + __ENUMR(&OPM_oldSF, Files_Rider__typ, 20, 1, P); + __ENUMR(&OPM_newSF, Files_Rider__typ, 20, 1, P); + __ENUMR(OPM_R, Files_Rider__typ, 20, 3, P); + P(OPM_oldSFile); + P(OPM_newSFile); + P(OPM_HFile); + P(OPM_BFile); + P(OPM_HIFile); +} + + +export void *OPM__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Console); + __MODULE_IMPORT(Files); + __MODULE_IMPORT(Platform); + __MODULE_IMPORT(Strings); + __MODULE_IMPORT(Texts); + __MODULE_IMPORT(errors); + __MODULE_IMPORT(vt100); + __REGMOD("OPM", EnumPtrs); + __REGCMD("CloseFiles", OPM_CloseFiles); + __REGCMD("CloseOldSym", OPM_CloseOldSym); + __REGCMD("DeleteNewSym", OPM_DeleteNewSym); + __REGCMD("InitOptions", OPM_InitOptions); + __REGCMD("LogWLn", OPM_LogWLn); + __REGCMD("RegisterNewSym", OPM_RegisterNewSym); + __REGCMD("WriteLn", OPM_WriteLn); +/* BEGIN */ + Texts_OpenWriter(&OPM_W, Texts_Writer__typ); + OPM_MODULES[0] = 0x00; + Platform_GetEnv((CHAR*)"MODULES", (LONGINT)8, (void*)OPM_MODULES, ((LONGINT)(1024))); + __MOVE(".", OPM_OBERON, 2); + Platform_GetEnv((CHAR*)"OBERON", (LONGINT)7, (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append((CHAR*)";.;", (LONGINT)4, (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append(OPM_MODULES, ((LONGINT)(1024)), (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append((CHAR*)";", (LONGINT)2, (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append((CHAR*)"/sym;", (LONGINT)6, (void*)OPM_OBERON, ((LONGINT)(1024))); + Files_SetSearchPath(OPM_OBERON, ((LONGINT)(1024))); + OPM_CharSize = 1; + OPM_BoolSize = 1; + OPM_SIntSize = 1; + OPM_RecSize = 1; + OPM_ByteSize = 1; + OPM_RealSize = 4; + OPM_LRealSize = 8; + OPM_PointerSize = 8; + OPM_Alignment = 8; + OPM_IntSize = 4; + __ENDMOD; +} diff --git a/bootstrap/unix-44/OPM.h b/bootstrap/unix-44/OPM.h new file mode 100644 index 00000000..68bf3af0 --- /dev/null +++ b/bootstrap/unix-44/OPM.h @@ -0,0 +1,63 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPM__h +#define OPM__h + +#include "SYSTEM.h" + + +import INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_CharAlign, OPM_BoolAlign, OPM_SIntAlign, OPM_IntAlign, OPM_LIntAlign, OPM_SetAlign, OPM_RealAlign, OPM_LRealAlign, OPM_PointerAlign, OPM_ProcAlign, OPM_RecAlign, OPM_MaxSet; +import LONGINT OPM_MinSInt, OPM_MinInt, OPM_MinLInt, OPM_MaxSInt, OPM_MaxInt, OPM_MaxLInt, OPM_MaxIndex; +import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; +import BOOLEAN OPM_noerr; +import LONGINT OPM_curpos, OPM_errpos, OPM_breakpc; +import INTEGER OPM_currFile, OPM_level, OPM_pc, OPM_entno; +import CHAR OPM_modName[32]; +import CHAR OPM_objname[64]; +import SET OPM_opt, OPM_glbopt; +import BOOLEAN OPM_dontAsm, OPM_dontLink, OPM_mainProg, OPM_mainLinkStat, OPM_notColorOutput, OPM_forceNewSym, OPM_Verbose; + + +import void OPM_CloseFiles (void); +import void OPM_CloseOldSym (void); +import void OPM_DeleteNewSym (void); +import void OPM_FPrint (LONGINT *fp, LONGINT val); +import void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr); +import void OPM_FPrintReal (LONGINT *fp, REAL real); +import void OPM_FPrintSet (LONGINT *fp, SET set); +import void OPM_Get (CHAR *ch); +import void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len); +import void OPM_InitOptions (void); +import void OPM_LogW (CHAR ch); +import void OPM_LogWLn (void); +import void OPM_LogWNum (LONGINT i, LONGINT len); +import void OPM_LogWStr (CHAR *s, LONGINT s__len); +import void OPM_Mark (INTEGER n, LONGINT pos); +import void OPM_NewSym (CHAR *modName, LONGINT modName__len); +import void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done); +import void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len); +import BOOLEAN OPM_OpenPar (void); +import void OPM_RegisterNewSym (void); +import void OPM_SymRCh (CHAR *ch); +import LONGINT OPM_SymRInt (void); +import void OPM_SymRLReal (LONGREAL *lr); +import void OPM_SymRReal (REAL *r); +import void OPM_SymRSet (SET *s); +import void OPM_SymWCh (CHAR ch); +import void OPM_SymWInt (LONGINT i); +import void OPM_SymWLReal (LONGREAL lr); +import void OPM_SymWReal (REAL r); +import void OPM_SymWSet (SET s); +import void OPM_Write (CHAR ch); +import void OPM_WriteHex (LONGINT i); +import void OPM_WriteInt (LONGINT i); +import void OPM_WriteLn (void); +import void OPM_WriteReal (LONGREAL r, CHAR suffx); +import void OPM_WriteString (CHAR *s, LONGINT s__len); +import void OPM_WriteStringVar (CHAR *s, LONGINT s__len); +import BOOLEAN OPM_eofSF (void); +import void OPM_err (INTEGER n); +import void *OPM__init(void); + + +#endif diff --git a/bootstrap/unix-44/OPP.c b/bootstrap/unix-44/OPP.c new file mode 100644 index 00000000..f0530bb4 --- /dev/null +++ b/bootstrap/unix-44/OPP.c @@ -0,0 +1,1873 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "OPB.h" +#include "OPM.h" +#include "OPS.h" +#include "OPT.h" + +struct OPP__1 { + LONGINT low, high; +}; + +typedef + struct OPP__1 OPP_CaseTable[128]; + + +static SHORTINT OPP_sym, OPP_level; +static INTEGER OPP_LoopLevel; +static OPT_Node OPP_TDinit, OPP_lastTDinit; +static INTEGER OPP_nofFwdPtr; +static OPT_Struct OPP_FwdPtr[64]; + +export LONGINT *OPP__1__typ; + +static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar); +static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned); +static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq); +static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab); +static void OPP_CheckMark (SHORTINT *vis); +static void OPP_CheckSym (INTEGER s); +static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_); +static void OPP_ConstExpression (OPT_Node *x); +static void OPP_Element (OPT_Node *x); +static void OPP_Expression (OPT_Node *x); +static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b); +static void OPP_Factor (OPT_Node *x); +static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp); +export void OPP_Module (OPT_Node *prog, SET opt); +static void OPP_PointerType (OPT_Struct *typ); +static void OPP_ProcedureDeclaration (OPT_Node *x); +static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec); +static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned); +static void OPP_Sets (OPT_Node *x); +static void OPP_SimpleExpression (OPT_Node *x); +static void OPP_StandProcCall (OPT_Node *x); +static void OPP_StatSeq (OPT_Node *stat); +static void OPP_Term (OPT_Node *x); +static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned); +static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned); +static void OPP_err (INTEGER n); +static void OPP_qualident (OPT_Object *id); +static void OPP_selector (OPT_Node *x); + + +static void OPP_err (INTEGER n) +{ + OPM_err(n); +} + +static void OPP_CheckSym (INTEGER s) +{ + if ((int)OPP_sym == s) { + OPS_Get(&OPP_sym); + } else { + OPM_err(s); + } +} + +static void OPP_qualident (OPT_Object *id) +{ + OPT_Object obj = NIL; + SHORTINT lev; + OPT_Find(&obj); + OPS_Get(&OPP_sym); + if ((((OPP_sym == 18 && obj != NIL)) && obj->mode == 11)) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPT_FindImport(obj, &obj); + OPS_Get(&OPP_sym); + } else { + OPP_err(38); + obj = NIL; + } + } + if (obj == NIL) { + OPP_err(0); + obj = OPT_NewObj(); + obj->mode = 1; + obj->typ = OPT_undftyp; + obj->adr = 0; + } else { + lev = obj->mnolev; + if ((__IN(obj->mode, 0x06) && lev != OPP_level)) { + obj->leaf = 0; + if (lev > 0) { + OPB_StaticLink(OPP_level - lev); + } + } + } + *id = obj; +} + +static void OPP_ConstExpression (OPT_Node *x) +{ + OPP_Expression(&*x); + if ((*x)->class != 7) { + OPP_err(50); + *x = OPB_NewIntConst(((LONGINT)(1))); + } +} + +static void OPP_CheckMark (SHORTINT *vis) +{ + OPS_Get(&OPP_sym); + if (OPP_sym == 1 || OPP_sym == 7) { + if (OPP_level > 0) { + OPP_err(47); + } + if (OPP_sym == 1) { + *vis = 1; + } else { + *vis = 2; + } + OPS_Get(&OPP_sym); + } else { + *vis = 0; + } +} + +static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_) +{ + OPT_Node x = NIL; + LONGINT sf; + if (OPP_sym == 31) { + OPS_Get(&OPP_sym); + if (!OPT_SYSimported) { + OPP_err(135); + } + OPP_ConstExpression(&x); + if (__IN(x->typ->form, 0x70)) { + sf = x->conval->intval; + if (sf < 0 || sf > 1) { + OPP_err(220); + sf = 0; + } + } else { + OPP_err(51); + sf = 0; + } + *sysflag = (int)sf; + OPP_CheckSym(23); + } else { + *sysflag = default_; + } +} + +static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned) +{ + OPT_Object fld = NIL, first = NIL, last = NIL, base = NIL; + OPT_Struct ftyp = NIL; + INTEGER sysflag; + *typ = OPT_NewStr(15, 4); + (*typ)->BaseTyp = NIL; + OPP_CheckSysFlag(&sysflag, -1); + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPP_qualident(&base); + if ((base->mode == 5 && base->typ->comp == 4)) { + if (base->typ == *banned) { + OPP_err(58); + } else { + base->typ->pvused = 1; + (*typ)->BaseTyp = base->typ; + (*typ)->extlev = base->typ->extlev + 1; + (*typ)->sysflag = base->typ->sysflag; + } + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + OPP_CheckSym(22); + } + if (sysflag >= 0) { + (*typ)->sysflag = sysflag; + } + OPT_OpenScope(0, NIL); + first = NIL; + last = NIL; + for (;;) { + if (OPP_sym == 38) { + for (;;) { + if (OPP_sym == 38) { + if ((*typ)->BaseTyp != NIL) { + OPT_FindField(OPS_name, (*typ)->BaseTyp, &fld); + if (fld != NIL) { + OPP_err(1); + } + } + OPT_Insert(OPS_name, &fld); + OPP_CheckMark(&fld->vis); + fld->mode = 4; + fld->link = NIL; + fld->typ = OPT_undftyp; + if (first == NIL) { + first = fld; + } + if (last == NIL) { + (*typ)->link = fld; + } else { + last->link = fld; + } + last = fld; + } else { + OPP_err(38); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(19); + } else { + break; + } + } + OPP_CheckSym(20); + OPP_Type(&ftyp, &*banned); + ftyp->pvused = 1; + if (ftyp->comp == 3) { + ftyp = OPT_undftyp; + OPP_err(88); + } + while (first != NIL) { + first->typ = ftyp; + first = first->link; + } + } + if (OPP_sym == 39) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(39); + } else { + break; + } + } + OPT_CloseScope(); +} + +static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned) +{ + OPT_Node x = NIL; + LONGINT n; + INTEGER sysflag; + OPP_CheckSysFlag(&sysflag, 0); + if (OPP_sym == 25) { + *typ = OPT_NewStr(15, 3); + (*typ)->mno = 0; + (*typ)->sysflag = sysflag; + OPS_Get(&OPP_sym); + OPP_Type(&(*typ)->BaseTyp, &*banned); + (*typ)->BaseTyp->pvused = 1; + if ((*typ)->BaseTyp->comp == 3) { + (*typ)->n = (*typ)->BaseTyp->n + 1; + } else { + (*typ)->n = 0; + } + } else { + *typ = OPT_NewStr(15, 2); + (*typ)->sysflag = sysflag; + OPP_ConstExpression(&x); + if (__IN(x->typ->form, 0x70)) { + n = x->conval->intval; + if (n <= 0 || n > OPM_MaxIndex) { + OPP_err(63); + n = 1; + } + } else { + OPP_err(51); + n = 1; + } + (*typ)->n = n; + if (OPP_sym == 25) { + OPS_Get(&OPP_sym); + OPP_Type(&(*typ)->BaseTyp, &*banned); + (*typ)->BaseTyp->pvused = 1; + } else if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + if (OPP_sym != 25) { + OPP_ArrayType(&(*typ)->BaseTyp, &*banned); + } + } else { + OPP_err(35); + } + if ((*typ)->BaseTyp->comp == 3) { + (*typ)->BaseTyp = OPT_undftyp; + OPP_err(88); + } + } +} + +static void OPP_PointerType (OPT_Struct *typ) +{ + OPT_Object id = NIL; + *typ = OPT_NewStr(13, 1); + OPP_CheckSysFlag(&(*typ)->sysflag, 0); + OPP_CheckSym(28); + if (OPP_sym == 38) { + OPT_Find(&id); + if (id == NIL) { + if (OPP_nofFwdPtr < 64) { + OPP_FwdPtr[__X(OPP_nofFwdPtr, ((LONGINT)(64)))] = *typ; + OPP_nofFwdPtr += 1; + } else { + OPP_err(224); + } + (*typ)->link = OPT_NewObj(); + __COPY(OPS_name, (*typ)->link->name, ((LONGINT)(256))); + (*typ)->BaseTyp = OPT_undftyp; + OPS_Get(&OPP_sym); + } else { + OPP_qualident(&id); + if (id->mode == 5) { + if (__IN(id->typ->comp, 0x1c)) { + (*typ)->BaseTyp = id->typ; + } else { + (*typ)->BaseTyp = OPT_undftyp; + OPP_err(57); + } + } else { + (*typ)->BaseTyp = OPT_undftyp; + OPP_err(52); + } + } + } else { + OPP_Type(&(*typ)->BaseTyp, &OPT_notyp); + if (!__IN((*typ)->BaseTyp->comp, 0x1c)) { + (*typ)->BaseTyp = OPT_undftyp; + OPP_err(57); + } + } +} + +static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp) +{ + SHORTINT mode; + OPT_Object par = NIL, first = NIL, last = NIL, res = NIL; + OPT_Struct typ = NIL; + first = NIL; + last = *firstPar; + if (OPP_sym == 38 || OPP_sym == 60) { + for (;;) { + if (OPP_sym == 60) { + OPS_Get(&OPP_sym); + mode = 2; + } else { + mode = 1; + } + for (;;) { + if (OPP_sym == 38) { + OPT_Insert(OPS_name, &par); + OPS_Get(&OPP_sym); + par->mode = mode; + par->link = NIL; + if (first == NIL) { + first = par; + } + if (*firstPar == NIL) { + *firstPar = par; + } else { + last->link = par; + } + last = par; + } else { + OPP_err(38); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(19); + } else if (OPP_sym == 60) { + OPP_err(19); + OPS_Get(&OPP_sym); + } else { + break; + } + } + OPP_CheckSym(20); + OPP_Type(&typ, &OPT_notyp); + if (mode == 1) { + typ->pvused = 1; + } + while (first != NIL) { + first->typ = typ; + first = first->link; + } + if (OPP_sym == 39) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(39); + } else { + break; + } + } + } + OPP_CheckSym(22); + if (OPP_sym == 20) { + OPS_Get(&OPP_sym); + *resTyp = OPT_undftyp; + if (OPP_sym == 38) { + OPP_qualident(&res); + if (res->mode == 5) { + if (res->typ->form < 15) { + *resTyp = res->typ; + } else { + OPP_err(54); + } + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + } else { + *resTyp = OPT_notyp; + } +} + +static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned) +{ + OPT_Object id = NIL; + *typ = OPT_undftyp; + if (OPP_sym < 30) { + OPP_err(12); + do { + OPS_Get(&OPP_sym); + } while (!(OPP_sym >= 30)); + } + if (OPP_sym == 38) { + OPP_qualident(&id); + if (id->mode == 5) { + if (id->typ != *banned) { + *typ = id->typ; + } else { + OPP_err(58); + } + } else { + OPP_err(52); + } + } else if (OPP_sym == 54) { + OPS_Get(&OPP_sym); + OPP_ArrayType(&*typ, &*banned); + } else if (OPP_sym == 55) { + OPS_Get(&OPP_sym); + OPP_RecordType(&*typ, &*banned); + OPB_Inittd(&OPP_TDinit, &OPP_lastTDinit, *typ); + OPP_CheckSym(41); + } else if (OPP_sym == 56) { + OPS_Get(&OPP_sym); + OPP_PointerType(&*typ); + } else if (OPP_sym == 61) { + OPS_Get(&OPP_sym); + *typ = OPT_NewStr(14, 1); + OPP_CheckSysFlag(&(*typ)->sysflag, 0); + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPT_OpenScope(OPP_level, NIL); + OPP_FormalParameters(&(*typ)->link, &(*typ)->BaseTyp); + OPT_CloseScope(); + } else { + (*typ)->BaseTyp = OPT_notyp; + (*typ)->link = NIL; + } + } else { + OPP_err(12); + } + for (;;) { + if (((OPP_sym >= 39 && OPP_sym <= 42) || OPP_sym == 22) || OPP_sym == 64) { + break; + } + OPP_err(15); + if (OPP_sym == 38) { + break; + } + OPS_Get(&OPP_sym); + } +} + +static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned) +{ + OPP_TypeDecl(&*typ, &*banned); + if (((((*typ)->form == 13 && (*typ)->BaseTyp == OPT_undftyp)) && (*typ)->strobj == NIL)) { + OPP_err(0); + } +} + +static void OPP_selector (OPT_Node *x) +{ + OPT_Object obj = NIL, proc = NIL; + OPT_Node y = NIL; + OPT_Struct typ = NIL; + OPS_Name name; + for (;;) { + if (OPP_sym == 31) { + OPS_Get(&OPP_sym); + for (;;) { + if (((*x)->typ != NIL && (*x)->typ->form == 13)) { + OPB_DeRef(&*x); + } + OPP_Expression(&y); + OPB_Index(&*x, y); + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else { + break; + } + } + OPP_CheckSym(23); + } else if (OPP_sym == 18) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + __COPY(OPS_name, name, ((LONGINT)(256))); + OPS_Get(&OPP_sym); + if ((*x)->typ != NIL) { + if ((*x)->typ->form == 13) { + OPB_DeRef(&*x); + } + if ((*x)->typ->comp == 4) { + OPT_FindField(name, (*x)->typ, &obj); + OPB_Field(&*x, obj); + if ((obj != NIL && obj->mode == 13)) { + if (OPP_sym == 17) { + OPS_Get(&OPP_sym); + y = (*x)->left; + if (y->class == 3) { + y = y->left; + } + if (y->obj != NIL) { + proc = OPT_topScope; + while ((proc->link != NIL && proc->link->mode != 13)) { + proc = proc->left; + } + if (proc->link == NIL || proc->link->link != y->obj) { + OPP_err(75); + } + typ = y->obj->typ; + if (typ->form == 13) { + typ = typ->BaseTyp; + } + OPT_FindField((*x)->obj->name, typ->BaseTyp, &proc); + if (proc != NIL) { + (*x)->subcl = 1; + } else { + OPP_err(74); + } + } else { + OPP_err(75); + } + } + if ((obj->typ != OPT_notyp && OPP_sym != 30)) { + OPP_err(30); + } + } + } else { + OPP_err(53); + } + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + } else if (OPP_sym == 17) { + OPS_Get(&OPP_sym); + OPB_DeRef(&*x); + } else if ((((((OPP_sym == 30 && (*x)->class < 7)) && (*x)->typ->form != 14)) && ((*x)->obj == NIL || (*x)->obj->mode != 13))) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPP_qualident(&obj); + if (obj->mode == 5) { + OPB_TypTest(&*x, obj, 1); + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + OPP_CheckSym(22); + } else { + break; + } + } +} + +static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar) +{ + OPT_Node apar = NIL, last = NIL; + *aparlist = NIL; + last = NIL; + if (OPP_sym != 22) { + for (;;) { + OPP_Expression(&apar); + if (fpar != NIL) { + OPB_Param(apar, fpar); + OPB_Link(&*aparlist, &last, apar); + fpar = fpar->link; + } else { + OPP_err(64); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if ((30 <= OPP_sym && OPP_sym <= 38)) { + OPP_err(19); + } else { + break; + } + } + } + if (fpar != NIL) { + OPP_err(65); + } +} + +static void OPP_StandProcCall (OPT_Node *x) +{ + OPT_Node y = NIL; + SHORTINT m; + INTEGER n; + m = (int)(*x)->obj->adr; + n = 0; + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + if (OPP_sym != 22) { + for (;;) { + if (n == 0) { + OPP_Expression(&*x); + OPB_StPar0(&*x, m); + n = 1; + } else if (n == 1) { + OPP_Expression(&y); + OPB_StPar1(&*x, y, m); + n = 2; + } else { + OPP_Expression(&y); + OPB_StParN(&*x, y, m, n); + n += 1; + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if ((30 <= OPP_sym && OPP_sym <= 38)) { + OPP_err(19); + } else { + break; + } + } + OPP_CheckSym(22); + } else { + OPS_Get(&OPP_sym); + } + OPB_StFct(&*x, m, n); + } else { + OPP_err(30); + } + if ((OPP_level > 0 && (m == 1 || m == 30))) { + OPT_topScope->link->leaf = 0; + } +} + +static void OPP_Element (OPT_Node *x) +{ + OPT_Node y = NIL; + OPP_Expression(&*x); + if (OPP_sym == 21) { + OPS_Get(&OPP_sym); + OPP_Expression(&y); + OPB_SetRange(&*x, y); + } else { + OPB_SetElem(&*x); + } +} + +static void OPP_Sets (OPT_Node *x) +{ + OPT_Node y = NIL; + if (OPP_sym != 24) { + OPP_Element(&*x); + for (;;) { + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if ((30 <= OPP_sym && OPP_sym <= 38)) { + OPP_err(19); + } else { + break; + } + OPP_Element(&y); + OPB_Op(6, &*x, y); + } + } else { + *x = OPB_EmptySet(); + } + OPP_CheckSym(24); +} + +static void OPP_Factor (OPT_Node *x) +{ + OPT_Object fpar = NIL, id = NIL; + OPT_Node apar = NIL; + if (OPP_sym < 30) { + OPP_err(13); + do { + OPS_Get(&OPP_sym); + } while (!(OPP_sym >= 30)); + } + if (OPP_sym == 38) { + OPP_qualident(&id); + *x = OPB_NewLeaf(id); + OPP_selector(&*x); + if (((*x)->class == 9 && (*x)->obj->mode == 8)) { + OPP_StandProcCall(&*x); + } else if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPB_PrepCall(&*x, &fpar); + OPP_ActualParameters(&apar, fpar); + OPB_Call(&*x, apar, fpar); + OPP_CheckSym(22); + if (OPP_level > 0) { + OPT_topScope->link->leaf = 0; + } + } + } else if (OPP_sym == 35) { + switch (OPS_numtyp) { + case 1: + *x = OPB_NewIntConst(OPS_intval); + (*x)->typ = OPT_chartyp; + break; + case 2: + *x = OPB_NewIntConst(OPS_intval); + break; + case 3: + *x = OPB_NewRealConst(OPS_realval, OPT_realtyp); + break; + case 4: + *x = OPB_NewRealConst(OPS_lrlval, OPT_lrltyp); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPP.Factor, OPS.numtyp = ", (LONGINT)44); + OPM_LogWNum(OPS_numtyp, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + OPS_Get(&OPP_sym); + } else if (OPP_sym == 37) { + *x = OPB_NewString(OPS_str, OPS_intval); + OPS_Get(&OPP_sym); + } else if (OPP_sym == 36) { + *x = OPB_Nil(); + OPS_Get(&OPP_sym); + } else if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPP_Expression(&*x); + OPP_CheckSym(22); + } else if (OPP_sym == 31) { + OPS_Get(&OPP_sym); + OPP_err(30); + OPP_Expression(&*x); + OPP_CheckSym(22); + } else if (OPP_sym == 32) { + OPS_Get(&OPP_sym); + OPP_Sets(&*x); + } else if (OPP_sym == 33) { + OPS_Get(&OPP_sym); + OPP_Factor(&*x); + OPB_MOp(33, &*x); + } else { + OPP_err(13); + OPS_Get(&OPP_sym); + *x = NIL; + } + if (*x == NIL) { + *x = OPB_NewIntConst(((LONGINT)(1))); + (*x)->typ = OPT_undftyp; + } +} + +static void OPP_Term (OPT_Node *x) +{ + OPT_Node y = NIL; + SHORTINT mulop; + OPP_Factor(&*x); + while ((1 <= OPP_sym && OPP_sym <= 5)) { + mulop = OPP_sym; + OPS_Get(&OPP_sym); + OPP_Factor(&y); + OPB_Op(mulop, &*x, y); + } +} + +static void OPP_SimpleExpression (OPT_Node *x) +{ + OPT_Node y = NIL; + SHORTINT addop; + if (OPP_sym == 7) { + OPS_Get(&OPP_sym); + OPP_Term(&*x); + OPB_MOp(7, &*x); + } else if (OPP_sym == 6) { + OPS_Get(&OPP_sym); + OPP_Term(&*x); + OPB_MOp(6, &*x); + } else { + OPP_Term(&*x); + } + while ((6 <= OPP_sym && OPP_sym <= 8)) { + addop = OPP_sym; + OPS_Get(&OPP_sym); + OPP_Term(&y); + OPB_Op(addop, &*x, y); + } +} + +static void OPP_Expression (OPT_Node *x) +{ + OPT_Node y = NIL; + OPT_Object obj = NIL; + SHORTINT relation; + OPP_SimpleExpression(&*x); + if ((9 <= OPP_sym && OPP_sym <= 14)) { + relation = OPP_sym; + OPS_Get(&OPP_sym); + OPP_SimpleExpression(&y); + OPB_Op(relation, &*x, y); + } else if (OPP_sym == 15) { + OPS_Get(&OPP_sym); + OPP_SimpleExpression(&y); + OPB_In(&*x, y); + } else if (OPP_sym == 16) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPP_qualident(&obj); + if (obj->mode == 5) { + OPB_TypTest(&*x, obj, 0); + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + } +} + +static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec) +{ + OPT_Object obj = NIL; + *typ = OPT_undftyp; + *rec = NIL; + if (OPP_sym == 60) { + OPS_Get(&OPP_sym); + *mode = 2; + } else { + *mode = 1; + } + __COPY(OPS_name, name, ((LONGINT)(256))); + OPP_CheckSym(38); + OPP_CheckSym(20); + if (OPP_sym == 38) { + OPT_Find(&obj); + OPS_Get(&OPP_sym); + if (obj == NIL) { + OPP_err(0); + } else if (obj->mode != 5) { + OPP_err(72); + } else { + *typ = obj->typ; + *rec = *typ; + if ((*rec)->form == 13) { + *rec = (*rec)->BaseTyp; + } + if (!((((*mode == 1 && (*typ)->form == 13)) && (*rec)->comp == 4) || (*mode == 2 && (*typ)->comp == 4))) { + OPP_err(70); + *rec = NIL; + } + if ((*rec != NIL && (*rec)->mno != OPP_level)) { + OPP_err(72); + *rec = NIL; + } + } + } else { + OPP_err(38); + } + OPP_CheckSym(22); + if (*rec == NIL) { + *rec = OPT_NewStr(15, 4); + (*rec)->BaseTyp = NIL; + } +} + +static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b) +{ + BOOLEAN _o_result; + if ((b->form == 13 && x->form == 13)) { + b = b->BaseTyp; + x = x->BaseTyp; + } + if ((b->comp == 4 && x->comp == 4)) { + do { + x = x->BaseTyp; + } while (!(x == NIL || x == b)); + } + _o_result = x == b; + return _o_result; +} + +static struct ProcedureDeclaration__16 { + OPT_Node *x; + OPT_Object *proc, *fwd; + OPS_Name *name; + SHORTINT *mode, *vis; + BOOLEAN *forward; + struct ProcedureDeclaration__16 *lnk; +} *ProcedureDeclaration__16_s; + +static void Body__17 (void); +static void GetCode__19 (void); +static void GetParams__21 (void); +static void TProcDecl__23 (void); + +static void GetCode__19 (void) +{ + OPT_ConstExt ext = NIL; + INTEGER n; + LONGINT c; + ext = OPT_NewExt(); + (*ProcedureDeclaration__16_s->proc)->conval->ext = ext; + n = 0; + if (OPP_sym == 37) { + while (OPS_str[__X(n, ((LONGINT)(256)))] != 0x00) { + (*ext)[__X(n + 1, ((LONGINT)(256)))] = OPS_str[__X(n, ((LONGINT)(256)))]; + n += 1; + } + (*ext)[0] = (CHAR)n; + OPS_Get(&OPP_sym); + } else { + for (;;) { + if (OPP_sym == 35) { + c = OPS_intval; + n += 1; + if ((c < 0 || c > 255) || n == 256) { + OPP_err(64); + c = 1; + n = 1; + } + OPS_Get(&OPP_sym); + (*ext)[__X(n, ((LONGINT)(256)))] = (CHAR)c; + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 35) { + OPP_err(19); + } else { + (*ext)[0] = (CHAR)n; + break; + } + } + } + (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1); +} + +static void GetParams__21 (void) +{ + (*ProcedureDeclaration__16_s->proc)->vis = *ProcedureDeclaration__16_s->vis; + (*ProcedureDeclaration__16_s->proc)->mode = *ProcedureDeclaration__16_s->mode; + (*ProcedureDeclaration__16_s->proc)->typ = OPT_notyp; + (*ProcedureDeclaration__16_s->proc)->conval = OPT_NewConst(); + (*ProcedureDeclaration__16_s->proc)->conval->setval = 0x0; + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPP_FormalParameters(&(*ProcedureDeclaration__16_s->proc)->link, &(*ProcedureDeclaration__16_s->proc)->typ); + } + if (*ProcedureDeclaration__16_s->fwd != NIL) { + OPB_CheckParameters((*ProcedureDeclaration__16_s->proc)->link, (*ProcedureDeclaration__16_s->fwd)->link, 1); + if ((*ProcedureDeclaration__16_s->proc)->typ != (*ProcedureDeclaration__16_s->fwd)->typ) { + OPP_err(117); + } + *ProcedureDeclaration__16_s->proc = *ProcedureDeclaration__16_s->fwd; + OPT_topScope = (*ProcedureDeclaration__16_s->proc)->scope; + if (*ProcedureDeclaration__16_s->mode == 10) { + (*ProcedureDeclaration__16_s->proc)->mode = 10; + } + } +} + +static void Body__17 (void) +{ + OPT_Node procdec = NIL, statseq = NIL; + LONGINT c; + c = OPM_errpos; + (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1); + OPP_CheckSym(39); + OPP_Block(&procdec, &statseq); + OPB_Enter(&procdec, statseq, *ProcedureDeclaration__16_s->proc); + *ProcedureDeclaration__16_s->x = procdec; + (*ProcedureDeclaration__16_s->x)->conval = OPT_NewConst(); + (*ProcedureDeclaration__16_s->x)->conval->intval = c; + if (OPP_sym == 38) { + if (__STRCMP(OPS_name, (*ProcedureDeclaration__16_s->proc)->name) != 0) { + OPP_err(4); + } + OPS_Get(&OPP_sym); + } else { + OPP_err(38); + } +} + +static void TProcDecl__23 (void) +{ + OPT_Object baseProc = NIL; + OPT_Struct objTyp = NIL, recTyp = NIL; + SHORTINT objMode; + OPS_Name objName; + OPS_Get(&OPP_sym); + *ProcedureDeclaration__16_s->mode = 13; + if (OPP_level > 0) { + OPP_err(73); + } + OPP_Receiver(&objMode, objName, &objTyp, &recTyp); + if (OPP_sym == 38) { + __COPY(OPS_name, *ProcedureDeclaration__16_s->name, ((LONGINT)(256))); + OPP_CheckMark(&*ProcedureDeclaration__16_s->vis); + OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp, &*ProcedureDeclaration__16_s->fwd); + OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp->BaseTyp, &baseProc); + if ((baseProc != NIL && baseProc->mode != 13)) { + baseProc = NIL; + } + if (*ProcedureDeclaration__16_s->fwd == baseProc) { + *ProcedureDeclaration__16_s->fwd = NIL; + } + if ((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mnolev != OPP_level)) { + *ProcedureDeclaration__16_s->fwd = NIL; + } + if ((((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mode == 13)) && !__IN(1, (*ProcedureDeclaration__16_s->fwd)->conval->setval))) { + *ProcedureDeclaration__16_s->proc = OPT_NewObj(); + (*ProcedureDeclaration__16_s->proc)->leaf = 1; + if ((*ProcedureDeclaration__16_s->fwd)->vis != *ProcedureDeclaration__16_s->vis) { + OPP_err(118); + } + } else { + if (*ProcedureDeclaration__16_s->fwd != NIL) { + OPP_err(1); + *ProcedureDeclaration__16_s->fwd = NIL; + } + OPT_OpenScope(0, NIL); + OPT_topScope->right = recTyp->link; + OPT_Insert(*ProcedureDeclaration__16_s->name, &*ProcedureDeclaration__16_s->proc); + recTyp->link = OPT_topScope->right; + OPT_CloseScope(); + } + OPP_level += 1; + OPT_OpenScope(OPP_level, *ProcedureDeclaration__16_s->proc); + OPT_Insert(objName, &(*ProcedureDeclaration__16_s->proc)->link); + (*ProcedureDeclaration__16_s->proc)->link->mode = objMode; + (*ProcedureDeclaration__16_s->proc)->link->typ = objTyp; + GetParams__21(); + if (baseProc != NIL) { + if (objMode != baseProc->link->mode || !OPP_Extends(objTyp, baseProc->link->typ)) { + OPP_err(115); + } + OPB_CheckParameters((*ProcedureDeclaration__16_s->proc)->link->link, baseProc->link->link, 0); + if ((*ProcedureDeclaration__16_s->proc)->typ != baseProc->typ) { + OPP_err(117); + } + if ((((((baseProc->vis == 1 && (*ProcedureDeclaration__16_s->proc)->vis == 0)) && recTyp->strobj != NIL)) && recTyp->strobj->vis == 1)) { + OPP_err(109); + } + (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(2); + } + if (!*ProcedureDeclaration__16_s->forward) { + Body__17(); + } + OPP_level -= 1; + OPT_CloseScope(); + } else { + OPP_err(38); + } +} + +static void OPP_ProcedureDeclaration (OPT_Node *x) +{ + OPT_Object proc = NIL, fwd = NIL; + OPS_Name name; + SHORTINT mode, vis; + BOOLEAN forward; + struct ProcedureDeclaration__16 _s; + _s.x = x; + _s.proc = &proc; + _s.fwd = &fwd; + _s.name = (void*)name; + _s.mode = &mode; + _s.vis = &vis; + _s.forward = &forward; + _s.lnk = ProcedureDeclaration__16_s; + ProcedureDeclaration__16_s = &_s; + proc = NIL; + forward = 0; + *x = NIL; + mode = 6; + if ((OPP_sym != 38 && OPP_sym != 30)) { + if (OPP_sym == 1) { + } else if (OPP_sym == 17) { + forward = 1; + } else if (OPP_sym == 6) { + mode = 10; + } else if (OPP_sym == 7) { + mode = 9; + } else { + OPP_err(38); + } + if ((__IN(mode, 0x0600) && !OPT_SYSimported)) { + OPP_err(135); + } + OPS_Get(&OPP_sym); + } + if (OPP_sym == 30) { + TProcDecl__23(); + } else if (OPP_sym == 38) { + OPT_Find(&fwd); + __COPY(OPS_name, name, ((LONGINT)(256))); + OPP_CheckMark(&vis); + if ((vis != 0 && mode == 6)) { + mode = 7; + } + if ((fwd != NIL && (fwd->mnolev != OPP_level || fwd->mode == 8))) { + fwd = NIL; + } + if ((((fwd != NIL && __IN(fwd->mode, 0xc0))) && !__IN(1, fwd->conval->setval))) { + proc = OPT_NewObj(); + proc->leaf = 1; + if (fwd->vis != vis) { + OPP_err(118); + } + } else { + if (fwd != NIL) { + OPP_err(1); + fwd = NIL; + } + OPT_Insert(name, &proc); + } + if ((mode != 6 && OPP_level > 0)) { + OPP_err(73); + } + OPP_level += 1; + OPT_OpenScope(OPP_level, proc); + proc->link = NIL; + GetParams__21(); + if (mode == 9) { + GetCode__19(); + } else if (!forward) { + Body__17(); + } + OPP_level -= 1; + OPT_CloseScope(); + } else { + OPP_err(38); + } + ProcedureDeclaration__16_s = _s.lnk; +} + +static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab) +{ + OPT_Node x = NIL, y = NIL, lastlab = NIL; + INTEGER i, f; + LONGINT xval, yval; + *lab = NIL; + lastlab = NIL; + for (;;) { + OPP_ConstExpression(&x); + f = x->typ->form; + if (__IN(f, 0x78)) { + xval = x->conval->intval; + } else { + OPP_err(61); + xval = 1; + } + if (__IN(f, 0x70)) { + if (LabelForm < f) { + OPP_err(60); + } + } else if (LabelForm != f) { + OPP_err(60); + } + if (OPP_sym == 21) { + OPS_Get(&OPP_sym); + OPP_ConstExpression(&y); + yval = y->conval->intval; + if (((int)y->typ->form != f && !((__IN(f, 0x70) && __IN(y->typ->form, 0x70))))) { + OPP_err(60); + } + if (yval < xval) { + OPP_err(63); + yval = xval; + } + } else { + yval = xval; + } + x->conval->intval2 = yval; + i = *n; + if (i < 128) { + for (;;) { + if (i == 0) { + break; + } + if (tab[__X(i - 1, ((LONGINT)(128)))].low <= yval) { + if (tab[__X(i - 1, ((LONGINT)(128)))].high >= xval) { + OPP_err(62); + } + break; + } + tab[__X(i, ((LONGINT)(128)))] = tab[__X(i - 1, ((LONGINT)(128)))]; + i -= 1; + } + tab[__X(i, ((LONGINT)(128)))].low = xval; + tab[__X(i, ((LONGINT)(128)))].high = yval; + *n += 1; + } else { + OPP_err(213); + } + OPB_Link(&*lab, &lastlab, x); + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 35 || OPP_sym == 38) { + OPP_err(19); + } else { + break; + } + } +} + +static struct StatSeq__30 { + LONGINT *pos; + struct StatSeq__30 *lnk; +} *StatSeq__30_s; + +static void CasePart__31 (OPT_Node *x); +static void CheckBool__33 (OPT_Node *x); +static void SetPos__35 (OPT_Node x); + +static void CasePart__31 (OPT_Node *x) +{ + INTEGER n; + LONGINT low, high; + BOOLEAN e; + OPP_CaseTable tab; + OPT_Node cases = NIL, lab = NIL, y = NIL, lastcase = NIL; + OPP_Expression(&*x); + *StatSeq__30_s->pos = OPM_errpos; + if ((*x)->class == 8 || (*x)->class == 9) { + OPP_err(126); + } else if (!__IN((*x)->typ->form, 0x78)) { + OPP_err(125); + } + OPP_CheckSym(25); + cases = NIL; + lastcase = NIL; + n = 0; + for (;;) { + if (OPP_sym < 40) { + OPP_CaseLabelList(&lab, (*x)->typ->form, &n, tab); + OPP_CheckSym(20); + OPP_StatSeq(&y); + OPB_Construct(17, &lab, y); + OPB_Link(&cases, &lastcase, lab); + } + if (OPP_sym == 40) { + OPS_Get(&OPP_sym); + } else { + break; + } + } + if (n > 0) { + low = tab[0].low; + high = tab[__X(n - 1, ((LONGINT)(128)))].high; + if (high - low > 512) { + OPP_err(209); + } + } else { + low = 1; + high = 0; + } + e = OPP_sym == 42; + if (e) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&y); + } else { + y = NIL; + OPM_Mark(-307, OPM_curpos); + } + OPB_Construct(16, &cases, y); + OPB_Construct(21, &*x, cases); + cases->conval = OPT_NewConst(); + cases->conval->intval = low; + cases->conval->intval2 = high; + if (e) { + cases->conval->setval = 0x02; + } else { + cases->conval->setval = 0x0; + } +} + +static void SetPos__35 (OPT_Node x) +{ + x->conval = OPT_NewConst(); + x->conval->intval = *StatSeq__30_s->pos; +} + +static void CheckBool__33 (OPT_Node *x) +{ + if ((*x)->class == 8 || (*x)->class == 9) { + OPP_err(126); + *x = OPB_NewBoolConst(0); + } else if ((*x)->typ->form != 2) { + OPP_err(120); + *x = OPB_NewBoolConst(0); + } + *StatSeq__30_s->pos = OPM_errpos; +} + +static void OPP_StatSeq (OPT_Node *stat) +{ + OPT_Object fpar = NIL, id = NIL, t = NIL, obj = NIL; + OPT_Struct idtyp = NIL; + BOOLEAN e; + OPT_Node s = NIL, x = NIL, y = NIL, z = NIL, apar = NIL, last = NIL, lastif = NIL; + LONGINT pos; + OPS_Name name; + struct StatSeq__30 _s; + _s.pos = &pos; + _s.lnk = StatSeq__30_s; + StatSeq__30_s = &_s; + *stat = NIL; + last = NIL; + for (;;) { + x = NIL; + if (OPP_sym < 38) { + OPP_err(14); + do { + OPS_Get(&OPP_sym); + } while (!(OPP_sym >= 38)); + } + if (OPP_sym == 38) { + OPP_qualident(&id); + x = OPB_NewLeaf(id); + OPP_selector(&x); + if (OPP_sym == 34) { + OPS_Get(&OPP_sym); + OPP_Expression(&y); + OPB_Assign(&x, y); + } else if (OPP_sym == 9) { + OPP_err(34); + OPS_Get(&OPP_sym); + OPP_Expression(&y); + OPB_Assign(&x, y); + } else if ((x->class == 9 && x->obj->mode == 8)) { + OPP_StandProcCall(&x); + if ((x != NIL && x->typ != OPT_notyp)) { + OPP_err(55); + } + } else { + OPB_PrepCall(&x, &fpar); + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPP_ActualParameters(&apar, fpar); + OPP_CheckSym(22); + } else { + apar = NIL; + if (fpar != NIL) { + OPP_err(65); + } + } + OPB_Call(&x, apar, fpar); + if (x->typ != OPT_notyp) { + OPP_err(55); + } + if (OPP_level > 0) { + OPT_topScope->link->leaf = 0; + } + } + pos = OPM_errpos; + } else if (OPP_sym == 45) { + OPS_Get(&OPP_sym); + OPP_Expression(&x); + CheckBool__33(&x); + OPP_CheckSym(26); + OPP_StatSeq(&y); + OPB_Construct(15, &x, y); + SetPos__35(x); + lastif = x; + while (OPP_sym == 43) { + OPS_Get(&OPP_sym); + OPP_Expression(&y); + CheckBool__33(&y); + OPP_CheckSym(26); + OPP_StatSeq(&z); + OPB_Construct(15, &y, z); + SetPos__35(y); + OPB_Link(&x, &lastif, y); + } + if (OPP_sym == 42) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&y); + } else { + y = NIL; + } + OPB_Construct(20, &x, y); + OPP_CheckSym(41); + OPB_OptIf(&x); + pos = OPM_errpos; + } else if (OPP_sym == 46) { + OPS_Get(&OPP_sym); + CasePart__31(&x); + OPP_CheckSym(41); + } else if (OPP_sym == 47) { + OPS_Get(&OPP_sym); + OPP_Expression(&x); + CheckBool__33(&x); + OPP_CheckSym(27); + OPP_StatSeq(&y); + OPB_Construct(22, &x, y); + OPP_CheckSym(41); + } else if (OPP_sym == 48) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&x); + if (OPP_sym == 44) { + OPS_Get(&OPP_sym); + OPP_Expression(&y); + CheckBool__33(&y); + } else { + OPP_err(44); + } + OPB_Construct(23, &x, y); + } else if (OPP_sym == 49) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPP_qualident(&id); + if (!__IN(id->typ->form, 0x70)) { + OPP_err(68); + } + OPP_CheckSym(34); + OPP_Expression(&y); + pos = OPM_errpos; + x = OPB_NewLeaf(id); + OPB_Assign(&x, y); + SetPos__35(x); + OPP_CheckSym(28); + OPP_Expression(&y); + pos = OPM_errpos; + if (y->class != 7) { + __MOVE("@@", name, 3); + OPT_Insert(name, &t); + __MOVE("@for", t->name, 5); + t->mode = 1; + t->typ = x->left->typ; + obj = OPT_topScope->scope; + if (obj == NIL) { + OPT_topScope->scope = t; + } else { + while (obj->link != NIL) { + obj = obj->link; + } + obj->link = t; + } + z = OPB_NewLeaf(t); + OPB_Assign(&z, y); + SetPos__35(z); + OPB_Link(&*stat, &last, z); + y = OPB_NewLeaf(t); + } else if (y->typ->form < 4 || y->typ->form > x->left->typ->form) { + OPP_err(113); + } + OPB_Link(&*stat, &last, x); + if (OPP_sym == 29) { + OPS_Get(&OPP_sym); + OPP_ConstExpression(&z); + } else { + z = OPB_NewIntConst(((LONGINT)(1))); + } + pos = OPM_errpos; + x = OPB_NewLeaf(id); + if (z->conval->intval > 0) { + OPB_Op(12, &x, y); + } else if (z->conval->intval < 0) { + OPB_Op(14, &x, y); + } else { + OPP_err(63); + OPB_Op(14, &x, y); + } + OPP_CheckSym(27); + OPP_StatSeq(&s); + y = OPB_NewLeaf(id); + OPB_StPar1(&y, z, 13); + SetPos__35(y); + if (s == NIL) { + s = y; + } else { + z = s; + while (z->link != NIL) { + z = z->link; + } + z->link = y; + } + OPP_CheckSym(41); + OPB_Construct(22, &x, s); + } else { + OPP_err(38); + } + } else if (OPP_sym == 50) { + OPS_Get(&OPP_sym); + OPP_LoopLevel += 1; + OPP_StatSeq(&x); + OPP_LoopLevel -= 1; + OPB_Construct(24, &x, NIL); + OPP_CheckSym(41); + pos = OPM_errpos; + } else if (OPP_sym == 51) { + OPS_Get(&OPP_sym); + idtyp = NIL; + x = NIL; + for (;;) { + if (OPP_sym == 38) { + OPP_qualident(&id); + y = OPB_NewLeaf(id); + if ((((id != NIL && id->typ->form == 13)) && (id->mode == 2 || !id->leaf))) { + OPP_err(245); + } + OPP_CheckSym(20); + if (OPP_sym == 38) { + OPP_qualident(&t); + if (t->mode == 5) { + if (id != NIL) { + idtyp = id->typ; + OPB_TypTest(&y, t, 0); + id->typ = t->typ; + } else { + OPP_err(130); + } + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + } else { + OPP_err(38); + } + pos = OPM_errpos; + OPP_CheckSym(27); + OPP_StatSeq(&s); + OPB_Construct(15, &y, s); + SetPos__35(y); + if (idtyp != NIL) { + id->typ = idtyp; + idtyp = NIL; + } + if (x == NIL) { + x = y; + lastif = x; + } else { + OPB_Link(&x, &lastif, y); + } + if (OPP_sym == 40) { + OPS_Get(&OPP_sym); + } else { + break; + } + } + e = OPP_sym == 42; + if (e) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&s); + } else { + s = NIL; + } + OPB_Construct(27, &x, s); + OPP_CheckSym(41); + if (e) { + x->subcl = 1; + } + } else if (OPP_sym == 52) { + OPS_Get(&OPP_sym); + if (OPP_LoopLevel == 0) { + OPP_err(46); + } + OPB_Construct(25, &x, NIL); + pos = OPM_errpos; + } else if (OPP_sym == 53) { + OPS_Get(&OPP_sym); + if (OPP_sym < 39) { + OPP_Expression(&x); + } + if (OPP_level > 0) { + OPB_Return(&x, OPT_topScope->link); + } else { + OPB_Return(&x, NIL); + } + pos = OPM_errpos; + } + if (x != NIL) { + SetPos__35(x); + OPB_Link(&*stat, &last, x); + } + if (OPP_sym == 39) { + OPS_Get(&OPP_sym); + } else if (OPP_sym <= 38 || (45 <= OPP_sym && OPP_sym <= 53)) { + OPP_err(39); + } else { + break; + } + } + StatSeq__30_s = _s.lnk; +} + +static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq) +{ + OPT_Struct typ = NIL; + OPT_Object obj = NIL, first = NIL, last = NIL; + OPT_Node x = NIL, lastdec = NIL; + INTEGER i; + first = NIL; + last = NIL; + OPP_nofFwdPtr = 0; + for (;;) { + if (OPP_sym == 58) { + OPS_Get(&OPP_sym); + while (OPP_sym == 38) { + OPT_Insert(OPS_name, &obj); + OPP_CheckMark(&obj->vis); + obj->typ = OPT_sinttyp; + obj->mode = 1; + if (OPP_sym == 9) { + OPS_Get(&OPP_sym); + OPP_ConstExpression(&x); + } else if (OPP_sym == 34) { + OPP_err(9); + OPS_Get(&OPP_sym); + OPP_ConstExpression(&x); + } else { + OPP_err(9); + x = OPB_NewIntConst(((LONGINT)(1))); + } + obj->mode = 3; + obj->typ = x->typ; + obj->conval = x->conval; + OPP_CheckSym(39); + } + } + if (OPP_sym == 59) { + OPS_Get(&OPP_sym); + while (OPP_sym == 38) { + OPT_Insert(OPS_name, &obj); + obj->mode = 5; + obj->typ = OPT_undftyp; + OPP_CheckMark(&obj->vis); + if (OPP_sym == 9) { + OPS_Get(&OPP_sym); + OPP_TypeDecl(&obj->typ, &obj->typ); + } else if (OPP_sym == 34 || OPP_sym == 20) { + OPP_err(9); + OPS_Get(&OPP_sym); + OPP_TypeDecl(&obj->typ, &obj->typ); + } else { + OPP_err(9); + } + if (obj->typ->strobj == NIL) { + obj->typ->strobj = obj; + } + if (__IN(obj->typ->comp, 0x1c)) { + i = 0; + while (i < OPP_nofFwdPtr) { + typ = OPP_FwdPtr[__X(i, ((LONGINT)(64)))]; + i += 1; + if (__STRCMP(typ->link->name, obj->name) == 0) { + typ->BaseTyp = obj->typ; + typ->link->name[0] = 0x00; + } + } + } + OPP_CheckSym(39); + } + } + if (OPP_sym == 60) { + OPS_Get(&OPP_sym); + while (OPP_sym == 38) { + for (;;) { + if (OPP_sym == 38) { + OPT_Insert(OPS_name, &obj); + OPP_CheckMark(&obj->vis); + obj->mode = 1; + obj->link = NIL; + obj->leaf = obj->vis == 0; + obj->typ = OPT_undftyp; + if (first == NIL) { + first = obj; + } + if (last == NIL) { + OPT_topScope->scope = obj; + } else { + last->link = obj; + } + last = obj; + } else { + OPP_err(38); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(19); + } else { + break; + } + } + OPP_CheckSym(20); + OPP_Type(&typ, &OPT_notyp); + typ->pvused = 1; + if (typ->comp == 3) { + typ = OPT_undftyp; + OPP_err(88); + } + while (first != NIL) { + first->typ = typ; + first = first->link; + } + OPP_CheckSym(39); + } + } + if (OPP_sym < 58 || OPP_sym > 60) { + break; + } + } + i = 0; + while (i < OPP_nofFwdPtr) { + if (OPP_FwdPtr[__X(i, ((LONGINT)(64)))]->link->name[0] != 0x00) { + OPP_err(128); + } + OPP_FwdPtr[__X(i, ((LONGINT)(64)))] = NIL; + i += 1; + } + OPT_topScope->adr = OPM_errpos; + *procdec = NIL; + lastdec = NIL; + while (OPP_sym == 61) { + OPS_Get(&OPP_sym); + OPP_ProcedureDeclaration(&x); + if (x != NIL) { + if (lastdec == NIL) { + *procdec = x; + } else { + lastdec->link = x; + } + lastdec = x; + } + OPP_CheckSym(39); + } + if (OPP_sym == 57) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&*statseq); + } else { + *statseq = NIL; + } + if ((OPP_level == 0 && OPP_TDinit != NIL)) { + OPP_lastTDinit->link = *statseq; + *statseq = OPP_TDinit; + } + OPP_CheckSym(41); +} + +void OPP_Module (OPT_Node *prog, SET opt) +{ + OPS_Name impName, aliasName; + OPT_Node procdec = NIL, statseq = NIL; + LONGINT c; + BOOLEAN done; + OPS_Init(); + OPP_LoopLevel = 0; + OPP_level = 0; + OPS_Get(&OPP_sym); + if (OPP_sym == 63) { + OPS_Get(&OPP_sym); + } else { + OPP_err(16); + } + if (OPP_sym == 38) { + OPM_LogWStr((CHAR*)"compiling ", (LONGINT)11); + OPM_LogWStr(OPS_name, ((LONGINT)(256))); + OPM_LogW('.'); + OPT_Init(OPS_name, opt); + OPS_Get(&OPP_sym); + OPP_CheckSym(39); + if (OPP_sym == 62) { + OPS_Get(&OPP_sym); + for (;;) { + if (OPP_sym == 38) { + __COPY(OPS_name, aliasName, ((LONGINT)(256))); + __COPY(aliasName, impName, ((LONGINT)(256))); + OPS_Get(&OPP_sym); + if (OPP_sym == 34) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + __COPY(OPS_name, impName, ((LONGINT)(256))); + OPS_Get(&OPP_sym); + } else { + OPP_err(38); + } + } + OPT_Import(aliasName, impName, &done); + } else { + OPP_err(38); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(19); + } else { + break; + } + } + OPP_CheckSym(39); + } + if (OPM_noerr) { + OPP_TDinit = NIL; + OPP_lastTDinit = NIL; + c = OPM_errpos; + OPP_Block(&procdec, &statseq); + OPB_Enter(&procdec, statseq, NIL); + *prog = procdec; + (*prog)->conval = OPT_NewConst(); + (*prog)->conval->intval = c; + if (OPP_sym == 38) { + if (__STRCMP(OPS_name, OPT_SelfName) != 0) { + OPP_err(4); + } + OPS_Get(&OPP_sym); + } else { + OPP_err(38); + } + if (OPP_sym != 18) { + OPP_err(18); + } + } + } else { + OPP_err(38); + } + OPP_TDinit = NIL; + OPP_lastTDinit = NIL; +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(OPP_TDinit); + P(OPP_lastTDinit); + __ENUMP(OPP_FwdPtr, 64, P); +} + +__TDESC(OPP__1, 1, 0) = {__TDFLDS("", 8), {-4}}; + +export void *OPP__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPB); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPS); + __MODULE_IMPORT(OPT); + __REGMOD("OPP", EnumPtrs); + __INITYP(OPP__1, OPP__1, 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-44/OPP.h b/bootstrap/unix-44/OPP.h new file mode 100644 index 00000000..1e0a1809 --- /dev/null +++ b/bootstrap/unix-44/OPP.h @@ -0,0 +1,16 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPP__h +#define OPP__h + +#include "SYSTEM.h" +#include "OPT.h" + + + + +import void OPP_Module (OPT_Node *prog, SET opt); +import void *OPP__init(void); + + +#endif diff --git a/bootstrap/unix-44/OPS.c b/bootstrap/unix-44/OPS.c new file mode 100644 index 00000000..88944148 --- /dev/null +++ b/bootstrap/unix-44/OPS.c @@ -0,0 +1,623 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tspkaSfF */ +#include "SYSTEM.h" +#include "OPM.h" + +typedef + CHAR OPS_Name[256]; + +typedef + CHAR OPS_String[256]; + + +export OPS_Name OPS_name; +export OPS_String OPS_str; +export INTEGER OPS_numtyp; +export LONGINT OPS_intval; +export REAL OPS_realval; +export LONGREAL OPS_lrlval; +static CHAR OPS_ch; + + +export void OPS_Get (SHORTINT *sym); +static void OPS_Identifier (SHORTINT *sym); +export void OPS_Init (void); +static void OPS_Number (void); +static void OPS_Str (SHORTINT *sym); +static void OPS_err (INTEGER n); + + +static void OPS_err (INTEGER n) +{ + OPM_err(n); +} + +static void OPS_Str (SHORTINT *sym) +{ + INTEGER i; + CHAR och; + i = 0; + och = OPS_ch; + for (;;) { + OPM_Get(&OPS_ch); + if (OPS_ch == och) { + break; + } + if (OPS_ch < ' ') { + OPS_err(3); + break; + } + if (i == 255) { + OPS_err(241); + break; + } + OPS_str[i] = OPS_ch; + i += 1; + } + OPM_Get(&OPS_ch); + OPS_str[i] = 0x00; + OPS_intval = i + 1; + if (OPS_intval == 2) { + *sym = 35; + OPS_numtyp = 1; + OPS_intval = (int)OPS_str[0]; + } else { + *sym = 37; + } +} + +static void OPS_Identifier (SHORTINT *sym) +{ + INTEGER i; + i = 0; + do { + OPS_name[i] = OPS_ch; + i += 1; + OPM_Get(&OPS_ch); + } while (!(((OPS_ch < '0' || ('9' < OPS_ch && __CAP(OPS_ch) < 'A')) || 'Z' < __CAP(OPS_ch)) || i == 256)); + if (i == 256) { + OPS_err(240); + i -= 1; + } + OPS_name[i] = 0x00; + *sym = 38; +} + +static struct Number__6 { + struct Number__6 *lnk; +} *Number__6_s; + +static INTEGER Ord__7 (CHAR ch, BOOLEAN hex); +static LONGREAL Ten__9 (INTEGER e); + +static LONGREAL Ten__9 (INTEGER e) +{ + LONGREAL _o_result; + LONGREAL x, p; + x = (LONGREAL)1; + p = (LONGREAL)10; + while (e > 0) { + if (__ODD(e)) { + x = x * p; + } + e = __ASHR(e, 1); + if (e > 0) { + p = p * p; + } + } + _o_result = x; + return _o_result; +} + +static INTEGER Ord__7 (CHAR ch, BOOLEAN hex) +{ + INTEGER _o_result; + if (ch <= '9') { + _o_result = (int)ch - 48; + return _o_result; + } else if (hex) { + _o_result = ((int)ch - 65) + 10; + return _o_result; + } else { + OPS_err(2); + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +static void OPS_Number (void) +{ + INTEGER i, m, n, d, e; + CHAR dig[24]; + LONGREAL f; + CHAR expCh; + BOOLEAN neg; + struct Number__6 _s; + _s.lnk = Number__6_s; + Number__6_s = &_s; + i = 0; + m = 0; + n = 0; + d = 0; + for (;;) { + if (('0' <= OPS_ch && OPS_ch <= '9') || (((d == 0 && 'A' <= OPS_ch)) && OPS_ch <= 'F')) { + if (m > 0 || OPS_ch != '0') { + if (n < 24) { + dig[n] = OPS_ch; + n += 1; + } + m += 1; + } + OPM_Get(&OPS_ch); + i += 1; + } else if (OPS_ch == '.') { + OPM_Get(&OPS_ch); + if (OPS_ch == '.') { + OPS_ch = 0x7f; + break; + } else if (d == 0) { + d = i; + } else { + OPS_err(2); + } + } else { + break; + } + } + if (d == 0) { + if (n == m) { + OPS_intval = 0; + i = 0; + if (OPS_ch == 'X') { + OPM_Get(&OPS_ch); + OPS_numtyp = 1; + if (n <= 2) { + while (i < n) { + OPS_intval = __ASHL(OPS_intval, 4) + (LONGINT)Ord__7(dig[i], 1); + i += 1; + } + } else { + OPS_err(203); + } + } else if (OPS_ch == 'H') { + OPM_Get(&OPS_ch); + OPS_numtyp = 2; + if (n <= 8) { + if ((n == 8 && dig[0] > '7')) { + OPS_intval = -1; + } + while (i < n) { + OPS_intval = __ASHL(OPS_intval, 4) + (LONGINT)Ord__7(dig[i], 1); + i += 1; + } + } else { + OPS_err(203); + } + } else { + OPS_numtyp = 2; + while (i < n) { + d = Ord__7(dig[i], 0); + i += 1; + if (OPS_intval <= __DIV(2147483647 - (LONGINT)d, 10)) { + OPS_intval = OPS_intval * 10 + (LONGINT)d; + } else { + OPS_err(203); + } + } + } + } else { + OPS_err(203); + } + } else { + f = (LONGREAL)0; + e = 0; + expCh = 'E'; + while (n > 0) { + n -= 1; + f = (Ord__7(dig[n], 0) + f) / (LONGREAL)(LONGREAL)10; + } + if (OPS_ch == 'E' || OPS_ch == 'D') { + expCh = OPS_ch; + OPM_Get(&OPS_ch); + neg = 0; + if (OPS_ch == '-') { + neg = 1; + OPM_Get(&OPS_ch); + } else if (OPS_ch == '+') { + OPM_Get(&OPS_ch); + } + if (('0' <= OPS_ch && OPS_ch <= '9')) { + do { + n = Ord__7(OPS_ch, 0); + OPM_Get(&OPS_ch); + if (e <= __DIV(32767 - n, 10)) { + e = e * 10 + n; + } else { + OPS_err(203); + } + } while (!(OPS_ch < '0' || '9' < OPS_ch)); + if (neg) { + e = -e; + } + } else { + OPS_err(2); + } + } + e -= (i - d) - m; + if (expCh == 'E') { + OPS_numtyp = 3; + if ((-37 < e && e <= 38)) { + if (e < 0) { + OPS_realval = (f / (LONGREAL)Ten__9(-e)); + } else { + OPS_realval = (f * Ten__9(e)); + } + } else { + OPS_err(203); + } + } else { + OPS_numtyp = 4; + if ((-307 < e && e <= 308)) { + if (e < 0) { + OPS_lrlval = f / (LONGREAL)Ten__9(-e); + } else { + OPS_lrlval = f * Ten__9(e); + } + } else { + OPS_err(203); + } + } + } + Number__6_s = _s.lnk; +} + +static struct Get__1 { + struct Get__1 *lnk; +} *Get__1_s; + +static void Comment__2 (void); + +static void Comment__2 (void) +{ + OPM_Get(&OPS_ch); + for (;;) { + for (;;) { + while (OPS_ch == '(') { + OPM_Get(&OPS_ch); + if (OPS_ch == '*') { + Comment__2(); + } + } + if (OPS_ch == '*') { + OPM_Get(&OPS_ch); + break; + } + if (OPS_ch == 0x00) { + break; + } + OPM_Get(&OPS_ch); + } + if (OPS_ch == ')') { + OPM_Get(&OPS_ch); + break; + } + if (OPS_ch == 0x00) { + OPS_err(5); + break; + } + } +} + +void OPS_Get (SHORTINT *sym) +{ + SHORTINT s; + struct Get__1 _s; + _s.lnk = Get__1_s; + Get__1_s = &_s; + OPM_errpos = OPM_curpos - 1; + while (OPS_ch <= ' ') { + if (OPS_ch == 0x00) { + *sym = 64; + return; + } else { + OPM_Get(&OPS_ch); + } + } + switch (OPS_ch) { + case '\"': case '\'': + OPS_Str(&s); + break; + case '#': + s = 10; + OPM_Get(&OPS_ch); + break; + case '&': + s = 5; + OPM_Get(&OPS_ch); + break; + case '(': + OPM_Get(&OPS_ch); + if (OPS_ch == '*') { + Comment__2(); + OPS_Get(&s); + } else { + s = 30; + } + break; + case ')': + s = 22; + OPM_Get(&OPS_ch); + break; + case '*': + s = 1; + OPM_Get(&OPS_ch); + break; + case '+': + s = 6; + OPM_Get(&OPS_ch); + break; + case ',': + s = 19; + OPM_Get(&OPS_ch); + break; + case '-': + s = 7; + OPM_Get(&OPS_ch); + break; + case '.': + OPM_Get(&OPS_ch); + if (OPS_ch == '.') { + OPM_Get(&OPS_ch); + s = 21; + } else { + s = 18; + } + break; + case '/': + s = 2; + OPM_Get(&OPS_ch); + break; + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + OPS_Number(); + s = 35; + break; + case ':': + OPM_Get(&OPS_ch); + if (OPS_ch == '=') { + OPM_Get(&OPS_ch); + s = 34; + } else { + s = 20; + } + break; + case ';': + s = 39; + OPM_Get(&OPS_ch); + break; + case '<': + OPM_Get(&OPS_ch); + if (OPS_ch == '=') { + OPM_Get(&OPS_ch); + s = 12; + } else { + s = 11; + } + break; + case '=': + s = 9; + OPM_Get(&OPS_ch); + break; + case '>': + OPM_Get(&OPS_ch); + if (OPS_ch == '=') { + OPM_Get(&OPS_ch); + s = 14; + } else { + s = 13; + } + break; + case 'A': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "ARRAY") == 0) { + s = 54; + } + break; + case 'B': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "BEGIN") == 0) { + s = 57; + } else if (__STRCMP(OPS_name, "BY") == 0) { + s = 29; + } + break; + case 'C': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "CASE") == 0) { + s = 46; + } else if (__STRCMP(OPS_name, "CONST") == 0) { + s = 58; + } + break; + case 'D': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "DO") == 0) { + s = 27; + } else if (__STRCMP(OPS_name, "DIV") == 0) { + s = 3; + } + break; + case 'E': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "END") == 0) { + s = 41; + } else if (__STRCMP(OPS_name, "ELSE") == 0) { + s = 42; + } else if (__STRCMP(OPS_name, "ELSIF") == 0) { + s = 43; + } else if (__STRCMP(OPS_name, "EXIT") == 0) { + s = 52; + } + break; + case 'F': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "FOR") == 0) { + s = 49; + } + break; + case 'I': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "IF") == 0) { + s = 45; + } else if (__STRCMP(OPS_name, "IN") == 0) { + s = 15; + } else if (__STRCMP(OPS_name, "IS") == 0) { + s = 16; + } else if (__STRCMP(OPS_name, "IMPORT") == 0) { + s = 62; + } + break; + case 'L': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "LOOP") == 0) { + s = 50; + } + break; + case 'M': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "MOD") == 0) { + s = 4; + } else if (__STRCMP(OPS_name, "MODULE") == 0) { + s = 63; + } + break; + case 'N': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "NIL") == 0) { + s = 36; + } + break; + case 'O': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "OR") == 0) { + s = 8; + } else if (__STRCMP(OPS_name, "OF") == 0) { + s = 25; + } + break; + case 'P': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "PROCEDURE") == 0) { + s = 61; + } else if (__STRCMP(OPS_name, "POINTER") == 0) { + s = 56; + } + break; + case 'R': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "RECORD") == 0) { + s = 55; + } else if (__STRCMP(OPS_name, "REPEAT") == 0) { + s = 48; + } else if (__STRCMP(OPS_name, "RETURN") == 0) { + s = 53; + } + break; + case 'T': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "THEN") == 0) { + s = 26; + } else if (__STRCMP(OPS_name, "TO") == 0) { + s = 28; + } else if (__STRCMP(OPS_name, "TYPE") == 0) { + s = 59; + } + break; + case 'U': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "UNTIL") == 0) { + s = 44; + } + break; + case 'V': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "VAR") == 0) { + s = 60; + } + break; + case 'W': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "WHILE") == 0) { + s = 47; + } else if (__STRCMP(OPS_name, "WITH") == 0) { + s = 51; + } + break; + case 'G': case 'H': case 'J': case 'K': case 'Q': + case 'S': case 'X': case 'Y': case 'Z': + OPS_Identifier(&s); + break; + case '[': + s = 31; + OPM_Get(&OPS_ch); + break; + case ']': + s = 23; + OPM_Get(&OPS_ch); + break; + case '^': + s = 17; + OPM_Get(&OPS_ch); + break; + case 'a': case 'b': case 'c': case 'd': case 'e': + case 'f': case 'g': case 'h': case 'i': case 'j': + case 'k': case 'l': case 'm': case 'n': case 'o': + case 'p': case 'q': case 'r': case 's': case 't': + case 'u': case 'v': case 'w': case 'x': case 'y': + case 'z': + OPS_Identifier(&s); + break; + case '{': + s = 32; + OPM_Get(&OPS_ch); + break; + case '|': + s = 40; + OPM_Get(&OPS_ch); + break; + case '}': + s = 24; + OPM_Get(&OPS_ch); + break; + case '~': + s = 33; + OPM_Get(&OPS_ch); + break; + case 0x7f: + s = 21; + OPM_Get(&OPS_ch); + break; + default: + s = 0; + OPM_Get(&OPS_ch); + break; + } + *sym = s; + Get__1_s = _s.lnk; +} + +void OPS_Init (void) +{ + OPS_ch = ' '; +} + + +export void *OPS__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPM); + __REGMOD("OPS", 0); + __REGCMD("Init", OPS_Init); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-44/OPS.h b/bootstrap/unix-44/OPS.h new file mode 100644 index 00000000..87a614f4 --- /dev/null +++ b/bootstrap/unix-44/OPS.h @@ -0,0 +1,28 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tspkaSfF */ + +#ifndef OPS__h +#define OPS__h + +#include "SYSTEM.h" + +typedef + CHAR OPS_Name[256]; + +typedef + CHAR OPS_String[256]; + + +import OPS_Name OPS_name; +import OPS_String OPS_str; +import INTEGER OPS_numtyp; +import LONGINT OPS_intval; +import REAL OPS_realval; +import LONGREAL OPS_lrlval; + + +import void OPS_Get (SHORTINT *sym); +import void OPS_Init (void); +import void *OPS__init(void); + + +#endif diff --git a/bootstrap/unix-44/OPT.c b/bootstrap/unix-44/OPT.c new file mode 100644 index 00000000..fc80ce02 --- /dev/null +++ b/bootstrap/unix-44/OPT.c @@ -0,0 +1,1858 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "OPM.h" +#include "OPS.h" + +typedef + struct OPT_ConstDesc *OPT_Const; + +typedef + OPS_String *OPT_ConstExt; + +typedef + struct OPT_ConstDesc { + OPT_ConstExt ext; + LONGINT intval, intval2; + SET setval; + LONGREAL realval; + } OPT_ConstDesc; + +typedef + struct OPT_ExpCtxt { + LONGINT reffp; + INTEGER ref; + SHORTINT nofm; + SHORTINT locmno[64]; + } OPT_ExpCtxt; + +typedef + struct OPT_StrDesc *OPT_Struct; + +typedef + struct OPT_ObjDesc *OPT_Object; + +typedef + struct OPT_ImpCtxt { + LONGINT nextTag, reffp; + INTEGER nofr, minr, nofm; + BOOLEAN self; + OPT_Struct ref[255]; + OPT_Object old[255]; + LONGINT pvfp[255]; + SHORTINT glbmno[64]; + } OPT_ImpCtxt; + +typedef + struct OPT_NodeDesc *OPT_Node; + +typedef + struct OPT_NodeDesc { + OPT_Node left, right, link; + SHORTINT class, subcl; + BOOLEAN readonly; + OPT_Struct typ; + OPT_Object obj; + OPT_Const conval; + } OPT_NodeDesc; + +typedef + struct OPT_ObjDesc { + OPT_Object left, right, link, scope; + OPS_Name name; + BOOLEAN leaf; + SHORTINT mode, mnolev, vis, history; + BOOLEAN used, fpdone; + LONGINT fprint; + OPT_Struct typ; + OPT_Const conval; + LONGINT adr, linkadr; + INTEGER x; + } OPT_ObjDesc; + +typedef + struct OPT_StrDesc { + SHORTINT form, comp, mno, extlev; + INTEGER ref, sysflag; + LONGINT n, size, align, txtpos; + BOOLEAN allocated, pbused, pvused, fpdone, idfpdone; + LONGINT idfp, pbfp, pvfp; + OPT_Struct BaseTyp; + OPT_Object link, strobj; + } OPT_StrDesc; + + +export void (*OPT_typSize)(OPT_Struct); +export OPT_Object OPT_topScope; +export OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp; +export SHORTINT OPT_nofGmod; +export OPT_Object OPT_GlbMod[64]; +export OPS_Name OPT_SelfName; +export BOOLEAN OPT_SYSimported; +static OPT_Object OPT_universe, OPT_syslink; +static OPT_ImpCtxt OPT_impCtxt; +static OPT_ExpCtxt OPT_expCtxt; +static LONGINT OPT_nofhdfld; +static BOOLEAN OPT_newsf, OPT_findpc, OPT_extsf, OPT_sfpresent, OPT_symExtended, OPT_symNew; + +export LONGINT *OPT_ConstDesc__typ; +export LONGINT *OPT_ObjDesc__typ; +export LONGINT *OPT_StrDesc__typ; +export LONGINT *OPT_NodeDesc__typ; +export LONGINT *OPT_ImpCtxt__typ; +export LONGINT *OPT_ExpCtxt__typ; + +export void OPT_Close (void); +export void OPT_CloseScope (void); +static void OPT_DebugStruct (OPT_Struct btyp); +static void OPT_EnterBoolConst (OPS_Name name, LONGINT value); +static void OPT_EnterProc (OPS_Name name, INTEGER num); +static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res); +export void OPT_Export (BOOLEAN *ext, BOOLEAN *new); +export void OPT_FPrintErr (OPT_Object obj, INTEGER errcode); +static void OPT_FPrintName (LONGINT *fp, CHAR *name, LONGINT name__len); +export void OPT_FPrintObj (OPT_Object obj); +static void OPT_FPrintSign (LONGINT *fp, OPT_Struct result, OPT_Object par); +export void OPT_FPrintStr (OPT_Struct typ); +export void OPT_Find (OPT_Object *res); +export void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res); +export void OPT_FindImport (OPT_Object mod, OPT_Object *res); +export void OPT_IdFPrint (OPT_Struct typ); +export void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done); +static void OPT_InConstant (LONGINT f, OPT_Const conval); +static OPT_Object OPT_InFld (void); +static void OPT_InMod (SHORTINT *mno); +static void OPT_InName (CHAR *name, LONGINT name__len); +static OPT_Object OPT_InObj (SHORTINT mno); +static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par); +static void OPT_InStruct (OPT_Struct *typ); +static OPT_Object OPT_InTProc (SHORTINT mno); +export void OPT_Init (OPS_Name name, SET opt); +static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form); +export void OPT_Insert (OPS_Name name, OPT_Object *obj); +export void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old); +export OPT_Const OPT_NewConst (void); +export OPT_ConstExt OPT_NewExt (void); +export OPT_Node OPT_NewNode (SHORTINT class); +export OPT_Object OPT_NewObj (void); +export OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp); +export void OPT_OpenScope (SHORTINT level, OPT_Object owner); +static void OPT_OutConstant (OPT_Object obj); +static void OPT_OutFlds (OPT_Object fld, LONGINT adr, BOOLEAN visible); +static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr); +static void OPT_OutMod (INTEGER mno); +static void OPT_OutName (CHAR *name, LONGINT name__len); +static void OPT_OutObj (OPT_Object obj); +static void OPT_OutSign (OPT_Struct result, OPT_Object par); +static void OPT_OutStr (OPT_Struct typ); +static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj); +static void OPT_err (INTEGER n); + + +static void OPT_err (INTEGER n) +{ + OPM_err(n); +} + +OPT_Const OPT_NewConst (void) +{ + OPT_Const _o_result; + OPT_Const const_ = NIL; + __NEW(const_, OPT_ConstDesc); + _o_result = const_; + return _o_result; +} + +OPT_Object OPT_NewObj (void) +{ + OPT_Object _o_result; + OPT_Object obj = NIL; + __NEW(obj, OPT_ObjDesc); + _o_result = obj; + return _o_result; +} + +OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp) +{ + OPT_Struct _o_result; + OPT_Struct typ = NIL; + __NEW(typ, OPT_StrDesc); + typ->form = form; + typ->comp = comp; + typ->ref = 255; + if (form != 0) { + typ->txtpos = OPM_errpos; + } + typ->size = -1; + typ->BaseTyp = OPT_undftyp; + _o_result = typ; + return _o_result; +} + +OPT_Node OPT_NewNode (SHORTINT class) +{ + OPT_Node _o_result; + OPT_Node node = NIL; + __NEW(node, OPT_NodeDesc); + node->class = class; + _o_result = node; + return _o_result; +} + +OPT_ConstExt OPT_NewExt (void) +{ + OPT_ConstExt _o_result; + OPT_ConstExt ext = NIL; + ext = __NEWARR(NIL, ((LONGINT)(1)), 1, 1, 0, (LONGINT)256); + _o_result = ext; + return _o_result; +} + +void OPT_OpenScope (SHORTINT level, OPT_Object owner) +{ + OPT_Object head = NIL; + head = OPT_NewObj(); + head->mode = 12; + head->mnolev = level; + head->link = owner; + if (owner != NIL) { + owner->scope = head; + } + head->left = OPT_topScope; + head->right = NIL; + head->scope = NIL; + OPT_topScope = head; +} + +void OPT_CloseScope (void) +{ + OPT_topScope = OPT_topScope->left; +} + +void OPT_Init (OPS_Name name, SET opt) +{ + OPT_topScope = OPT_universe; + OPT_OpenScope(0, NIL); + OPT_SYSimported = 0; + __COPY(name, OPT_SelfName, ((LONGINT)(256))); + __COPY(name, OPT_topScope->name, ((LONGINT)(256))); + OPT_GlbMod[0] = OPT_topScope; + OPT_nofGmod = 1; + OPT_newsf = __IN(4, opt); + OPT_findpc = __IN(8, opt); + OPT_extsf = OPT_newsf || __IN(9, opt); + OPT_sfpresent = 1; +} + +void OPT_Close (void) +{ + INTEGER i; + OPT_CloseScope(); + i = 0; + while (i < 64) { + OPT_GlbMod[__X(i, ((LONGINT)(64)))] = NIL; + i += 1; + } + i = 16; + while (i < 255) { + OPT_impCtxt.ref[__X(i, ((LONGINT)(255)))] = NIL; + OPT_impCtxt.old[__X(i, ((LONGINT)(255)))] = NIL; + i += 1; + } +} + +void OPT_FindImport (OPT_Object mod, OPT_Object *res) +{ + OPT_Object obj = NIL; + obj = mod->scope; + for (;;) { + if (obj == NIL) { + break; + } + if (__STRCMP(OPS_name, obj->name) < 0) { + obj = obj->left; + } else if (__STRCMP(OPS_name, obj->name) > 0) { + obj = obj->right; + } else { + if ((obj->mode == 5 && obj->vis == 0)) { + obj = NIL; + } else { + obj->used = 1; + } + break; + } + } + *res = obj; +} + +void OPT_Find (OPT_Object *res) +{ + OPT_Object obj = NIL, head = NIL; + head = OPT_topScope; + for (;;) { + obj = head->right; + for (;;) { + if (obj == NIL) { + break; + } + if (__STRCMP(OPS_name, obj->name) < 0) { + obj = obj->left; + } else if (__STRCMP(OPS_name, obj->name) > 0) { + obj = obj->right; + } else { + break; + } + } + if (obj != NIL) { + break; + } + head = head->left; + if (head == NIL) { + break; + } + } + *res = obj; +} + +void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res) +{ + OPT_Object obj = NIL; + while (typ != NIL) { + obj = typ->link; + while (obj != NIL) { + if (__STRCMP(name, obj->name) < 0) { + obj = obj->left; + } else if (__STRCMP(name, obj->name) > 0) { + obj = obj->right; + } else { + *res = obj; + return; + } + } + typ = typ->BaseTyp; + } + *res = NIL; +} + +void OPT_Insert (OPS_Name name, OPT_Object *obj) +{ + OPT_Object ob0 = NIL, ob1 = NIL; + BOOLEAN left; + SHORTINT mnolev; + ob0 = OPT_topScope; + ob1 = ob0->right; + left = 0; + for (;;) { + if (ob1 != NIL) { + if (__STRCMP(name, ob1->name) < 0) { + ob0 = ob1; + ob1 = ob0->left; + left = 1; + } else if (__STRCMP(name, ob1->name) > 0) { + ob0 = ob1; + ob1 = ob0->right; + left = 0; + } else { + OPT_err(1); + ob0 = ob1; + ob1 = ob0->right; + } + } else { + ob1 = OPT_NewObj(); + ob1->leaf = 1; + if (left) { + ob0->left = ob1; + } else { + ob0->right = ob1; + } + ob1->left = NIL; + ob1->right = NIL; + __COPY(name, ob1->name, ((LONGINT)(256))); + mnolev = OPT_topScope->mnolev; + ob1->mnolev = mnolev; + break; + } + } + *obj = ob1; +} + +static void OPT_FPrintName (LONGINT *fp, CHAR *name, LONGINT name__len) +{ + INTEGER i; + CHAR ch; + i = 0; + do { + ch = name[__X(i, name__len)]; + OPM_FPrint(&*fp, (int)ch); + i += 1; + } while (!(ch == 0x00)); +} + +static void OPT_DebugStruct (OPT_Struct btyp) +{ + OPM_LogWLn(); + if (btyp == NIL) { + OPM_LogWStr((CHAR*)"btyp is nil", (LONGINT)12); + OPM_LogWLn(); + } + OPM_LogWStr((CHAR*)"btyp^.strobji^.name = ", (LONGINT)23); + OPM_LogWStr(btyp->strobj->name, ((LONGINT)(256))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.form = ", (LONGINT)14); + OPM_LogWNum(btyp->form, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.comp = ", (LONGINT)14); + OPM_LogWNum(btyp->comp, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.mno = ", (LONGINT)13); + OPM_LogWNum(btyp->mno, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.extlev = ", (LONGINT)16); + OPM_LogWNum(btyp->extlev, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.size = ", (LONGINT)14); + OPM_LogWNum(btyp->size, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.align = ", (LONGINT)15); + OPM_LogWNum(btyp->align, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.txtpos = ", (LONGINT)16); + OPM_LogWNum(btyp->txtpos, ((LONGINT)(0))); + OPM_LogWLn(); +} + +static void OPT_FPrintSign (LONGINT *fp, OPT_Struct result, OPT_Object par) +{ + OPT_IdFPrint(result); + OPM_FPrint(&*fp, result->idfp); + while (par != NIL) { + OPM_FPrint(&*fp, par->mode); + OPT_IdFPrint(par->typ); + OPM_FPrint(&*fp, par->typ->idfp); + par = par->link; + } +} + +void OPT_IdFPrint (OPT_Struct typ) +{ + OPT_Struct btyp = NIL; + OPT_Object strobj = NIL; + LONGINT idfp; + INTEGER f, c; + if (!typ->idfpdone) { + typ->idfpdone = 1; + idfp = 0; + f = typ->form; + c = typ->comp; + OPM_FPrint(&idfp, f); + OPM_FPrint(&idfp, c); + btyp = typ->BaseTyp; + strobj = typ->strobj; + if ((strobj != NIL && strobj->name[0] != 0x00)) { + OPT_FPrintName(&idfp, (void*)OPT_GlbMod[__X(typ->mno, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + OPT_FPrintName(&idfp, (void*)strobj->name, ((LONGINT)(256))); + } + if ((f == 13 || (c == 4 && btyp != NIL)) || c == 3) { + OPT_IdFPrint(btyp); + OPM_FPrint(&idfp, btyp->idfp); + } else if (c == 2) { + OPT_IdFPrint(btyp); + OPM_FPrint(&idfp, btyp->idfp); + OPM_FPrint(&idfp, typ->n); + } else if (f == 14) { + OPT_FPrintSign(&idfp, btyp, typ->link); + } + typ->idfp = idfp; + } +} + +static struct FPrintStr__12 { + LONGINT *pbfp, *pvfp; + struct FPrintStr__12 *lnk; +} *FPrintStr__12_s; + +static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible); +static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr); +static void FPrintTProcs__17 (OPT_Object obj); + +static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr) +{ + LONGINT i, j, n; + OPT_Struct btyp = NIL; + if (typ->comp == 4) { + FPrintFlds__13(typ->link, adr, 0); + } else if (typ->comp == 2) { + btyp = typ->BaseTyp; + n = typ->n; + while (btyp->comp == 2) { + n = btyp->n * n; + btyp = btyp->BaseTyp; + } + if (btyp->form == 13 || btyp->comp == 4) { + j = OPT_nofhdfld; + FPrintHdFld__15(btyp, fld, adr); + if (j != OPT_nofhdfld) { + i = 1; + while ((i < n && OPT_nofhdfld <= 2048)) { + adr += btyp->size; + FPrintHdFld__15(btyp, fld, adr); + i += 1; + } + } + } + } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) { + OPM_FPrint(&*FPrintStr__12_s->pvfp, ((LONGINT)(13))); + OPM_FPrint(&*FPrintStr__12_s->pvfp, adr); + OPT_nofhdfld += 1; + } +} + +static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible) +{ + while ((fld != NIL && fld->mode == 4)) { + if ((fld->vis != 0 && visible)) { + OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->vis); + OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)fld->name, ((LONGINT)(256))); + OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->adr); + OPT_FPrintStr(fld->typ); + OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->typ->pbfp); + OPM_FPrint(&*FPrintStr__12_s->pvfp, fld->typ->pvfp); + } else { + FPrintHdFld__15(fld->typ, fld, fld->adr + adr); + } + fld = fld->link; + } +} + +static void FPrintTProcs__17 (OPT_Object obj) +{ + if (obj != NIL) { + FPrintTProcs__17(obj->left); + if (obj->mode == 13) { + if (obj->vis != 0) { + OPM_FPrint(&*FPrintStr__12_s->pbfp, ((LONGINT)(13))); + OPM_FPrint(&*FPrintStr__12_s->pbfp, __ASHR(obj->adr, 16)); + OPT_FPrintSign(&*FPrintStr__12_s->pbfp, obj->typ, obj->link); + OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)obj->name, ((LONGINT)(256))); + } + } + FPrintTProcs__17(obj->right); + } +} + +void OPT_FPrintStr (OPT_Struct typ) +{ + INTEGER f, c; + OPT_Struct btyp = NIL; + OPT_Object strobj = NIL, bstrobj = NIL; + LONGINT pbfp, pvfp; + struct FPrintStr__12 _s; + _s.pbfp = &pbfp; + _s.pvfp = &pvfp; + _s.lnk = FPrintStr__12_s; + FPrintStr__12_s = &_s; + if (!typ->fpdone) { + OPT_IdFPrint(typ); + pbfp = typ->idfp; + if (typ->sysflag != 0) { + OPM_FPrint(&pbfp, typ->sysflag); + } + pvfp = pbfp; + typ->pbfp = pbfp; + typ->pvfp = pvfp; + typ->fpdone = 1; + f = typ->form; + c = typ->comp; + btyp = typ->BaseTyp; + if (f == 13) { + strobj = typ->strobj; + bstrobj = btyp->strobj; + if (((strobj == NIL || strobj->name[0] == 0x00) || bstrobj == NIL) || bstrobj->name[0] == 0x00) { + OPT_FPrintStr(btyp); + OPM_FPrint(&pbfp, btyp->pbfp); + pvfp = pbfp; + } + } else if (f == 14) { + } else if (__IN(c, 0x0c)) { + OPT_FPrintStr(btyp); + OPM_FPrint(&pbfp, btyp->pvfp); + pvfp = pbfp; + } else { + if (btyp != NIL) { + OPT_FPrintStr(btyp); + OPM_FPrint(&pbfp, btyp->pbfp); + OPM_FPrint(&pvfp, btyp->pvfp); + } + OPM_FPrint(&pvfp, typ->size); + OPM_FPrint(&pvfp, typ->align); + OPM_FPrint(&pvfp, typ->n); + OPT_nofhdfld = 0; + FPrintFlds__13(typ->link, ((LONGINT)(0)), 1); + if (OPT_nofhdfld > 2048) { + OPM_Mark(225, typ->txtpos); + } + FPrintTProcs__17(typ->link); + OPM_FPrint(&pvfp, pbfp); + strobj = typ->strobj; + if (strobj == NIL || strobj->name[0] == 0x00) { + pbfp = pvfp; + } + } + typ->pbfp = pbfp; + typ->pvfp = pvfp; + } + FPrintStr__12_s = _s.lnk; +} + +void OPT_FPrintObj (OPT_Object obj) +{ + LONGINT fprint; + INTEGER f, m; + REAL rval; + OPT_ConstExt ext = NIL; + if (!obj->fpdone) { + fprint = 0; + obj->fpdone = 1; + OPM_FPrint(&fprint, obj->mode); + if (obj->mode == 3) { + f = obj->typ->form; + OPM_FPrint(&fprint, f); + switch (f) { + case 2: case 3: case 4: case 5: case 6: + OPM_FPrint(&fprint, obj->conval->intval); + break; + case 9: + OPM_FPrintSet(&fprint, obj->conval->setval); + break; + case 7: + rval = obj->conval->realval; + OPM_FPrintReal(&fprint, rval); + break; + case 8: + OPM_FPrintLReal(&fprint, obj->conval->realval); + break; + case 10: + OPT_FPrintName(&fprint, (void*)*obj->conval->ext, ((LONGINT)(256))); + break; + case 11: + break; + default: + OPT_err(127); + break; + } + } else if (obj->mode == 1) { + OPM_FPrint(&fprint, obj->vis); + OPT_FPrintStr(obj->typ); + OPM_FPrint(&fprint, obj->typ->pbfp); + } else if (__IN(obj->mode, 0x0480)) { + OPT_FPrintSign(&fprint, obj->typ, obj->link); + } else if (obj->mode == 9) { + OPT_FPrintSign(&fprint, obj->typ, obj->link); + ext = obj->conval->ext; + m = (int)(*ext)[0]; + f = 1; + OPM_FPrint(&fprint, m); + while (f <= m) { + OPM_FPrint(&fprint, (int)(*ext)[__X(f, ((LONGINT)(256)))]); + f += 1; + } + } else if (obj->mode == 5) { + OPT_FPrintStr(obj->typ); + OPM_FPrint(&fprint, obj->typ->pbfp); + } + obj->fprint = fprint; + } +} + +void OPT_FPrintErr (OPT_Object obj, INTEGER errcode) +{ + INTEGER i, j; + CHAR ch; + if (obj->mnolev != 0) { + __COPY(OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, OPM_objname, ((LONGINT)(64))); + i = 0; + while (OPM_objname[__X(i, ((LONGINT)(64)))] != 0x00) { + i += 1; + } + OPM_objname[__X(i, ((LONGINT)(64)))] = '.'; + j = 0; + i += 1; + do { + ch = obj->name[__X(j, ((LONGINT)(256)))]; + OPM_objname[__X(i, ((LONGINT)(64)))] = ch; + j += 1; + i += 1; + } while (!(ch == 0x00)); + } else { + __COPY(obj->name, OPM_objname, ((LONGINT)(64))); + } + if (errcode == 249) { + if (OPM_noerr) { + OPT_err(errcode); + } + } else if (errcode == 253) { + if ((((!OPT_symNew && !OPT_symExtended)) && !OPT_extsf)) { + OPT_err(errcode); + } + OPT_symExtended = 1; + } else { + if ((!OPT_symNew && !OPT_newsf)) { + OPT_err(errcode); + } + OPT_symNew = 1; + } +} + +void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old) +{ + OPT_Object ob0 = NIL, ob1 = NIL; + BOOLEAN left; + if (*root == NIL) { + *root = obj; + *old = NIL; + } else { + ob0 = *root; + ob1 = ob0->right; + left = 0; + if (__STRCMP(obj->name, ob0->name) < 0) { + ob1 = ob0->left; + left = 1; + } else if (__STRCMP(obj->name, ob0->name) > 0) { + ob1 = ob0->right; + left = 0; + } else { + *old = ob0; + return; + } + for (;;) { + if (ob1 != NIL) { + if (__STRCMP(obj->name, ob1->name) < 0) { + ob0 = ob1; + ob1 = ob1->left; + left = 1; + } else if (__STRCMP(obj->name, ob1->name) > 0) { + ob0 = ob1; + ob1 = ob1->right; + left = 0; + } else { + *old = ob1; + break; + } + } else { + ob1 = obj; + if (left) { + ob0->left = ob1; + } else { + ob0->right = ob1; + } + ob1->left = NIL; + ob1->right = NIL; + *old = NIL; + break; + } + } + } +} + +static void OPT_InName (CHAR *name, LONGINT name__len) +{ + INTEGER i; + CHAR ch; + i = 0; + do { + OPM_SymRCh(&ch); + name[__X(i, name__len)] = ch; + i += 1; + } while (!(ch == 0x00)); +} + +static void OPT_InMod (SHORTINT *mno) +{ + OPT_Object head = NIL; + OPS_Name name; + LONGINT mn; + SHORTINT i; + mn = OPM_SymRInt(); + if (mn == 0) { + *mno = OPT_impCtxt.glbmno[0]; + } else { + if (mn == 16) { + OPT_InName((void*)name, ((LONGINT)(256))); + if ((__STRCMP(name, OPT_SelfName) == 0 && !OPT_impCtxt.self)) { + OPT_err(154); + } + i = 0; + while ((i < OPT_nofGmod && __STRCMP(name, OPT_GlbMod[__X(i, ((LONGINT)(64)))]->name) != 0)) { + i += 1; + } + if (i < OPT_nofGmod) { + *mno = i; + } else { + head = OPT_NewObj(); + head->mode = 12; + __COPY(name, head->name, ((LONGINT)(256))); + *mno = OPT_nofGmod; + head->mnolev = -*mno; + if (OPT_nofGmod < 64) { + OPT_GlbMod[__X(*mno, ((LONGINT)(64)))] = head; + OPT_nofGmod += 1; + } else { + OPT_err(227); + } + } + OPT_impCtxt.glbmno[__X(OPT_impCtxt.nofm, ((LONGINT)(64)))] = *mno; + OPT_impCtxt.nofm += 1; + } else { + *mno = OPT_impCtxt.glbmno[__X(-mn, ((LONGINT)(64)))]; + } + } +} + +static void OPT_InConstant (LONGINT f, OPT_Const conval) +{ + CHAR ch; + INTEGER i; + OPT_ConstExt ext = NIL; + REAL rval; + switch (f) { + case 1: case 3: case 2: + OPM_SymRCh(&ch); + conval->intval = (int)ch; + break; + case 4: case 5: case 6: + conval->intval = OPM_SymRInt(); + break; + case 9: + OPM_SymRSet(&conval->setval); + break; + case 7: + OPM_SymRReal(&rval); + conval->realval = rval; + conval->intval = -1; + break; + case 8: + OPM_SymRLReal(&conval->realval); + conval->intval = -1; + break; + case 10: + ext = OPT_NewExt(); + conval->ext = ext; + i = 0; + do { + OPM_SymRCh(&ch); + (*ext)[__X(i, ((LONGINT)(256)))] = ch; + i += 1; + } while (!(ch == 0x00)); + conval->intval2 = i; + conval->intval = -1; + break; + case 11: + conval->intval = 0; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPT.InConstant(), f = ", (LONGINT)41); + OPM_LogWNum(f, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } +} + +static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par) +{ + OPT_Object last = NIL, new = NIL; + LONGINT tag; + OPT_InStruct(&*res); + tag = OPM_SymRInt(); + last = NIL; + while (tag != 18) { + new = OPT_NewObj(); + new->mnolev = -mno; + if (last == NIL) { + *par = new; + } else { + last->link = new; + } + if (tag == 23) { + new->mode = 1; + } else { + new->mode = 2; + } + OPT_InStruct(&new->typ); + new->adr = OPM_SymRInt(); + OPT_InName((void*)new->name, ((LONGINT)(256))); + last = new; + tag = OPM_SymRInt(); + } +} + +static OPT_Object OPT_InFld (void) +{ + OPT_Object _o_result; + LONGINT tag; + OPT_Object obj = NIL; + tag = OPT_impCtxt.nextTag; + obj = OPT_NewObj(); + if (tag <= 26) { + obj->mode = 4; + if (tag == 26) { + obj->vis = 2; + } else { + obj->vis = 1; + } + OPT_InStruct(&obj->typ); + OPT_InName((void*)obj->name, ((LONGINT)(256))); + obj->adr = OPM_SymRInt(); + } else { + obj->mode = 4; + if (tag == 27) { + __MOVE("@ptr", obj->name, 5); + } else { + __MOVE("@proc", obj->name, 6); + } + obj->typ = OPT_undftyp; + obj->vis = 0; + obj->adr = OPM_SymRInt(); + } + _o_result = obj; + return _o_result; +} + +static OPT_Object OPT_InTProc (SHORTINT mno) +{ + OPT_Object _o_result; + LONGINT tag; + OPT_Object obj = NIL; + tag = OPT_impCtxt.nextTag; + obj = OPT_NewObj(); + obj->mnolev = -mno; + if (tag == 29) { + obj->mode = 13; + obj->conval = OPT_NewConst(); + obj->conval->intval = -1; + OPT_InSign(mno, &obj->typ, &obj->link); + obj->vis = 1; + OPT_InName((void*)obj->name, ((LONGINT)(256))); + obj->adr = __ASHL(OPM_SymRInt(), 16); + } else { + obj->mode = 13; + __MOVE("@tproc", obj->name, 7); + obj->link = OPT_NewObj(); + obj->typ = OPT_undftyp; + obj->vis = 0; + obj->adr = __ASHL(OPM_SymRInt(), 16); + } + _o_result = obj; + return _o_result; +} + +static void OPT_InStruct (OPT_Struct *typ) +{ + SHORTINT mno; + INTEGER ref; + LONGINT tag; + OPS_Name name; + OPT_Struct t = NIL; + OPT_Object obj = NIL, last = NIL, fld = NIL, old = NIL, dummy = NIL; + tag = OPM_SymRInt(); + if (tag != 34) { + *typ = OPT_impCtxt.ref[__X(-tag, ((LONGINT)(255)))]; + } else { + ref = OPT_impCtxt.nofr; + OPT_impCtxt.nofr += 1; + if (ref < OPT_impCtxt.minr) { + OPT_impCtxt.minr = ref; + } + OPT_InMod(&mno); + OPT_InName((void*)name, ((LONGINT)(256))); + obj = OPT_NewObj(); + if (name[0] == 0x00) { + if (OPT_impCtxt.self) { + old = NIL; + } else { + __MOVE("@", obj->name, 2); + OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old); + obj->name[0] = 0x00; + } + *typ = OPT_NewStr(0, 1); + } else { + __COPY(name, obj->name, ((LONGINT)(256))); + OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old); + if (old != NIL) { + OPT_FPrintObj(old); + OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] = old->typ->pvfp; + if (OPT_impCtxt.self) { + *typ = OPT_NewStr(0, 1); + } else { + *typ = old->typ; + (*typ)->link = NIL; + (*typ)->sysflag = 0; + (*typ)->fpdone = 0; + (*typ)->idfpdone = 0; + } + } else { + *typ = OPT_NewStr(0, 1); + } + } + OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))] = *typ; + OPT_impCtxt.old[__X(ref, ((LONGINT)(255)))] = old; + (*typ)->ref = ref + 255; + (*typ)->mno = mno; + (*typ)->allocated = 1; + (*typ)->strobj = obj; + obj->mode = 5; + obj->typ = *typ; + obj->mnolev = -mno; + obj->vis = 0; + tag = OPM_SymRInt(); + if (tag == 35) { + (*typ)->sysflag = (int)OPM_SymRInt(); + tag = OPM_SymRInt(); + } + switch (tag) { + case 36: + (*typ)->form = 13; + (*typ)->size = OPM_PointerSize; + (*typ)->n = 0; + OPT_InStruct(&(*typ)->BaseTyp); + break; + case 37: + (*typ)->form = 15; + (*typ)->comp = 2; + OPT_InStruct(&(*typ)->BaseTyp); + (*typ)->n = OPM_SymRInt(); + (*OPT_typSize)(*typ); + break; + case 38: + (*typ)->form = 15; + (*typ)->comp = 3; + OPT_InStruct(&(*typ)->BaseTyp); + if ((*typ)->BaseTyp->comp == 3) { + (*typ)->n = (*typ)->BaseTyp->n + 1; + } else { + (*typ)->n = 0; + } + (*OPT_typSize)(*typ); + break; + case 39: + (*typ)->form = 15; + (*typ)->comp = 4; + OPT_InStruct(&(*typ)->BaseTyp); + if ((*typ)->BaseTyp == OPT_notyp) { + (*typ)->BaseTyp = NIL; + } + (*typ)->extlev = 0; + t = (*typ)->BaseTyp; + while (t != NIL) { + (*typ)->extlev += 1; + t = t->BaseTyp; + } + (*typ)->size = OPM_SymRInt(); + (*typ)->align = OPM_SymRInt(); + (*typ)->n = OPM_SymRInt(); + OPT_impCtxt.nextTag = OPM_SymRInt(); + last = NIL; + while ((OPT_impCtxt.nextTag >= 25 && OPT_impCtxt.nextTag <= 28)) { + fld = OPT_InFld(); + fld->mnolev = -mno; + if (last != NIL) { + last->link = fld; + } + last = fld; + OPT_InsertImport(fld, &(*typ)->link, &dummy); + OPT_impCtxt.nextTag = OPM_SymRInt(); + } + while (OPT_impCtxt.nextTag != 18) { + fld = OPT_InTProc(mno); + OPT_InsertImport(fld, &(*typ)->link, &dummy); + OPT_impCtxt.nextTag = OPM_SymRInt(); + } + break; + case 40: + (*typ)->form = 14; + (*typ)->size = OPM_ProcSize; + OPT_InSign(mno, &(*typ)->BaseTyp, &(*typ)->link); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.InStruct, tag = ", (LONGINT)39); + OPM_LogWNum(tag, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + if (ref == OPT_impCtxt.minr) { + while (ref < OPT_impCtxt.nofr) { + t = OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))]; + OPT_FPrintStr(t); + obj = t->strobj; + if (obj->name[0] != 0x00) { + OPT_FPrintObj(obj); + } + old = OPT_impCtxt.old[__X(ref, ((LONGINT)(255)))]; + if (old != NIL) { + t->strobj = old; + if (OPT_impCtxt.self) { + if (old->mnolev < 0) { + if (old->history != 5) { + if (old->fprint != obj->fprint) { + old->history = 2; + } else if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) { + old->history = 3; + } + } + } else if (old->fprint != obj->fprint) { + old->history = 2; + } else if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) { + old->history = 3; + } else if (old->vis == 0) { + old->history = 1; + } else { + old->history = 0; + } + } else { + if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) { + old->history = 5; + } + if (old->fprint != obj->fprint) { + OPT_FPrintErr(old, 249); + } + } + } else if (OPT_impCtxt.self) { + obj->history = 4; + } else { + obj->history = 1; + } + ref += 1; + } + OPT_impCtxt.minr = 255; + } + } +} + +static OPT_Object OPT_InObj (SHORTINT mno) +{ + OPT_Object _o_result; + INTEGER i, s; + CHAR ch; + OPT_Object obj = NIL, old = NIL; + OPT_Struct typ = NIL; + LONGINT tag; + OPT_ConstExt ext = NIL; + tag = OPT_impCtxt.nextTag; + if (tag == 19) { + OPT_InStruct(&typ); + obj = typ->strobj; + if (!OPT_impCtxt.self) { + obj->vis = 1; + } + } else { + obj = OPT_NewObj(); + obj->mnolev = -mno; + obj->vis = 1; + if (tag <= 13) { + obj->mode = 3; + obj->typ = OPT_impCtxt.ref[__X(tag, ((LONGINT)(255)))]; + obj->conval = OPT_NewConst(); + OPT_InConstant(tag, obj->conval); + } else if (tag >= 31) { + obj->conval = OPT_NewConst(); + obj->conval->intval = -1; + OPT_InSign(mno, &obj->typ, &obj->link); + switch (tag) { + case 31: + obj->mode = 7; + break; + case 32: + obj->mode = 10; + break; + case 33: + obj->mode = 9; + ext = OPT_NewExt(); + obj->conval->ext = ext; + s = (int)OPM_SymRInt(); + (*ext)[0] = (CHAR)s; + i = 1; + while (i <= s) { + OPM_SymRCh(&(*ext)[__X(i, ((LONGINT)(256)))]); + i += 1; + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.InObj, tag = ", (LONGINT)36); + OPM_LogWNum(tag, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } else if (tag == 20) { + obj->mode = 5; + OPT_InStruct(&obj->typ); + } else { + obj->mode = 1; + if (tag == 22) { + obj->vis = 2; + } + OPT_InStruct(&obj->typ); + } + OPT_InName((void*)obj->name, ((LONGINT)(256))); + } + OPT_FPrintObj(obj); + if ((obj->mode == 1 && (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00))) { + OPM_FPrint(&OPT_impCtxt.reffp, obj->typ->ref - 255); + } + if (tag != 19) { + OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old); + if (OPT_impCtxt.self) { + if (old != NIL) { + if (old->vis == 0) { + old->history = 4; + } else { + OPT_FPrintObj(old); + if (obj->fprint != old->fprint) { + old->history = 2; + } else if (obj->typ->pvfp != old->typ->pvfp) { + old->history = 3; + } else { + old->history = 1; + } + } + } else { + obj->history = 4; + } + } + } else { + if (OPT_impCtxt.self) { + if (obj->vis == 0) { + obj->history = 4; + } else if (obj->history == 0) { + obj->history = 1; + } + } + } + _o_result = obj; + return _o_result; +} + +void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done) +{ + OPT_Object obj = NIL; + SHORTINT mno; + OPS_Name aliasName__copy; + __DUPARR(aliasName, OPS_Name); + if (__STRCMP(name, "SYSTEM") == 0) { + OPT_SYSimported = 1; + OPT_Insert(aliasName, &obj); + obj->mode = 11; + obj->mnolev = 0; + obj->scope = OPT_syslink; + obj->typ = OPT_notyp; + } else { + OPT_impCtxt.nofr = 16; + OPT_impCtxt.minr = 255; + OPT_impCtxt.nofm = 0; + OPT_impCtxt.self = __STRCMP(aliasName, "@self") == 0; + OPT_impCtxt.reffp = 0; + OPM_OldSym((void*)name, ((LONGINT)(256)), &*done); + if (*done) { + OPT_InMod(&mno); + OPT_impCtxt.nextTag = OPM_SymRInt(); + while (!OPM_eofSF()) { + obj = OPT_InObj(mno); + OPT_impCtxt.nextTag = OPM_SymRInt(); + } + OPT_Insert(aliasName, &obj); + obj->mode = 11; + obj->scope = OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right; + OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->link = obj; + obj->mnolev = -mno; + obj->typ = OPT_notyp; + OPM_CloseOldSym(); + } else if (OPT_impCtxt.self) { + OPT_newsf = 1; + OPT_extsf = 1; + OPT_sfpresent = 0; + } else { + OPT_err(152); + } + } +} + +static void OPT_OutName (CHAR *name, LONGINT name__len) +{ + INTEGER i; + CHAR ch; + i = 0; + do { + ch = name[__X(i, name__len)]; + OPM_SymWCh(ch); + i += 1; + } while (!(ch == 0x00)); +} + +static void OPT_OutMod (INTEGER mno) +{ + if (OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))] < 0) { + OPM_SymWInt(((LONGINT)(16))); + OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))] = OPT_expCtxt.nofm; + OPT_expCtxt.nofm += 1; + OPT_OutName((void*)OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + } else { + OPM_SymWInt(-OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))]); + } +} + +static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr) +{ + LONGINT i, j, n; + OPT_Struct btyp = NIL; + if (typ->comp == 4) { + OPT_OutFlds(typ->link, adr, 0); + } else if (typ->comp == 2) { + btyp = typ->BaseTyp; + n = typ->n; + while (btyp->comp == 2) { + n = btyp->n * n; + btyp = btyp->BaseTyp; + } + if (btyp->form == 13 || btyp->comp == 4) { + j = OPT_nofhdfld; + OPT_OutHdFld(btyp, fld, adr); + if (j != OPT_nofhdfld) { + i = 1; + while ((i < n && OPT_nofhdfld <= 2048)) { + adr += btyp->size; + OPT_OutHdFld(btyp, fld, adr); + i += 1; + } + } + } + } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) { + OPM_SymWInt(((LONGINT)(27))); + OPM_SymWInt(adr); + OPT_nofhdfld += 1; + } +} + +static void OPT_OutFlds (OPT_Object fld, LONGINT adr, BOOLEAN visible) +{ + while ((fld != NIL && fld->mode == 4)) { + if ((fld->vis != 0 && visible)) { + if (fld->vis == 2) { + OPM_SymWInt(((LONGINT)(26))); + } else { + OPM_SymWInt(((LONGINT)(25))); + } + OPT_OutStr(fld->typ); + OPT_OutName((void*)fld->name, ((LONGINT)(256))); + OPM_SymWInt(fld->adr); + } else { + OPT_OutHdFld(fld->typ, fld, fld->adr + adr); + } + fld = fld->link; + } +} + +static void OPT_OutSign (OPT_Struct result, OPT_Object par) +{ + OPT_OutStr(result); + while (par != NIL) { + if (par->mode == 1) { + OPM_SymWInt(((LONGINT)(23))); + } else { + OPM_SymWInt(((LONGINT)(24))); + } + OPT_OutStr(par->typ); + OPM_SymWInt(par->adr); + OPT_OutName((void*)par->name, ((LONGINT)(256))); + par = par->link; + } + OPM_SymWInt(((LONGINT)(18))); +} + +static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj) +{ + if (obj != NIL) { + OPT_OutTProcs(typ, obj->left); + if (obj->mode == 13) { + if ((((typ->BaseTyp != NIL && __ASHR(obj->adr, 16) < typ->BaseTyp->n)) && obj->vis == 0)) { + OPM_Mark(109, typ->txtpos); + } + if (obj->vis != 0) { + if (obj->vis != 0) { + OPM_SymWInt(((LONGINT)(29))); + OPT_OutSign(obj->typ, obj->link); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + OPM_SymWInt(__ASHR(obj->adr, 16)); + } else { + OPM_SymWInt(((LONGINT)(30))); + OPM_SymWInt(__ASHR(obj->adr, 16)); + } + } + } + OPT_OutTProcs(typ, obj->right); + } +} + +static void OPT_OutStr (OPT_Struct typ) +{ + OPT_Object strobj = NIL; + if (typ->ref < OPT_expCtxt.ref) { + OPM_SymWInt(-typ->ref); + } else { + OPM_SymWInt(((LONGINT)(34))); + typ->ref = OPT_expCtxt.ref; + OPT_expCtxt.ref += 1; + if (OPT_expCtxt.ref >= 255) { + OPT_err(228); + } + OPT_OutMod(typ->mno); + strobj = typ->strobj; + if ((strobj != NIL && strobj->name[0] != 0x00)) { + OPT_OutName((void*)strobj->name, ((LONGINT)(256))); + switch (strobj->history) { + case 2: + OPT_FPrintErr(strobj, 252); + break; + case 3: + OPT_FPrintErr(strobj, 251); + break; + case 5: + OPT_FPrintErr(strobj, 249); + break; + default: + break; + } + } else { + OPM_SymWCh(0x00); + } + if (typ->sysflag != 0) { + OPM_SymWInt(((LONGINT)(35))); + OPM_SymWInt(typ->sysflag); + } + switch (typ->form) { + case 13: + OPM_SymWInt(((LONGINT)(36))); + OPT_OutStr(typ->BaseTyp); + break; + case 14: + OPM_SymWInt(((LONGINT)(40))); + OPT_OutSign(typ->BaseTyp, typ->link); + break; + case 15: + switch (typ->comp) { + case 2: + OPM_SymWInt(((LONGINT)(37))); + OPT_OutStr(typ->BaseTyp); + OPM_SymWInt(typ->n); + break; + case 3: + OPM_SymWInt(((LONGINT)(38))); + OPT_OutStr(typ->BaseTyp); + break; + case 4: + OPM_SymWInt(((LONGINT)(39))); + if (typ->BaseTyp == NIL) { + OPT_OutStr(OPT_notyp); + } else { + OPT_OutStr(typ->BaseTyp); + } + OPM_SymWInt(typ->size); + OPM_SymWInt(typ->align); + OPM_SymWInt(typ->n); + OPT_nofhdfld = 0; + OPT_OutFlds(typ->link, ((LONGINT)(0)), 1); + if (OPT_nofhdfld > 2048) { + OPM_Mark(223, typ->txtpos); + } + OPT_OutTProcs(typ, typ->link); + OPM_SymWInt(((LONGINT)(18))); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.OutStr, typ^.comp = ", (LONGINT)43); + OPM_LogWNum(typ->comp, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.OutStr, typ^.form = ", (LONGINT)43); + OPM_LogWNum(typ->form, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } +} + +static void OPT_OutConstant (OPT_Object obj) +{ + INTEGER f; + REAL rval; + f = obj->typ->form; + OPM_SymWInt(f); + switch (f) { + case 2: case 3: + OPM_SymWCh((CHAR)obj->conval->intval); + break; + case 4: case 5: case 6: + OPM_SymWInt(obj->conval->intval); + break; + case 9: + OPM_SymWSet(obj->conval->setval); + break; + case 7: + rval = obj->conval->realval; + OPM_SymWReal(rval); + break; + case 8: + OPM_SymWLReal(obj->conval->realval); + break; + case 10: + OPT_OutName((void*)*obj->conval->ext, ((LONGINT)(256))); + break; + case 11: + break; + default: + OPT_err(127); + break; + } +} + +static void OPT_OutObj (OPT_Object obj) +{ + INTEGER i, j; + OPT_ConstExt ext = NIL; + if (obj != NIL) { + OPT_OutObj(obj->left); + if (__IN(obj->mode, 0x06ea)) { + if (obj->history == 4) { + OPT_FPrintErr(obj, 250); + } else if (obj->vis != 0) { + switch (obj->history) { + case 0: + OPT_FPrintErr(obj, 253); + break; + case 1: + break; + case 2: + OPT_FPrintErr(obj, 252); + break; + case 3: + OPT_FPrintErr(obj, 251); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.OutObj, obj^.history = ", (LONGINT)46); + OPM_LogWNum(obj->history, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + switch (obj->mode) { + case 3: + OPT_OutConstant(obj); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + break; + case 5: + if (obj->typ->strobj == obj) { + OPM_SymWInt(((LONGINT)(19))); + OPT_OutStr(obj->typ); + } else { + OPM_SymWInt(((LONGINT)(20))); + OPT_OutStr(obj->typ); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + } + break; + case 1: + if (obj->vis == 2) { + OPM_SymWInt(((LONGINT)(22))); + } else { + OPM_SymWInt(((LONGINT)(21))); + } + OPT_OutStr(obj->typ); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + if (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00) { + OPM_FPrint(&OPT_expCtxt.reffp, obj->typ->ref); + } + break; + case 7: + OPM_SymWInt(((LONGINT)(31))); + OPT_OutSign(obj->typ, obj->link); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + break; + case 10: + OPM_SymWInt(((LONGINT)(32))); + OPT_OutSign(obj->typ, obj->link); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + break; + case 9: + OPM_SymWInt(((LONGINT)(33))); + OPT_OutSign(obj->typ, obj->link); + ext = obj->conval->ext; + j = (int)(*ext)[0]; + i = 1; + OPM_SymWInt(j); + while (i <= j) { + OPM_SymWCh((*ext)[__X(i, ((LONGINT)(256)))]); + i += 1; + } + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.OutObj, obj.mode = ", (LONGINT)42); + OPM_LogWNum(obj->mode, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } + } + OPT_OutObj(obj->right); + } +} + +void OPT_Export (BOOLEAN *ext, BOOLEAN *new) +{ + INTEGER i; + SHORTINT nofmod; + BOOLEAN done; + OPT_symExtended = 0; + OPT_symNew = 0; + nofmod = OPT_nofGmod; + OPT_Import((CHAR*)"@self", OPT_SelfName, &done); + OPT_nofGmod = nofmod; + if (OPM_noerr) { + OPM_NewSym((void*)OPT_SelfName, ((LONGINT)(256))); + if (OPM_noerr) { + OPM_SymWInt(((LONGINT)(16))); + OPT_OutName((void*)OPT_SelfName, ((LONGINT)(256))); + OPT_expCtxt.reffp = 0; + OPT_expCtxt.ref = 16; + OPT_expCtxt.nofm = 1; + OPT_expCtxt.locmno[0] = 0; + i = 1; + while (i < 64) { + OPT_expCtxt.locmno[__X(i, ((LONGINT)(64)))] = -1; + i += 1; + } + OPT_OutObj(OPT_topScope->right); + *ext = (OPT_sfpresent && OPT_symExtended); + *new = !OPT_sfpresent || OPT_symNew; + if (OPM_forceNewSym) { + *new = 1; + } + if ((((OPM_noerr && OPT_sfpresent)) && OPT_impCtxt.reffp != OPT_expCtxt.reffp)) { + *new = 1; + if (!OPT_extsf) { + OPT_err(155); + } + } + OPT_newsf = 0; + OPT_symNew = 0; + if (!OPM_noerr || OPT_findpc) { + OPM_DeleteNewSym(); + } + } + } +} + +static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form) +{ + *typ = OPT_NewStr(form, 1); + (*typ)->ref = form; + (*typ)->size = OPM_ByteSize; + (*typ)->allocated = 1; + (*typ)->strobj = OPT_NewObj(); + (*typ)->pbfp = form; + (*typ)->pvfp = form; + (*typ)->fpdone = 1; + (*typ)->idfp = form; + (*typ)->idfpdone = 1; +} + +static void OPT_EnterBoolConst (OPS_Name name, LONGINT value) +{ + OPT_Object obj = NIL; + OPS_Name name__copy; + __DUPARR(name, OPS_Name); + OPT_Insert(name, &obj); + obj->conval = OPT_NewConst(); + obj->mode = 3; + obj->typ = OPT_booltyp; + obj->conval->intval = value; +} + +static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res) +{ + OPT_Object obj = NIL; + OPT_Struct typ = NIL; + OPS_Name name__copy; + __DUPARR(name, OPS_Name); + OPT_Insert(name, &obj); + typ = OPT_NewStr(form, 1); + obj->mode = 5; + obj->typ = typ; + obj->vis = 1; + typ->strobj = obj; + typ->size = size; + typ->ref = form; + typ->allocated = 1; + typ->pbfp = form; + typ->pvfp = form; + typ->fpdone = 1; + typ->idfp = form; + typ->idfpdone = 1; + *res = typ; +} + +static void OPT_EnterProc (OPS_Name name, INTEGER num) +{ + OPT_Object obj = NIL; + OPS_Name name__copy; + __DUPARR(name, OPS_Name); + OPT_Insert(name, &obj); + obj->mode = 8; + obj->typ = OPT_notyp; + obj->adr = num; +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(OPT_topScope); + P(OPT_undftyp); + P(OPT_bytetyp); + P(OPT_booltyp); + P(OPT_chartyp); + P(OPT_sinttyp); + P(OPT_inttyp); + P(OPT_linttyp); + P(OPT_realtyp); + P(OPT_lrltyp); + P(OPT_settyp); + P(OPT_stringtyp); + P(OPT_niltyp); + P(OPT_notyp); + P(OPT_sysptrtyp); + __ENUMP(OPT_GlbMod, 64, P); + P(OPT_universe); + P(OPT_syslink); + __ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 3140, 1, P); +} + +__TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 24), {0, -8}}; +__TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 304), {0, 4, 8, 12, 284, 288, -28}}; +__TDESC(OPT_StrDesc, 1, 3) = {__TDFLDS("StrDesc", 56), {44, 48, 52, -16}}; +__TDESC(OPT_NodeDesc, 1, 6) = {__TDFLDS("NodeDesc", 28), {0, 4, 8, 16, 20, 24, -28}}; +__TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 3140), {16, 20, 24, 28, 32, 36, 40, 44, 48, 52, 56, 60, 64, 68, 72, 76, + 80, 84, 88, 92, 96, 100, 104, 108, 112, 116, 120, 124, 128, 132, 136, 140, + 144, 148, 152, 156, 160, 164, 168, 172, 176, 180, 184, 188, 192, 196, 200, 204, + 208, 212, 216, 220, 224, 228, 232, 236, 240, 244, 248, 252, 256, 260, 264, 268, + 272, 276, 280, 284, 288, 292, 296, 300, 304, 308, 312, 316, 320, 324, 328, 332, + 336, 340, 344, 348, 352, 356, 360, 364, 368, 372, 376, 380, 384, 388, 392, 396, + 400, 404, 408, 412, 416, 420, 424, 428, 432, 436, 440, 444, 448, 452, 456, 460, + 464, 468, 472, 476, 480, 484, 488, 492, 496, 500, 504, 508, 512, 516, 520, 524, + 528, 532, 536, 540, 544, 548, 552, 556, 560, 564, 568, 572, 576, 580, 584, 588, + 592, 596, 600, 604, 608, 612, 616, 620, 624, 628, 632, 636, 640, 644, 648, 652, + 656, 660, 664, 668, 672, 676, 680, 684, 688, 692, 696, 700, 704, 708, 712, 716, + 720, 724, 728, 732, 736, 740, 744, 748, 752, 756, 760, 764, 768, 772, 776, 780, + 784, 788, 792, 796, 800, 804, 808, 812, 816, 820, 824, 828, 832, 836, 840, 844, + 848, 852, 856, 860, 864, 868, 872, 876, 880, 884, 888, 892, 896, 900, 904, 908, + 912, 916, 920, 924, 928, 932, 936, 940, 944, 948, 952, 956, 960, 964, 968, 972, + 976, 980, 984, 988, 992, 996, 1000, 1004, 1008, 1012, 1016, 1020, 1024, 1028, 1032, 1036, + 1040, 1044, 1048, 1052, 1056, 1060, 1064, 1068, 1072, 1076, 1080, 1084, 1088, 1092, 1096, 1100, + 1104, 1108, 1112, 1116, 1120, 1124, 1128, 1132, 1136, 1140, 1144, 1148, 1152, 1156, 1160, 1164, + 1168, 1172, 1176, 1180, 1184, 1188, 1192, 1196, 1200, 1204, 1208, 1212, 1216, 1220, 1224, 1228, + 1232, 1236, 1240, 1244, 1248, 1252, 1256, 1260, 1264, 1268, 1272, 1276, 1280, 1284, 1288, 1292, + 1296, 1300, 1304, 1308, 1312, 1316, 1320, 1324, 1328, 1332, 1336, 1340, 1344, 1348, 1352, 1356, + 1360, 1364, 1368, 1372, 1376, 1380, 1384, 1388, 1392, 1396, 1400, 1404, 1408, 1412, 1416, 1420, + 1424, 1428, 1432, 1436, 1440, 1444, 1448, 1452, 1456, 1460, 1464, 1468, 1472, 1476, 1480, 1484, + 1488, 1492, 1496, 1500, 1504, 1508, 1512, 1516, 1520, 1524, 1528, 1532, 1536, 1540, 1544, 1548, + 1552, 1556, 1560, 1564, 1568, 1572, 1576, 1580, 1584, 1588, 1592, 1596, 1600, 1604, 1608, 1612, + 1616, 1620, 1624, 1628, 1632, 1636, 1640, 1644, 1648, 1652, 1656, 1660, 1664, 1668, 1672, 1676, + 1680, 1684, 1688, 1692, 1696, 1700, 1704, 1708, 1712, 1716, 1720, 1724, 1728, 1732, 1736, 1740, + 1744, 1748, 1752, 1756, 1760, 1764, 1768, 1772, 1776, 1780, 1784, 1788, 1792, 1796, 1800, 1804, + 1808, 1812, 1816, 1820, 1824, 1828, 1832, 1836, 1840, 1844, 1848, 1852, 1856, 1860, 1864, 1868, + 1872, 1876, 1880, 1884, 1888, 1892, 1896, 1900, 1904, 1908, 1912, 1916, 1920, 1924, 1928, 1932, + 1936, 1940, 1944, 1948, 1952, 1956, 1960, 1964, 1968, 1972, 1976, 1980, 1984, 1988, 1992, 1996, + 2000, 2004, 2008, 2012, 2016, 2020, 2024, 2028, 2032, 2036, 2040, 2044, 2048, 2052, -2044}}; +__TDESC(OPT_ExpCtxt, 1, 0) = {__TDFLDS("ExpCtxt", 72), {-4}}; + +export void *OPT__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPS); + __REGMOD("OPT", EnumPtrs); + __REGCMD("Close", OPT_Close); + __REGCMD("CloseScope", OPT_CloseScope); + __INITYP(OPT_ConstDesc, OPT_ConstDesc, 0); + __INITYP(OPT_ObjDesc, OPT_ObjDesc, 0); + __INITYP(OPT_StrDesc, OPT_StrDesc, 0); + __INITYP(OPT_NodeDesc, OPT_NodeDesc, 0); + __INITYP(OPT_ImpCtxt, OPT_ImpCtxt, 0); + __INITYP(OPT_ExpCtxt, OPT_ExpCtxt, 0); +/* BEGIN */ + OPT_topScope = NIL; + OPT_OpenScope(0, NIL); + OPM_errpos = 0; + OPT_InitStruct(&OPT_undftyp, 0); + OPT_InitStruct(&OPT_notyp, 12); + OPT_InitStruct(&OPT_stringtyp, 10); + OPT_InitStruct(&OPT_niltyp, 11); + OPT_undftyp->BaseTyp = OPT_undftyp; + OPT_EnterTyp((CHAR*)"BYTE", 1, OPM_ByteSize, &OPT_bytetyp); + OPT_EnterTyp((CHAR*)"PTR", 13, OPM_PointerSize, &OPT_sysptrtyp); + OPT_EnterProc((CHAR*)"ADR", 20); + OPT_EnterProc((CHAR*)"CC", 21); + OPT_EnterProc((CHAR*)"LSH", 22); + OPT_EnterProc((CHAR*)"ROT", 23); + OPT_EnterProc((CHAR*)"GET", 24); + OPT_EnterProc((CHAR*)"PUT", 25); + OPT_EnterProc((CHAR*)"GETREG", 26); + OPT_EnterProc((CHAR*)"PUTREG", 27); + OPT_EnterProc((CHAR*)"BIT", 28); + OPT_EnterProc((CHAR*)"VAL", 29); + OPT_EnterProc((CHAR*)"NEW", 30); + OPT_EnterProc((CHAR*)"MOVE", 31); + OPT_syslink = OPT_topScope->right; + OPT_universe = OPT_topScope; + OPT_topScope->right = NIL; + OPT_EnterTyp((CHAR*)"CHAR", 3, OPM_CharSize, &OPT_chartyp); + OPT_EnterTyp((CHAR*)"SET", 9, OPM_SetSize, &OPT_settyp); + OPT_EnterTyp((CHAR*)"REAL", 7, OPM_RealSize, &OPT_realtyp); + OPT_EnterTyp((CHAR*)"INTEGER", 5, OPM_IntSize, &OPT_inttyp); + OPT_EnterTyp((CHAR*)"LONGINT", 6, OPM_LIntSize, &OPT_linttyp); + OPT_EnterTyp((CHAR*)"LONGREAL", 8, OPM_LRealSize, &OPT_lrltyp); + OPT_EnterTyp((CHAR*)"SHORTINT", 4, OPM_SIntSize, &OPT_sinttyp); + OPT_EnterTyp((CHAR*)"BOOLEAN", 2, OPM_BoolSize, &OPT_booltyp); + OPT_EnterBoolConst((CHAR*)"FALSE", ((LONGINT)(0))); + OPT_EnterBoolConst((CHAR*)"TRUE", ((LONGINT)(1))); + OPT_EnterProc((CHAR*)"HALT", 0); + OPT_EnterProc((CHAR*)"NEW", 1); + OPT_EnterProc((CHAR*)"ABS", 2); + OPT_EnterProc((CHAR*)"CAP", 3); + OPT_EnterProc((CHAR*)"ORD", 4); + OPT_EnterProc((CHAR*)"ENTIER", 5); + OPT_EnterProc((CHAR*)"ODD", 6); + OPT_EnterProc((CHAR*)"MIN", 7); + OPT_EnterProc((CHAR*)"MAX", 8); + OPT_EnterProc((CHAR*)"CHR", 9); + OPT_EnterProc((CHAR*)"SHORT", 10); + OPT_EnterProc((CHAR*)"LONG", 11); + OPT_EnterProc((CHAR*)"SIZE", 12); + OPT_EnterProc((CHAR*)"INC", 13); + OPT_EnterProc((CHAR*)"DEC", 14); + OPT_EnterProc((CHAR*)"INCL", 15); + OPT_EnterProc((CHAR*)"EXCL", 16); + OPT_EnterProc((CHAR*)"LEN", 17); + OPT_EnterProc((CHAR*)"COPY", 18); + OPT_EnterProc((CHAR*)"ASH", 19); + OPT_EnterProc((CHAR*)"ASSERT", 32); + OPT_impCtxt.ref[0] = OPT_undftyp; + OPT_impCtxt.ref[1] = OPT_bytetyp; + OPT_impCtxt.ref[2] = OPT_booltyp; + OPT_impCtxt.ref[3] = OPT_chartyp; + OPT_impCtxt.ref[4] = OPT_sinttyp; + OPT_impCtxt.ref[5] = OPT_inttyp; + OPT_impCtxt.ref[6] = OPT_linttyp; + OPT_impCtxt.ref[7] = OPT_realtyp; + OPT_impCtxt.ref[8] = OPT_lrltyp; + OPT_impCtxt.ref[9] = OPT_settyp; + OPT_impCtxt.ref[10] = OPT_stringtyp; + OPT_impCtxt.ref[11] = OPT_niltyp; + OPT_impCtxt.ref[12] = OPT_notyp; + OPT_impCtxt.ref[13] = OPT_sysptrtyp; + __ENDMOD; +} diff --git a/bootstrap/unix-44/OPT.h b/bootstrap/unix-44/OPT.h new file mode 100644 index 00000000..1a22d0df --- /dev/null +++ b/bootstrap/unix-44/OPT.h @@ -0,0 +1,105 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPT__h +#define OPT__h + +#include "SYSTEM.h" +#include "OPS.h" + +typedef + struct OPT_ConstDesc *OPT_Const; + +typedef + OPS_String *OPT_ConstExt; + +typedef + struct OPT_ConstDesc { + OPT_ConstExt ext; + LONGINT intval, intval2; + SET setval; + LONGREAL realval; + } OPT_ConstDesc; + +typedef + struct OPT_NodeDesc *OPT_Node; + +typedef + struct OPT_StrDesc *OPT_Struct; + +typedef + struct OPT_ObjDesc *OPT_Object; + +typedef + struct OPT_NodeDesc { + OPT_Node left, right, link; + SHORTINT class, subcl; + BOOLEAN readonly; + OPT_Struct typ; + OPT_Object obj; + OPT_Const conval; + } OPT_NodeDesc; + +typedef + struct OPT_ObjDesc { + OPT_Object left, right, link, scope; + OPS_Name name; + BOOLEAN leaf; + SHORTINT mode, mnolev, vis, history; + BOOLEAN used, fpdone; + LONGINT fprint; + OPT_Struct typ; + OPT_Const conval; + LONGINT adr, linkadr; + INTEGER x; + } OPT_ObjDesc; + +typedef + struct OPT_StrDesc { + SHORTINT form, comp, mno, extlev; + INTEGER ref, sysflag; + LONGINT n, size, align, txtpos; + BOOLEAN allocated, pbused, pvused; + char _prvt0[8]; + LONGINT pbfp, pvfp; + OPT_Struct BaseTyp; + OPT_Object link, strobj; + } OPT_StrDesc; + + +import void (*OPT_typSize)(OPT_Struct); +import OPT_Object OPT_topScope; +import OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp; +import SHORTINT OPT_nofGmod; +import OPT_Object OPT_GlbMod[64]; +import OPS_Name OPT_SelfName; +import BOOLEAN OPT_SYSimported; + +import LONGINT *OPT_ConstDesc__typ; +import LONGINT *OPT_ObjDesc__typ; +import LONGINT *OPT_StrDesc__typ; +import LONGINT *OPT_NodeDesc__typ; + +import void OPT_Close (void); +import void OPT_CloseScope (void); +import void OPT_Export (BOOLEAN *ext, BOOLEAN *new); +import void OPT_FPrintErr (OPT_Object obj, INTEGER errcode); +import void OPT_FPrintObj (OPT_Object obj); +import void OPT_FPrintStr (OPT_Struct typ); +import void OPT_Find (OPT_Object *res); +import void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res); +import void OPT_FindImport (OPT_Object mod, OPT_Object *res); +import void OPT_IdFPrint (OPT_Struct typ); +import void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done); +import void OPT_Init (OPS_Name name, SET opt); +import void OPT_Insert (OPS_Name name, OPT_Object *obj); +import void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old); +import OPT_Const OPT_NewConst (void); +import OPT_ConstExt OPT_NewExt (void); +import OPT_Node OPT_NewNode (SHORTINT class); +import OPT_Object OPT_NewObj (void); +import OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp); +import void OPT_OpenScope (SHORTINT level, OPT_Object owner); +import void *OPT__init(void); + + +#endif diff --git a/bootstrap/unix-44/OPV.c b/bootstrap/unix-44/OPV.c new file mode 100644 index 00000000..572285dc --- /dev/null +++ b/bootstrap/unix-44/OPV.c @@ -0,0 +1,1688 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "OPC.h" +#include "OPM.h" +#include "OPS.h" +#include "OPT.h" + +typedef + struct OPV_ExitInfo { + INTEGER level, label; + } OPV_ExitInfo; + + +static BOOLEAN OPV_assert, OPV_inxchk, OPV_mainprog, OPV_ansi; +static INTEGER OPV_stamp; +static LONGINT OPV_recno; +static OPV_ExitInfo OPV_exit; +static INTEGER OPV_nofExitLabels; +static BOOLEAN OPV_naturalAlignment; + +export LONGINT *OPV_ExitInfo__typ; + +static void OPV_ActualPar (OPT_Node n, OPT_Object fp); +export void OPV_AdrAndSize (OPT_Object topScope); +static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc); +static void OPV_Convert (OPT_Node n, INTEGER form, INTEGER prec); +static void OPV_DefineTDescs (OPT_Node n); +static void OPV_Entier (OPT_Node n, INTEGER prec); +static void OPV_GetTProcNum (OPT_Object obj); +static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc); +static BOOLEAN OPV_ImplicitReturn (OPT_Node n); +static void OPV_Index (OPT_Node n, OPT_Node d, INTEGER prec, INTEGER dim); +export void OPV_Init (void); +static void OPV_InitTDescs (OPT_Node n); +static void OPV_Len (OPT_Node n, LONGINT dim); +export void OPV_Module (OPT_Node prog); +static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max); +static void OPV_NewArr (OPT_Node d, OPT_Node x); +static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp); +static BOOLEAN OPV_SideEffects (OPT_Node n); +static void OPV_Stamp (OPS_Name s); +static OPT_Object OPV_SuperProc (OPT_Node n); +static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported); +static void OPV_TraverseRecord (OPT_Struct typ); +export void OPV_TypSize (OPT_Struct typ); +static void OPV_TypeOf (OPT_Node n); +static void OPV_design (OPT_Node n, INTEGER prec); +static void OPV_expr (OPT_Node n, INTEGER prec); +static void OPV_stat (OPT_Node n, OPT_Object outerProc); + + +static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max) +{ + LONGINT _o_result; + LONGINT i; + if (size >= max) { + _o_result = max; + return _o_result; + } else { + i = 1; + while (i < size) { + i += i; + } + _o_result = i; + return _o_result; + } + __RETCHK; +} + +void OPV_TypSize (OPT_Struct typ) +{ + INTEGER f, c; + LONGINT offset, size, base, fbase, off0; + OPT_Object fld = NIL; + OPT_Struct btyp = NIL; + if (typ == OPT_undftyp) { + OPM_err(58); + } else if (typ->size == -1) { + f = typ->form; + c = typ->comp; + if (c == 4) { + btyp = typ->BaseTyp; + if (btyp == NIL) { + offset = 0; + base = OPM_RecAlign; + } else { + OPV_TypSize(btyp); + offset = btyp->size - (LONGINT)__ASHR(btyp->sysflag, 8); + base = btyp->align; + } + fld = typ->link; + while ((fld != NIL && fld->mode == 4)) { + btyp = fld->typ; + OPV_TypSize(btyp); + size = btyp->size; + fbase = OPC_Base(btyp); + OPC_Align(&offset, fbase); + fld->adr = offset; + offset += size; + if (fbase > base) { + base = fbase; + } + fld = fld->link; + } + off0 = offset; + if (offset == 0) { + offset = 1; + } + if (OPM_RecSize == 0) { + base = OPV_NaturalAlignment(offset, OPM_RecAlign); + } + OPC_Align(&offset, base); + if ((typ->strobj == NIL && __MASK(typ->align, -65536) == 0)) { + OPV_recno += 1; + base += __ASHL(OPV_recno, 16); + } + typ->size = offset; + typ->align = base; + typ->sysflag = __MASK(typ->sysflag, -256) + (int)__ASHL(offset - off0, 8); + } else if (c == 2) { + OPV_TypSize(typ->BaseTyp); + typ->size = typ->n * typ->BaseTyp->size; + } else if (f == 13) { + typ->size = OPM_PointerSize; + if (typ->BaseTyp == OPT_undftyp) { + OPM_Mark(128, typ->n); + } else { + OPV_TypSize(typ->BaseTyp); + } + } else if (f == 14) { + typ->size = OPM_ProcSize; + } else if (c == 3) { + btyp = typ->BaseTyp; + OPV_TypSize(btyp); + if (btyp->comp == 3) { + typ->size = btyp->size + 4; + } else { + typ->size = 8; + } + } + } +} + +void OPV_Init (void) +{ + OPV_stamp = 0; + OPV_recno = 0; + OPV_nofExitLabels = 0; + OPV_assert = __IN(7, OPM_opt); + OPV_inxchk = __IN(0, OPM_opt); + OPV_mainprog = __IN(10, OPM_opt); + OPV_ansi = __IN(6, OPM_opt); +} + +static void OPV_GetTProcNum (OPT_Object obj) +{ + LONGINT oldPos; + OPT_Struct typ = NIL; + OPT_Object redef = NIL; + oldPos = OPM_errpos; + OPM_errpos = obj->scope->adr; + typ = obj->link->typ; + if (typ->form == 13) { + typ = typ->BaseTyp; + } + OPT_FindField(obj->name, typ->BaseTyp, &redef); + if (redef != NIL) { + obj->adr = __ASHL(__ASHR(redef->adr, 16), 16); + if (!__IN(2, obj->conval->setval)) { + OPM_err(119); + } + } else { + obj->adr += __ASHL(typ->n, 16); + typ->n += 1; + } + OPM_errpos = oldPos; +} + +static void OPV_TraverseRecord (OPT_Struct typ) +{ + if (!typ->allocated) { + if (typ->BaseTyp != NIL) { + OPV_TraverseRecord(typ->BaseTyp); + typ->n = typ->BaseTyp->n; + } + typ->allocated = 1; + OPV_Traverse(typ->link, typ->strobj, 0); + } +} + +static void OPV_Stamp (OPS_Name s) +{ + INTEGER i, j, k; + CHAR n[10]; + OPV_stamp += 1; + i = 0; + j = OPV_stamp; + while (s[__X(i, ((LONGINT)(256)))] != 0x00) { + i += 1; + } + if (i > 25) { + i = 25; + } + s[__X(i, ((LONGINT)(256)))] = '_'; + s[__X(i + 1, ((LONGINT)(256)))] = '_'; + i += 2; + k = 0; + do { + n[__X(k, ((LONGINT)(10)))] = (CHAR)((int)__MOD(j, 10) + 48); + j = __DIV(j, 10); + k += 1; + } while (!(j == 0)); + do { + k -= 1; + s[__X(i, ((LONGINT)(256)))] = n[__X(k, ((LONGINT)(10)))]; + i += 1; + } while (!(k == 0)); + s[__X(i, ((LONGINT)(256)))] = 0x00; +} + +static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported) +{ + INTEGER mode; + OPT_Object scope = NIL; + OPT_Struct typ = NIL; + if (obj != NIL) { + OPV_Traverse(obj->left, outerScope, exported); + if (obj->name[0] == '@') { + obj->name[0] = '_'; + OPV_Stamp(obj->name); + } + obj->linkadr = 0; + mode = obj->mode; + if ((mode == 5 && (obj->vis != 0) == exported)) { + typ = obj->typ; + OPV_TypSize(obj->typ); + if (typ->form == 13) { + typ = typ->BaseTyp; + } + if (typ->comp == 4) { + OPV_TraverseRecord(typ); + } + } else if (mode == 13) { + OPV_GetTProcNum(obj); + } else if (mode == 1) { + OPV_TypSize(obj->typ); + } + if (!exported) { + if ((__IN(mode, 0x60) && obj->mnolev > 0)) { + OPV_Stamp(obj->name); + } + if (__IN(mode, 0x26)) { + obj->scope = outerScope; + } else if (__IN(mode, 0x26c0)) { + if (obj->conval->setval == 0x0) { + OPM_err(129); + } + scope = obj->scope; + scope->leaf = 1; + __COPY(obj->name, scope->name, ((LONGINT)(256))); + OPV_Stamp(scope->name); + if (mode == 9) { + obj->adr = 1; + } + if (scope->mnolev > 1) { + outerScope->leaf = 0; + } + OPV_Traverse(obj->scope->right, obj->scope, 0); + } + } + OPV_Traverse(obj->right, outerScope, exported); + } +} + +void OPV_AdrAndSize (OPT_Object topScope) +{ + OPM_errpos = topScope->adr; + topScope->leaf = 1; + OPV_Traverse(topScope->right, topScope, 1); + OPV_Traverse(topScope->right, topScope, 0); + OPT_chartyp->strobj->linkadr = 2; + OPT_settyp->strobj->linkadr = 2; + OPT_realtyp->strobj->linkadr = 2; + OPT_inttyp->strobj->linkadr = 2; + OPT_linttyp->strobj->linkadr = 2; + OPT_lrltyp->strobj->linkadr = 2; + OPT_sinttyp->strobj->linkadr = 2; + OPT_booltyp->strobj->linkadr = 2; + OPT_bytetyp->strobj->linkadr = 2; + OPT_sysptrtyp->strobj->linkadr = 2; +} + +static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp) +{ + INTEGER _o_result; + switch (class) { + case 7: case 0: case 2: case 4: case 9: + case 13: + _o_result = 10; + return _o_result; + break; + case 5: + if (__IN(3, OPM_opt)) { + _o_result = 10; + return _o_result; + } else { + _o_result = 9; + return _o_result; + } + break; + case 1: + if (__IN(comp, 0x0c)) { + _o_result = 10; + return _o_result; + } else { + _o_result = 9; + return _o_result; + } + break; + case 3: + _o_result = 9; + return _o_result; + break; + case 11: + switch (subclass) { + case 33: case 7: case 24: case 29: case 20: + _o_result = 9; + return _o_result; + break; + case 16: case 21: case 22: case 23: case 25: + _o_result = 10; + return _o_result; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence Nmop, subclass = ", (LONGINT)51); + OPM_LogWNum(subclass, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + break; + case 12: + switch (subclass) { + case 1: + if (form == 9) { + _o_result = 4; + return _o_result; + } else { + _o_result = 8; + return _o_result; + } + break; + case 2: + if (form == 9) { + _o_result = 3; + return _o_result; + } else { + _o_result = 8; + return _o_result; + } + break; + case 3: case 4: + _o_result = 10; + return _o_result; + break; + case 6: + if (form == 9) { + _o_result = 2; + return _o_result; + } else { + _o_result = 7; + return _o_result; + } + break; + case 7: + if (form == 9) { + _o_result = 4; + return _o_result; + } else { + _o_result = 7; + return _o_result; + } + break; + case 11: case 12: case 13: case 14: + _o_result = 6; + return _o_result; + break; + case 9: case 10: + _o_result = 5; + return _o_result; + break; + case 5: + _o_result = 1; + return _o_result; + break; + case 8: + _o_result = 0; + return _o_result; + break; + case 19: case 15: case 17: case 18: case 26: + case 27: case 28: + _o_result = 10; + return _o_result; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence Ndop, subclass = ", (LONGINT)51); + OPM_LogWNum(subclass, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + break; + case 10: + _o_result = 10; + return _o_result; + break; + case 8: case 6: + _o_result = 12; + return _o_result; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence, class = ", (LONGINT)43); + OPM_LogWNum(class, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + __RETCHK; +} + +static void OPV_Len (OPT_Node n, LONGINT dim) +{ + while ((n->class == 4 && n->typ->comp == 3)) { + dim += 1; + n = n->left; + } + if ((n->class == 3 && n->typ->comp == 3)) { + OPV_design(n->left, 10); + OPM_WriteString((CHAR*)"->len[", (LONGINT)7); + OPM_WriteInt(dim); + OPM_Write(']'); + } else { + OPC_Len(n->obj, n->typ, dim); + } +} + +static BOOLEAN OPV_SideEffects (OPT_Node n) +{ + BOOLEAN _o_result; + if (n != NIL) { + _o_result = (n->class == 13 || OPV_SideEffects(n->left)) || OPV_SideEffects(n->right); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +static void OPV_Entier (OPT_Node n, INTEGER prec) +{ + if (__IN(n->typ->form, 0x0180)) { + OPM_WriteString((CHAR*)"__ENTIER(", (LONGINT)10); + OPV_expr(n, -1); + OPM_Write(')'); + } else { + OPV_expr(n, prec); + } +} + +static void OPV_Convert (OPT_Node n, INTEGER form, INTEGER prec) +{ + INTEGER from; + from = n->typ->form; + if (form == 9) { + OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9); + OPV_Entier(n, -1); + OPM_Write(')'); + } else if (form == 6) { + if (from < 6) { + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + } + OPV_Entier(n, 9); + } else if (form == 5) { + if (from < 5) { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + OPV_expr(n, 9); + } else { + if (__IN(2, OPM_opt)) { + OPM_WriteString((CHAR*)"__SHORT", (LONGINT)8); + if (OPV_SideEffects(n)) { + OPM_Write('F'); + } + OPM_Write('('); + OPV_Entier(n, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(OPM_MaxInt + 1); + OPM_Write(')'); + } else { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + OPV_Entier(n, 9); + } + } + } else if (form == 4) { + if (__IN(2, OPM_opt)) { + OPM_WriteString((CHAR*)"__SHORT", (LONGINT)8); + if (OPV_SideEffects(n)) { + OPM_Write('F'); + } + OPM_Write('('); + OPV_Entier(n, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(OPM_MaxSInt + 1); + OPM_Write(')'); + } else { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + OPV_Entier(n, 9); + } + } else if (form == 3) { + if (__IN(2, OPM_opt)) { + OPM_WriteString((CHAR*)"__CHR", (LONGINT)6); + if (OPV_SideEffects(n)) { + OPM_Write('F'); + } + OPM_Write('('); + OPV_Entier(n, -1); + OPM_Write(')'); + } else { + OPM_WriteString((CHAR*)"(CHAR)", (LONGINT)7); + OPV_Entier(n, 9); + } + } else { + OPV_expr(n, prec); + } +} + +static void OPV_TypeOf (OPT_Node n) +{ + if (n->typ->form == 13) { + OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10); + OPV_expr(n, -1); + OPM_Write(')'); + } else if (__IN(n->class, 0x15)) { + OPC_Andent(n->typ); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } else if (n->class == 3) { + OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10); + OPV_expr(n->left, -1); + OPM_Write(')'); + } else if (n->class == 5) { + OPV_TypeOf(n->left); + } else if ((n->class == 11 && n->subcl == 29)) { + OPC_TypeOf(n->left->obj); + } else { + OPC_TypeOf(n->obj); + } +} + +static void OPV_Index (OPT_Node n, OPT_Node d, INTEGER prec, INTEGER dim) +{ + if (!OPV_inxchk || (n->right->class == 7 && (n->right->conval->intval == 0 || n->left->typ->comp != 3))) { + OPV_expr(n->right, prec); + } else { + if (OPV_SideEffects(n->right)) { + OPM_WriteString((CHAR*)"__XF(", (LONGINT)6); + } else { + OPM_WriteString((CHAR*)"__X(", (LONGINT)5); + } + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_Len(d, dim); + OPM_Write(')'); + } +} + +static void OPV_design (OPT_Node n, INTEGER prec) +{ + OPT_Object obj = NIL; + OPT_Struct typ = NIL; + INTEGER class, designPrec, comp; + OPT_Node d = NIL, x = NIL; + INTEGER dims, i, _for__26; + comp = n->typ->comp; + obj = n->obj; + class = n->class; + designPrec = OPV_Precedence(class, n->subcl, n->typ->form, comp); + if ((((((class == 0 && obj->mnolev > 0)) && (int)obj->mnolev != OPM_level)) && prec == 10)) { + designPrec = 9; + } + if (prec > designPrec) { + OPM_Write('('); + } + if (prec == 11) { + OPM_Write('*'); + } + switch (class) { + case 9: + OPC_Ident(n->obj); + break; + case 0: + OPC_CompleteIdent(n->obj); + break; + case 1: + if (!__IN(comp, 0x0c)) { + OPM_Write('*'); + } + OPC_CompleteIdent(n->obj); + break; + case 2: + if (n->left->class == 3) { + OPV_design(n->left->left, designPrec); + OPM_WriteString((CHAR*)"->", (LONGINT)3); + } else { + OPV_design(n->left, designPrec); + OPM_Write('.'); + } + OPC_Ident(n->obj); + break; + case 3: + if (n->typ->comp == 3) { + OPV_design(n->left, 10); + OPM_WriteString((CHAR*)"->data", (LONGINT)7); + } else { + OPM_Write('*'); + OPV_design(n->left, designPrec); + } + break; + case 4: + d = n->left; + if (d->typ->comp == 3) { + dims = 0; + while (d->class == 4) { + d = d->left; + dims += 1; + } + if (n->typ->comp == 3) { + OPM_Write('&'); + } + OPV_design(d, designPrec); + OPM_Write('['); + if (n->typ->comp == 3) { + OPM_Write('('); + } + i = dims; + x = n; + while (x != d) { + if (x->left != d) { + OPV_Index(x, d, 7, i); + OPM_WriteString((CHAR*)" + ", (LONGINT)4); + OPV_Len(d, i); + OPM_WriteString((CHAR*)" * (", (LONGINT)5); + i -= 1; + } else { + OPV_Index(x, d, -1, i); + } + x = x->left; + } + _for__26 = dims; + i = 1; + while (i <= _for__26) { + OPM_Write(')'); + i += 1; + } + if (n->typ->comp == 3) { + OPM_Write(')'); + while ((LONGINT)i < __ASHR(d->typ->size - 4, 2)) { + OPM_WriteString((CHAR*)" * ", (LONGINT)4); + OPV_Len(d, i); + i += 1; + } + } + OPM_Write(']'); + } else { + OPV_design(n->left, designPrec); + OPM_Write('['); + OPV_Index(n, n->left, -1, 0); + OPM_Write(']'); + } + break; + case 5: + typ = n->typ; + obj = n->left->obj; + if (__IN(3, OPM_opt)) { + if (typ->comp == 4) { + OPM_WriteString((CHAR*)"__GUARDR(", (LONGINT)10); + if ((int)obj->mnolev != OPM_level) { + OPM_WriteStringVar((void*)obj->scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"__curr->", (LONGINT)9); + OPC_Ident(obj); + } else { + OPC_Ident(obj); + } + } else { + if (typ->BaseTyp->strobj == NIL) { + OPM_WriteString((CHAR*)"__GUARDA(", (LONGINT)10); + } else { + OPM_WriteString((CHAR*)"__GUARDP(", (LONGINT)10); + } + OPV_expr(n->left, -1); + typ = typ->BaseTyp; + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(typ); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(typ->extlev); + OPM_Write(')'); + } else { + if (typ->comp == 4) { + OPM_WriteString((CHAR*)"*(", (LONGINT)3); + OPC_Ident(typ->strobj); + OPM_WriteString((CHAR*)"*)", (LONGINT)3); + OPC_CompleteIdent(obj); + } else { + OPM_Write('('); + OPC_Ident(typ->strobj); + OPM_Write(')'); + OPV_expr(n->left, designPrec); + } + } + break; + case 6: + if (__IN(3, OPM_opt)) { + if (n->left->class == 1) { + OPM_WriteString((CHAR*)"__GUARDEQR(", (LONGINT)12); + OPC_CompleteIdent(n->left->obj); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_TypeOf(n->left); + } else { + OPM_WriteString((CHAR*)"__GUARDEQP(", (LONGINT)12); + OPV_expr(n->left->left, -1); + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(n->left->typ->strobj); + OPM_Write(')'); + } else { + OPV_expr(n->left, -1); + } + break; + case 11: + if (n->subcl == 29) { + OPV_design(n->left, prec); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.design, class = ", (LONGINT)39); + OPM_LogWNum(class, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + if (prec > designPrec) { + OPM_Write(')'); + } +} + +static void OPV_ActualPar (OPT_Node n, OPT_Object fp) +{ + OPT_Struct typ = NIL, aptyp = NIL; + INTEGER comp, form, mode, prec, dim; + OPM_Write('('); + while (n != NIL) { + typ = fp->typ; + comp = typ->comp; + form = typ->form; + mode = fp->mode; + prec = -1; + if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) { + OPM_Write('('); + OPC_Ident(n->typ->strobj); + OPM_WriteString((CHAR*)"*)", (LONGINT)3); + prec = 10; + } + if (!__IN(n->typ->comp, 0x0c)) { + if (mode == 2) { + if ((OPV_ansi && typ != n->typ)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } + OPM_Write('&'); + prec = 9; + } else if (OPV_ansi) { + if ((__IN(comp, 0x0c) && n->class == 7)) { + OPM_WriteString((CHAR*)"(CHAR*)", (LONGINT)8); + } else if ((((form == 13 && typ != n->typ)) && n->typ != OPT_niltyp)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } + } else { + if ((__IN(form, 0x0180) && __IN(n->typ->form, 0x70))) { + OPM_WriteString((CHAR*)"(double)", (LONGINT)9); + prec = 9; + } else if ((form == 6 && n->typ->form < 6)) { + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + prec = 9; + } + } + } else if (OPV_ansi) { + if ((((mode == 2 && typ != n->typ)) && prec == -1)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } + } + if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) { + OPV_expr(n->left, prec); + } else if ((((((form == 6 && n->class == 7)) && n->conval->intval <= OPM_MaxInt)) && n->conval->intval >= OPM_MinInt)) { + OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12); + OPV_expr(n, prec); + OPM_WriteString((CHAR*)"))", (LONGINT)3); + } else { + OPV_expr(n, prec); + } + if ((comp == 4 && mode == 2)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_TypeOf(n); + } else if (comp == 3) { + if (n->class == 7) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + OPM_WriteInt(n->conval->intval2); + } else { + aptyp = n->typ; + dim = 0; + while ((typ->comp == 3 && typ->BaseTyp->form != 1)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_Len(n, dim); + typ = typ->BaseTyp; + aptyp = aptyp->BaseTyp; + dim += 1; + } + if ((typ->comp == 3 && typ->BaseTyp->form == 1)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + while (aptyp->comp == 3) { + OPV_Len(n, dim); + OPM_WriteString((CHAR*)" * ", (LONGINT)4); + dim += 1; + aptyp = aptyp->BaseTyp; + } + OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12); + OPM_WriteInt(aptyp->size); + OPM_WriteString((CHAR*)"))", (LONGINT)3); + } + } + } + n = n->link; + fp = fp->link; + if (n != NIL) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + } + } + OPM_Write(')'); +} + +static OPT_Object OPV_SuperProc (OPT_Node n) +{ + OPT_Object _o_result; + OPT_Object obj = NIL; + OPT_Struct typ = NIL; + typ = n->right->typ; + if (typ->form == 13) { + typ = typ->BaseTyp; + } + OPT_FindField(n->left->obj->name, typ->BaseTyp, &obj); + _o_result = obj; + return _o_result; +} + +static void OPV_expr (OPT_Node n, INTEGER prec) +{ + INTEGER class, subclass, form, exprPrec; + OPT_Struct typ = NIL; + OPT_Node l = NIL, r = NIL; + OPT_Object proc = NIL; + class = n->class; + subclass = n->subcl; + form = n->typ->form; + l = n->left; + r = n->right; + exprPrec = OPV_Precedence(class, subclass, form, n->typ->comp); + if ((exprPrec <= prec && __IN(class, 0x3ce0))) { + OPM_Write('('); + } + switch (class) { + case 7: + OPC_Constant(n->conval, form); + break; + case 10: + OPM_WriteString((CHAR*)"__SETRNG(", (LONGINT)10); + OPV_expr(l, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(r, -1); + OPM_Write(')'); + break; + case 11: + switch (subclass) { + case 33: + OPM_Write('!'); + OPV_expr(l, exprPrec); + break; + case 7: + if (form == 9) { + OPM_Write('~'); + } else { + OPM_Write('-'); + } + OPV_expr(l, exprPrec); + break; + case 16: + typ = n->obj->typ; + if (l->typ->comp == 4) { + OPM_WriteString((CHAR*)"__IS(", (LONGINT)6); + OPC_TypeOf(l->obj); + } else { + OPM_WriteString((CHAR*)"__ISP(", (LONGINT)7); + OPV_expr(l, -1); + typ = typ->BaseTyp; + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(typ); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(typ->extlev); + OPM_Write(')'); + break; + case 20: + OPV_Convert(l, form, exprPrec); + break; + case 21: + if (OPV_SideEffects(l)) { + if (l->typ->form < 7) { + if (l->typ->form < 6) { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + } + OPM_WriteString((CHAR*)"__ABSF(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ABSFD(", (LONGINT)9); + } + } else { + OPM_WriteString((CHAR*)"__ABS(", (LONGINT)7); + } + OPV_expr(l, -1); + OPM_Write(')'); + break; + case 22: + OPM_WriteString((CHAR*)"__CAP(", (LONGINT)7); + OPV_expr(l, -1); + OPM_Write(')'); + break; + case 23: + OPM_WriteString((CHAR*)"__ODD(", (LONGINT)7); + OPV_expr(l, -1); + OPM_Write(')'); + break; + case 24: + OPM_WriteString((CHAR*)"(LONGINT)(uintptr_t)", (LONGINT)21); + if (l->class == 1) { + OPC_CompleteIdent(l->obj); + } else { + if ((l->typ->form != 10 && !__IN(l->typ->comp, 0x0c))) { + OPM_Write('&'); + } + OPV_expr(l, exprPrec); + } + break; + case 29: + if ((((__IN(n->typ->form, 0x6240) && __IN(l->typ->form, 0x6240))) && n->typ->size == l->typ->size) || !__IN(l->class, 0x17)) { + OPM_Write('('); + OPC_Ident(n->typ->strobj); + OPM_Write(')'); + if (__IN(n->typ->form, 0x6000) || __IN(l->typ->form, 0x6000)) { + OPM_WriteString((CHAR*)"(uintptr_t)", (LONGINT)12); + } + OPV_expr(l, exprPrec); + } else { + if (__IN(n->typ->form, 0x6000) || __IN(l->typ->form, 0x6000)) { + OPM_WriteString((CHAR*)"__VALP(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__VAL(", (LONGINT)7); + } + OPC_Ident(n->typ->strobj); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(l, -1); + OPM_Write(')'); + } + break; + default: + OPM_err(200); + break; + } + break; + case 12: + switch (subclass) { + case 19: + OPV_Len(l, r->conval->intval); + break; + case 15: case 17: case 18: case 26: case 27: + case 28: case 3: case 4: + switch (subclass) { + case 15: + OPM_WriteString((CHAR*)"__IN(", (LONGINT)6); + break; + case 17: + if (r->class == 7) { + if (r->conval->intval >= 0) { + OPM_WriteString((CHAR*)"__ASHL(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ASHR(", (LONGINT)8); + } + } else if (OPV_SideEffects(r)) { + OPM_WriteString((CHAR*)"__ASHF(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ASH(", (LONGINT)7); + } + break; + case 18: + OPM_WriteString((CHAR*)"__MASK(", (LONGINT)8); + break; + case 26: + OPM_WriteString((CHAR*)"__BIT(", (LONGINT)7); + break; + case 27: + if (r->class == 7) { + if (r->conval->intval >= 0) { + OPM_WriteString((CHAR*)"__LSHL(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__LSHR(", (LONGINT)8); + } + } else { + OPM_WriteString((CHAR*)"__LSH(", (LONGINT)7); + } + break; + case 28: + if (r->class == 7) { + if (r->conval->intval >= 0) { + OPM_WriteString((CHAR*)"__ROTL(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ROTR(", (LONGINT)8); + } + } else { + OPM_WriteString((CHAR*)"__ROT(", (LONGINT)7); + } + break; + case 3: + if (OPV_SideEffects(n)) { + if (form < 6) { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + } + OPM_WriteString((CHAR*)"__DIVF(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__DIV(", (LONGINT)7); + } + break; + case 4: + if (form < 6) { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + } + if (OPV_SideEffects(n)) { + OPM_WriteString((CHAR*)"__MODF(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__MOD(", (LONGINT)7); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", (LONGINT)40); + OPM_LogWNum(subclass, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + OPV_expr(l, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if ((((__IN(subclass, 0x18020000) && r->class == 7)) && r->conval->intval < 0)) { + OPM_WriteInt(-r->conval->intval); + } else { + OPV_expr(r, -1); + } + if (__IN(subclass, 0x18000000)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(l->typ->strobj); + } + OPM_Write(')'); + break; + case 9: case 10: case 11: case 12: case 13: + case 14: + if (__IN(l->typ->form, 0x8400)) { + OPM_WriteString((CHAR*)"__STRCMP(", (LONGINT)10); + OPV_expr(l, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(r, -1); + OPM_Write(')'); + OPC_Cmp(subclass); + OPM_Write('0'); + } else { + OPV_expr(l, exprPrec); + OPC_Cmp(subclass); + typ = l->typ; + if ((((((typ->form == 13 && r->typ->form != 11)) && r->typ != typ)) && r->typ != OPT_sysptrtyp)) { + OPM_WriteString((CHAR*)"(void *) ", (LONGINT)10); + } + OPV_expr(r, exprPrec); + } + break; + default: + if (subclass == 5 || (form == 9 && (subclass == 1 || subclass == 7))) { + OPM_Write('('); + } + OPV_expr(l, exprPrec); + switch (subclass) { + case 1: + if (form == 9) { + OPM_WriteString((CHAR*)" & ", (LONGINT)4); + } else { + OPM_WriteString((CHAR*)" * ", (LONGINT)4); + } + break; + case 2: + if (form == 9) { + OPM_WriteString((CHAR*)" ^ ", (LONGINT)4); + } else { + OPM_WriteString((CHAR*)" / ", (LONGINT)4); + if (r->obj == NIL || __IN(r->obj->typ->form, 0x70)) { + OPM_Write('('); + OPC_Ident(n->typ->strobj); + OPM_Write(')'); + } + } + break; + case 5: + OPM_WriteString((CHAR*)" && ", (LONGINT)5); + break; + case 6: + if (form == 9) { + OPM_WriteString((CHAR*)" | ", (LONGINT)4); + } else { + OPM_WriteString((CHAR*)" + ", (LONGINT)4); + } + break; + case 7: + if (form == 9) { + OPM_WriteString((CHAR*)" & ~", (LONGINT)5); + } else { + OPM_WriteString((CHAR*)" - ", (LONGINT)4); + } + break; + case 8: + OPM_WriteString((CHAR*)" || ", (LONGINT)5); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", (LONGINT)40); + OPM_LogWNum(subclass, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + OPV_expr(r, exprPrec); + if (subclass == 5 || (form == 9 && (subclass == 1 || subclass == 7))) { + OPM_Write(')'); + } + break; + } + break; + case 13: + if ((l->obj != NIL && l->obj->mode == 13)) { + if (l->subcl == 1) { + proc = OPV_SuperProc(n); + } else { + OPM_WriteString((CHAR*)"__", (LONGINT)3); + proc = OPC_BaseTProc(l->obj); + } + OPC_Ident(proc); + n->obj = proc->link; + } else if (l->class == 9) { + OPV_design(l, 10); + } else { + OPV_design(l, 11); + } + OPV_ActualPar(r, n->obj); + break; + default: + OPV_design(n, prec); + break; + } + if ((exprPrec <= prec && __IN(class, 0x3ca0))) { + OPM_Write(')'); + } +} + +static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc) +{ + OPT_Node if_ = NIL; + OPT_Object obj = NIL; + OPT_Struct typ = NIL; + LONGINT adr; + if_ = n->left; + while (if_ != NIL) { + OPM_WriteString((CHAR*)"if ", (LONGINT)4); + OPV_expr(if_->left, 12); + OPM_Write(' '); + OPC_BegBlk(); + if ((n->class == 27 && if_->left->left != NIL)) { + obj = if_->left->left->obj; + typ = obj->typ; + adr = obj->adr; + if (typ->comp == 4) { + OPC_BegStat(); + OPC_Ident(if_->left->obj); + OPM_WriteString((CHAR*)" *", (LONGINT)3); + OPM_WriteString(obj->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"__ = (void*)", (LONGINT)13); + obj->adr = 0; + OPC_CompleteIdent(obj); + OPC_EndStat(); + } + obj->adr = 1; + obj->typ = if_->left->obj->typ; + OPV_stat(if_->right, outerProc); + obj->typ = typ; + obj->adr = adr; + } else { + OPV_stat(if_->right, outerProc); + } + if_ = if_->link; + if ((if_ != NIL || n->right != NIL) || withtrap) { + OPC_EndBlk0(); + OPM_WriteString((CHAR*)" else ", (LONGINT)7); + } else { + OPC_EndBlk(); + } + } + if (withtrap) { + OPM_WriteString((CHAR*)"__WITHCHK", (LONGINT)10); + OPC_EndStat(); + } else if (n->right != NIL) { + OPC_BegBlk(); + OPV_stat(n->right, outerProc); + OPC_EndBlk(); + } +} + +static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc) +{ + OPT_Node switchCase = NIL, label = NIL; + LONGINT low, high; + INTEGER form, i; + OPM_WriteString((CHAR*)"switch ", (LONGINT)8); + OPV_expr(n->left, 12); + OPM_Write(' '); + OPC_BegBlk(); + form = n->left->typ->form; + switchCase = n->right->left; + while (switchCase != NIL) { + label = switchCase->left; + i = 0; + while (label != NIL) { + low = label->conval->intval; + high = label->conval->intval2; + while (low <= high) { + if (i == 0) { + OPC_BegStat(); + } + OPC_Case(low, form); + low += 1; + i += 1; + if (i == 5) { + OPM_WriteLn(); + i = 0; + } + } + label = label->link; + } + if (i > 0) { + OPM_WriteLn(); + } + OPC_Indent(1); + OPV_stat(switchCase->right, outerProc); + OPC_BegStat(); + OPM_WriteString((CHAR*)"break", (LONGINT)6); + OPC_EndStat(); + OPC_Indent(-1); + switchCase = switchCase->link; + } + OPC_BegStat(); + OPM_WriteString((CHAR*)"default: ", (LONGINT)10); + if (n->right->conval->setval != 0x0) { + OPC_Indent(1); + OPM_WriteLn(); + OPV_stat(n->right->right, outerProc); + OPC_BegStat(); + OPM_WriteString((CHAR*)"break", (LONGINT)6); + OPC_Indent(-1); + } else { + OPM_WriteString((CHAR*)"__CASECHK", (LONGINT)10); + } + OPC_EndStat(); + OPC_EndBlk(); +} + +static BOOLEAN OPV_ImplicitReturn (OPT_Node n) +{ + BOOLEAN _o_result; + while ((n != NIL && n->class != 26)) { + n = n->link; + } + _o_result = n == NIL; + return _o_result; +} + +static void OPV_NewArr (OPT_Node d, OPT_Node x) +{ + OPT_Struct typ = NIL, base = NIL; + INTEGER nofdim, nofdyn; + typ = d->typ->BaseTyp; + base = typ; + nofdim = 0; + nofdyn = 0; + while (base->comp == 3) { + nofdim += 1; + nofdyn += 1; + base = base->BaseTyp; + } + OPV_design(d, -1); + OPM_WriteString((CHAR*)" = __NEWARR(", (LONGINT)13); + while (base->comp == 2) { + nofdim += 1; + base = base->BaseTyp; + } + if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) { + OPC_Ident(base->strobj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } else if (base->form == 13) { + OPM_WriteString((CHAR*)"POINTER__typ", (LONGINT)13); + } else { + OPM_WriteString((CHAR*)"NIL", (LONGINT)4); + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12); + OPM_WriteInt(base->size); + OPM_WriteString((CHAR*)"))", (LONGINT)3); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(OPC_Base(base)); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(nofdim); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(nofdyn); + while (typ != base) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (typ->comp == 3) { + if (x->class == 7) { + OPM_WriteString((CHAR*)"(LONGINT)(", (LONGINT)11); + OPV_expr(x, -1); + OPM_WriteString((CHAR*)")", (LONGINT)2); + } else { + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + OPV_expr(x, 10); + } + x = x->link; + } else { + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + OPM_WriteInt(typ->n); + } + typ = typ->BaseTyp; + } + OPM_Write(')'); +} + +static void OPV_DefineTDescs (OPT_Node n) +{ + while ((n != NIL && n->class == 14)) { + OPC_TDescDecl(n->typ); + n = n->link; + } +} + +static void OPV_InitTDescs (OPT_Node n) +{ + while ((n != NIL && n->class == 14)) { + OPC_InitTDesc(n->typ); + n = n->link; + } +} + +static void OPV_stat (OPT_Node n, OPT_Object outerProc) +{ + OPT_Object proc = NIL; + OPV_ExitInfo saved; + OPT_Node l = NIL, r = NIL; + while ((n != NIL && OPM_noerr)) { + OPM_errpos = n->conval->intval; + if (n->class != 14) { + OPC_BegStat(); + } + switch (n->class) { + case 18: + if (n->obj == NIL) { + OPM_level += 1; + OPV_stat(n->left, outerProc); + OPM_level -= 1; + OPC_GenEnumPtrs(OPT_topScope->scope); + OPV_DefineTDescs(n->right); + OPC_EnterBody(); + OPV_InitTDescs(n->right); + OPM_WriteString((CHAR*)"/* BEGIN */", (LONGINT)12); + OPM_WriteLn(); + OPV_stat(n->right, outerProc); + OPC_ExitBody(); + } else { + proc = n->obj; + OPC_TypeDefs(proc->scope->right, 0); + if (!proc->scope->leaf) { + OPC_DefineInter(proc); + } + OPM_level += 1; + OPV_stat(n->left, proc); + OPM_level -= 1; + OPC_EnterProc(proc); + OPV_stat(n->right, proc); + OPC_ExitProc(proc, 1, OPV_ImplicitReturn(n->right)); + } + break; + case 14: + break; + case 19: + switch (n->subcl) { + case 0: + l = n->left; + r = n->right; + if (l->typ->comp == 2) { + OPM_WriteString((CHAR*)"__MOVE(", (LONGINT)8); + OPV_expr(r, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(l, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (r->typ == OPT_stringtyp) { + OPM_WriteInt(r->conval->intval2); + } else { + OPM_WriteInt(r->typ->size); + } + OPM_Write(')'); + } else { + if ((((((l->typ->form == 13 && l->obj != NIL)) && l->obj->adr == 1)) && l->obj->mode == 1)) { + l->obj->adr = 0; + OPV_design(l, -1); + l->obj->adr = 1; + if (r->typ->form != 11) { + OPM_WriteString((CHAR*)" = (void*)", (LONGINT)11); + } else { + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + } + } else { + OPV_design(l, -1); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + } + if (l->typ == r->typ) { + OPV_expr(r, -1); + } else if ((((l->typ->form == 13 && r->typ->form != 11)) && l->typ->strobj != NIL)) { + OPM_Write('('); + OPC_Ident(l->typ->strobj); + OPM_Write(')'); + OPV_expr(r, -1); + } else if (l->typ->comp == 4) { + OPM_WriteString((CHAR*)"*(", (LONGINT)3); + OPC_Andent(l->typ); + OPM_WriteString((CHAR*)"*)&", (LONGINT)4); + OPV_expr(r, 9); + } else { + OPV_expr(r, -1); + } + } + break; + case 1: + if (n->left->typ->BaseTyp->comp == 4) { + OPM_WriteString((CHAR*)"__NEW(", (LONGINT)7); + OPV_design(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(n->left->typ->BaseTyp); + OPM_WriteString((CHAR*)")", (LONGINT)2); + } else if (__IN(n->left->typ->BaseTyp->comp, 0x0c)) { + OPV_NewArr(n->left, n->right); + } + break; + case 13: case 14: + OPV_expr(n->left, -1); + OPC_Increment(n->subcl == 14); + OPV_expr(n->right, -1); + break; + case 15: case 16: + OPV_expr(n->left, -1); + OPC_SetInclude(n->subcl == 16); + OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9); + OPV_expr(n->right, -1); + OPM_Write(')'); + break; + case 18: + OPM_WriteString((CHAR*)"__COPY(", (LONGINT)8); + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_Len(n->left, ((LONGINT)(0))); + OPM_Write(')'); + break; + case 31: + OPM_WriteString((CHAR*)"__MOVE(", (LONGINT)8); + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->right->link, -1); + OPM_Write(')'); + break; + case 24: + OPM_WriteString((CHAR*)"__GET(", (LONGINT)7); + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(n->left->typ->strobj); + OPM_Write(')'); + break; + case 25: + OPM_WriteString((CHAR*)"__PUT(", (LONGINT)7); + OPV_expr(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(n->right->typ->strobj); + OPM_Write(')'); + break; + case 26: case 27: + OPM_err(200); + break; + case 30: + OPM_WriteString((CHAR*)"__SYSNEW(", (LONGINT)10); + OPV_design(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->right, -1); + OPM_Write(')'); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.subcl = ", (LONGINT)40); + OPM_LogWNum(n->subcl, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + break; + case 13: + if ((n->left->obj != NIL && n->left->obj->mode == 13)) { + if (n->left->subcl == 1) { + proc = OPV_SuperProc(n); + } else { + OPM_WriteString((CHAR*)"__", (LONGINT)3); + proc = OPC_BaseTProc(n->left->obj); + } + OPC_Ident(proc); + n->obj = proc->link; + } else if (n->left->class == 9) { + OPV_design(n->left, 10); + } else { + OPV_design(n->left, 11); + } + OPV_ActualPar(n->right, n->obj); + break; + case 20: + if (n->subcl != 32) { + OPV_IfStat(n, 0, outerProc); + } else if (OPV_assert) { + OPM_WriteString((CHAR*)"__ASSERT(", (LONGINT)10); + OPV_expr(n->left->left->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(n->left->right->right->conval->intval); + OPM_Write(')'); + OPC_EndStat(); + } + break; + case 21: + OPV_exit.level += 1; + OPV_CaseStat(n, outerProc); + OPV_exit.level -= 1; + break; + case 22: + OPV_exit.level += 1; + OPM_WriteString((CHAR*)"while ", (LONGINT)7); + OPV_expr(n->left, 12); + OPM_Write(' '); + OPC_BegBlk(); + OPV_stat(n->right, outerProc); + OPC_EndBlk(); + OPV_exit.level -= 1; + break; + case 23: + OPV_exit.level += 1; + OPM_WriteString((CHAR*)"do ", (LONGINT)4); + OPC_BegBlk(); + OPV_stat(n->left, outerProc); + OPC_EndBlk0(); + OPM_WriteString((CHAR*)" while (!", (LONGINT)10); + OPV_expr(n->right, 9); + OPM_Write(')'); + OPV_exit.level -= 1; + break; + case 24: + saved = OPV_exit; + OPV_exit.level = 0; + OPV_exit.label = -1; + OPM_WriteString((CHAR*)"for (;;) ", (LONGINT)10); + OPC_BegBlk(); + OPV_stat(n->left, outerProc); + OPC_EndBlk(); + if (OPV_exit.label != -1) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"exit__", (LONGINT)7); + OPM_WriteInt(OPV_exit.label); + OPM_Write(':'); + OPC_EndStat(); + } + OPV_exit = saved; + break; + case 25: + if (OPV_exit.level == 0) { + OPM_WriteString((CHAR*)"break", (LONGINT)6); + } else { + if (OPV_exit.label == -1) { + OPV_exit.label = OPV_nofExitLabels; + OPV_nofExitLabels += 1; + } + OPM_WriteString((CHAR*)"goto exit__", (LONGINT)12); + OPM_WriteInt(OPV_exit.label); + } + break; + case 26: + if (OPM_level == 0) { + if (OPV_mainprog) { + OPM_WriteString((CHAR*)"__FINI", (LONGINT)7); + } else { + OPM_WriteString((CHAR*)"__ENDMOD", (LONGINT)9); + } + } else { + if (n->left != NIL) { + OPM_WriteString((CHAR*)"_o_result = ", (LONGINT)13); + if ((n->left->typ->form == 13 && n->obj->typ != n->left->typ)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + OPV_expr(n->left, 10); + } else { + OPV_expr(n->left, -1); + } + OPM_WriteString((CHAR*)";", (LONGINT)2); + OPM_WriteLn(); + OPC_BegStat(); + OPC_ExitProc(outerProc, 0, 0); + OPM_WriteString((CHAR*)"return _o_result", (LONGINT)17); + } else { + OPM_WriteString((CHAR*)"return", (LONGINT)7); + } + } + break; + case 27: + OPV_IfStat(n, n->subcl == 0, outerProc); + break; + case 28: + OPC_Halt(n->right->conval->intval); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.class = ", (LONGINT)40); + OPM_LogWNum(n->class, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + if (!__IN(n->class, 0x09744000)) { + OPC_EndStat(); + } + n = n->link; + } +} + +void OPV_Module (OPT_Node prog) +{ + if (!OPV_mainprog) { + OPC_GenHdr(prog->right); + OPC_GenHdrIncludes(); + } + OPC_GenBdy(prog->right); + OPV_stat(prog, NIL); +} + +__TDESC(OPV_ExitInfo, 1, 0) = {__TDFLDS("ExitInfo", 4), {-4}}; + +export void *OPV__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPC); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPS); + __MODULE_IMPORT(OPT); + __REGMOD("OPV", 0); + __REGCMD("Init", OPV_Init); + __INITYP(OPV_ExitInfo, OPV_ExitInfo, 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-44/OPV.h b/bootstrap/unix-44/OPV.h new file mode 100644 index 00000000..9907a1ef --- /dev/null +++ b/bootstrap/unix-44/OPV.h @@ -0,0 +1,19 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPV__h +#define OPV__h + +#include "SYSTEM.h" +#include "OPT.h" + + + + +import void OPV_AdrAndSize (OPT_Object topScope); +import void OPV_Init (void); +import void OPV_Module (OPT_Node prog); +import void OPV_TypSize (OPT_Struct typ); +import void *OPV__init(void); + + +#endif diff --git a/bootstrap/unix-44/Platform.c b/bootstrap/unix-44/Platform.c new file mode 100644 index 00000000..013e6f9c --- /dev/null +++ b/bootstrap/unix-44/Platform.c @@ -0,0 +1,792 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" + +typedef + CHAR (*Platform_ArgPtr)[1024]; + +typedef + Platform_ArgPtr (*Platform_ArgVec)[1024]; + +typedef + LONGINT (*Platform_ArgVecPtr)[1]; + +typedef + CHAR (*Platform_EnvPtr)[1024]; + +typedef + struct Platform_FileIdentity { + LONGINT volume, index, mtime; + } Platform_FileIdentity; + +typedef + void (*Platform_HaltProcedure)(LONGINT); + +typedef + void (*Platform_SignalHandler)(INTEGER); + + +export BOOLEAN Platform_LittleEndian; +export LONGINT Platform_MainStackFrame, Platform_HaltCode; +export INTEGER Platform_PID; +export CHAR Platform_CWD[256]; +export INTEGER Platform_ArgCount; +export LONGINT Platform_ArgVector; +static Platform_HaltProcedure Platform_HaltHandler; +static LONGINT Platform_TimeStart; +export INTEGER Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd; +export CHAR Platform_nl[3]; + +export LONGINT *Platform_FileIdentity__typ; + +export BOOLEAN Platform_Absent (INTEGER e); +export INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len); +export void Platform_AssertFail (LONGINT code); +export INTEGER Platform_Chdir (CHAR *n, LONGINT n__len); +export INTEGER Platform_Close (LONGINT h); +export BOOLEAN Platform_ConnectionFailed (INTEGER e); +export void Platform_Delay (LONGINT ms); +export BOOLEAN Platform_DifferentFilesystems (INTEGER e); +static void Platform_DisplayHaltCode (LONGINT code); +export INTEGER Platform_Error (void); +export void Platform_Exit (INTEGER code); +export void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len); +export void Platform_GetClock (LONGINT *t, LONGINT *d); +export void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len); +export void Platform_GetIntArg (INTEGER n, LONGINT *val); +export void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec); +export void Platform_Halt (LONGINT code); +export INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ); +export INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ); +export BOOLEAN Platform_Inaccessible (INTEGER e); +export void Platform_Init (INTEGER argc, LONGINT argvadr); +export void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d); +export INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h); +export BOOLEAN Platform_NoSuchDirectory (INTEGER e); +export LONGINT Platform_OSAllocate (LONGINT size); +export void Platform_OSFree (LONGINT address); +export INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h); +export INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h); +export INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n); +export INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n); +export INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len); +export BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2); +export BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2); +export INTEGER Platform_Seek (LONGINT h, LONGINT offset, INTEGER whence); +export void Platform_SetBadInstructionHandler (Platform_SignalHandler handler); +export void Platform_SetHalt (Platform_HaltProcedure p); +export void Platform_SetInterruptHandler (Platform_SignalHandler handler); +export void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source); +export void Platform_SetQuitHandler (Platform_SignalHandler handler); +export INTEGER Platform_Size (LONGINT h, LONGINT *l); +export INTEGER Platform_Sync (LONGINT h); +export INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len); +static void Platform_TestLittleEndian (void); +export LONGINT Platform_Time (void); +export BOOLEAN Platform_TimedOut (INTEGER e); +export BOOLEAN Platform_TooManyFiles (INTEGER e); +export INTEGER Platform_Truncate (LONGINT h, LONGINT l); +export INTEGER Platform_Unlink (CHAR *n, LONGINT n__len); +export INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l); +static void Platform_YMDHMStoClock (LONGINT ye, LONGINT mo, LONGINT da, LONGINT ho, LONGINT mi, LONGINT se, LONGINT *t, LONGINT *d); +static void Platform_errch (CHAR c); +static void Platform_errint (LONGINT l); +static void Platform_errln (void); +static void Platform_errposint (LONGINT l); +export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len); + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#define Platform_EACCES() EACCES +#define Platform_EAGAIN() EAGAIN +#define Platform_ECONNABORTED() ECONNABORTED +#define Platform_ECONNREFUSED() ECONNREFUSED +#define Platform_EHOSTUNREACH() EHOSTUNREACH +#define Platform_EMFILE() EMFILE +#define Platform_ENETUNREACH() ENETUNREACH +#define Platform_ENFILE() ENFILE +#define Platform_ENOENT() ENOENT +#define Platform_EROFS() EROFS +#define Platform_ETIMEDOUT() ETIMEDOUT +#define Platform_EXDEV() EXDEV +extern void Heap_InitHeap(); +#define Platform_HeapInitHeap() Heap_InitHeap() +#define Platform_allocate(size) (LONGINT)(uintptr_t)((void*)malloc((size_t)size)) +#define Platform_chdir(n, n__len) chdir((char*)n) +#define Platform_closefile(fd) close(fd) +#define Platform_err() errno +#define Platform_errc(c) write(1, &c, 1) +#define Platform_errstring(s, s__len) write(1, s, s__len-1) +#define Platform_exit(code) exit(code) +#define Platform_free(address) free((void*)(uintptr_t)address) +#define Platform_fstat(fd) fstat(fd, &s) +#define Platform_fsync(fd) fsync(fd) +#define Platform_ftruncate(fd, l) ftruncate(fd, l) +#define Platform_getcwd(cwd, cwd__len) getcwd((char*)cwd, cwd__len) +#define Platform_getenv(var, var__len) (Platform_EnvPtr)getenv((char*)var) +#define Platform_getpid() (INTEGER)getpid() +#define Platform_gettimeval() struct timeval tv; gettimeofday(&tv,0) +#define Platform_lseek(fd, o, w) lseek(fd, o, w) +#define Platform_nanosleep(s, ns) struct timespec req, rem; req.tv_sec = s; req.tv_nsec = ns; nanosleep(&req, &rem) +#define Platform_opennew(n, n__len) open((char*)n, O_CREAT | O_TRUNC | O_RDWR, 0664) +#define Platform_openro(n, n__len) open((char*)n, O_RDONLY) +#define Platform_openrw(n, n__len) open((char*)n, O_RDWR) +#define Platform_readfile(fd, p, l) read(fd, (void*)(uintptr_t)(p), l) +#define Platform_rename(o, o__len, n, n__len) rename((char*)o, (char*)n) +#define Platform_sectotm(s) struct tm *time = localtime((time_t*)&s) +#define Platform_seekcur() SEEK_CUR +#define Platform_seekend() SEEK_END +#define Platform_seekset() SEEK_SET +#define Platform_sethandler(s, h) SystemSetHandler(s, (uintptr_t)h) +#define Platform_stat(n, n__len) stat((char*)n, &s) +#define Platform_statdev() (LONGINT)s.st_dev +#define Platform_statino() (LONGINT)s.st_ino +#define Platform_statmtime() (LONGINT)s.st_mtime +#define Platform_statsize() (LONGINT)s.st_size +#define Platform_structstats() struct stat s +#define Platform_system(str, str__len) system((char*)str) +#define Platform_tmhour() (LONGINT)time->tm_hour +#define Platform_tmmday() (LONGINT)time->tm_mday +#define Platform_tmmin() (LONGINT)time->tm_min +#define Platform_tmmon() (LONGINT)time->tm_mon +#define Platform_tmsec() (LONGINT)time->tm_sec +#define Platform_tmyear() (LONGINT)time->tm_year +#define Platform_tvsec() tv.tv_sec +#define Platform_tvusec() tv.tv_usec +#define Platform_unlink(n, n__len) unlink((char*)n) +#define Platform_writefile(fd, p, l) write(fd, (void*)(uintptr_t)(p), l) + +BOOLEAN Platform_TooManyFiles (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_EMFILE() || e == Platform_ENFILE(); + return _o_result; +} + +BOOLEAN Platform_NoSuchDirectory (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_ENOENT(); + return _o_result; +} + +BOOLEAN Platform_DifferentFilesystems (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_EXDEV(); + return _o_result; +} + +BOOLEAN Platform_Inaccessible (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = (e == Platform_EACCES() || e == Platform_EROFS()) || e == Platform_EAGAIN(); + return _o_result; +} + +BOOLEAN Platform_Absent (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_ENOENT(); + return _o_result; +} + +BOOLEAN Platform_TimedOut (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_ETIMEDOUT(); + return _o_result; +} + +BOOLEAN Platform_ConnectionFailed (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = ((e == Platform_ECONNREFUSED() || e == Platform_ECONNABORTED()) || e == Platform_ENETUNREACH()) || e == Platform_EHOSTUNREACH(); + return _o_result; +} + +LONGINT Platform_OSAllocate (LONGINT size) +{ + LONGINT _o_result; + _o_result = Platform_allocate(size); + return _o_result; +} + +void Platform_OSFree (LONGINT address) +{ + Platform_free(address); +} + +void Platform_Init (INTEGER argc, LONGINT argvadr) +{ + Platform_ArgVecPtr av = NIL; + Platform_MainStackFrame = argvadr; + Platform_ArgCount = argc; + av = (Platform_ArgVecPtr)(uintptr_t)argvadr; + Platform_ArgVector = (*av)[0]; + Platform_HaltCode = -128; + Platform_HeapInitHeap(); +} + +BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len) +{ + BOOLEAN _o_result; + Platform_EnvPtr p = NIL; + __DUP(var, var__len, CHAR); + p = Platform_getenv(var, var__len); + if (p != NIL) { + __COPY(*p, val, val__len); + } + _o_result = p != NIL; + __DEL(var); + return _o_result; +} + +void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len) +{ + __DUP(var, var__len, CHAR); + if (!Platform_getEnv(var, var__len, (void*)val, val__len)) { + val[0] = 0x00; + } + __DEL(var); +} + +void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len) +{ + Platform_ArgVec av = NIL; + if (n < Platform_ArgCount) { + av = (Platform_ArgVec)(uintptr_t)Platform_ArgVector; + __COPY(*(*av)[__X(n, ((LONGINT)(1024)))], val, val__len); + } +} + +void Platform_GetIntArg (INTEGER n, LONGINT *val) +{ + CHAR s[64]; + LONGINT k, d, i; + s[0] = 0x00; + Platform_GetArg(n, (void*)s, ((LONGINT)(64))); + i = 0; + if (s[0] == '-') { + i = 1; + } + k = 0; + d = (int)s[__X(i, ((LONGINT)(64)))] - 48; + while ((d >= 0 && d <= 9)) { + k = k * 10 + d; + i += 1; + d = (int)s[__X(i, ((LONGINT)(64)))] - 48; + } + if (s[0] == '-') { + k = -k; + i -= 1; + } + if (i > 0) { + *val = k; + } +} + +INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len) +{ + INTEGER _o_result; + INTEGER i; + CHAR arg[256]; + __DUP(s, s__len, CHAR); + i = 0; + Platform_GetArg(i, (void*)arg, ((LONGINT)(256))); + while ((i < Platform_ArgCount && __STRCMP(s, arg) != 0)) { + i += 1; + Platform_GetArg(i, (void*)arg, ((LONGINT)(256))); + } + _o_result = i; + __DEL(s); + return _o_result; +} + +void Platform_SetInterruptHandler (Platform_SignalHandler handler) +{ + Platform_sethandler(2, handler); +} + +void Platform_SetQuitHandler (Platform_SignalHandler handler) +{ + Platform_sethandler(3, handler); +} + +void Platform_SetBadInstructionHandler (Platform_SignalHandler handler) +{ + Platform_sethandler(4, handler); +} + +static void Platform_YMDHMStoClock (LONGINT ye, LONGINT mo, LONGINT da, LONGINT ho, LONGINT mi, LONGINT se, LONGINT *t, LONGINT *d) +{ + *d = (__ASHL(__MOD(ye, 100), 9) + __ASHL(mo + 1, 5)) + da; + *t = (__ASHL(ho, 12) + __ASHL(mi, 6)) + se; +} + +void Platform_GetClock (LONGINT *t, LONGINT *d) +{ + Platform_gettimeval(); + Platform_sectotm(Platform_tvsec()); + Platform_YMDHMStoClock(Platform_tmyear(), Platform_tmmon(), Platform_tmmday(), Platform_tmhour(), Platform_tmmin(), Platform_tmsec(), &*t, &*d); +} + +void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec) +{ + Platform_gettimeval(); + *sec = Platform_tvsec(); + *usec = Platform_tvusec(); +} + +LONGINT Platform_Time (void) +{ + LONGINT _o_result; + LONGINT ms; + Platform_gettimeval(); + ms = __DIVF(Platform_tvusec(), 1000) + Platform_tvsec() * 1000; + _o_result = __MOD(ms - Platform_TimeStart, 2147483647); + return _o_result; +} + +void Platform_Delay (LONGINT ms) +{ + LONGINT s, ns; + s = __DIV(ms, 1000); + ns = __MOD(ms, 1000) * 1000000; + Platform_nanosleep(s, ns); +} + +INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len) +{ + INTEGER _o_result; + __DUP(cmd, cmd__len, CHAR); + _o_result = Platform_system(cmd, cmd__len); + __DEL(cmd); + return _o_result; +} + +INTEGER Platform_Error (void) +{ + INTEGER _o_result; + _o_result = Platform_err(); + return _o_result; +} + +INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h) +{ + INTEGER _o_result; + INTEGER fd; + fd = Platform_openro(n, n__len); + if (fd < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + *h = fd; + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h) +{ + INTEGER _o_result; + INTEGER fd; + fd = Platform_openrw(n, n__len); + if (fd < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + *h = fd; + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h) +{ + INTEGER _o_result; + INTEGER fd; + fd = Platform_opennew(n, n__len); + if (fd < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + *h = fd; + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Close (LONGINT h) +{ + INTEGER _o_result; + if (Platform_closefile(h) < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ) +{ + INTEGER _o_result; + Platform_structstats(); + if (Platform_fstat(h) < 0) { + _o_result = Platform_err(); + return _o_result; + } + (*identity).volume = Platform_statdev(); + (*identity).index = Platform_statino(); + (*identity).mtime = Platform_statmtime(); + _o_result = 0; + return _o_result; +} + +INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ) +{ + INTEGER _o_result; + __DUP(n, n__len, CHAR); + Platform_structstats(); + if (Platform_stat(n, n__len) < 0) { + _o_result = Platform_err(); + __DEL(n); + return _o_result; + } + (*identity).volume = Platform_statdev(); + (*identity).index = Platform_statino(); + (*identity).mtime = Platform_statmtime(); + _o_result = 0; + __DEL(n); + return _o_result; +} + +BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2) +{ + BOOLEAN _o_result; + _o_result = (i1.index == i2.index && i1.volume == i2.volume); + return _o_result; +} + +BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2) +{ + BOOLEAN _o_result; + _o_result = i1.mtime == i2.mtime; + return _o_result; +} + +void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source) +{ + (*target).mtime = source.mtime; +} + +void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d) +{ + Platform_sectotm(i.mtime); + Platform_YMDHMStoClock(Platform_tmyear(), Platform_tmmon(), Platform_tmmday(), Platform_tmhour(), Platform_tmmin(), Platform_tmsec(), &*t, &*d); +} + +INTEGER Platform_Size (LONGINT h, LONGINT *l) +{ + INTEGER _o_result; + Platform_structstats(); + if (Platform_fstat(h) < 0) { + _o_result = Platform_err(); + return _o_result; + } + *l = Platform_statsize(); + _o_result = 0; + return _o_result; +} + +INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n) +{ + INTEGER _o_result; + *n = Platform_readfile(h, p, l); + if (*n < 0) { + *n = 0; + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n) +{ + INTEGER _o_result; + *n = Platform_readfile(h, (LONGINT)(uintptr_t)b, b__len); + if (*n < 0) { + *n = 0; + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l) +{ + INTEGER _o_result; + LONGINT written; + written = Platform_writefile(h, p, l); + if (written < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Sync (LONGINT h) +{ + INTEGER _o_result; + if (Platform_fsync(h) < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Seek (LONGINT h, LONGINT offset, INTEGER whence) +{ + INTEGER _o_result; + if (Platform_lseek(h, offset, whence) < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Truncate (LONGINT h, LONGINT l) +{ + INTEGER _o_result; + if (Platform_ftruncate(h, l) < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Unlink (CHAR *n, LONGINT n__len) +{ + INTEGER _o_result; + if (Platform_unlink(n, n__len) < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Chdir (CHAR *n, LONGINT n__len) +{ + INTEGER _o_result; + INTEGER r; + r = Platform_chdir(n, n__len); + Platform_getcwd((void*)Platform_CWD, ((LONGINT)(256))); + if (r < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len) +{ + INTEGER _o_result; + if (Platform_rename(o, o__len, n, n__len) < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +void Platform_Exit (INTEGER code) +{ + Platform_exit(code); +} + +static void Platform_errch (CHAR c) +{ + Platform_errc(c); +} + +static void Platform_errln (void) +{ + Platform_errch(0x0d); + Platform_errch(0x0a); +} + +static void Platform_errposint (LONGINT l) +{ + if (l > 10) { + Platform_errposint(__DIV(l, 10)); + } + Platform_errch((CHAR)(48 + __MOD(l, 10))); +} + +static void Platform_errint (LONGINT l) +{ + if (l < 0) { + Platform_errch('-'); + l = -l; + } + Platform_errposint(l); +} + +static void Platform_DisplayHaltCode (LONGINT code) +{ + switch (code) { + case -1: + Platform_errstring((CHAR*)"Assertion failure.", (LONGINT)19); + break; + case -2: + Platform_errstring((CHAR*)"Index out of range.", (LONGINT)20); + break; + case -3: + Platform_errstring((CHAR*)"Reached end of function without reaching RETURN.", (LONGINT)49); + break; + case -4: + Platform_errstring((CHAR*)"CASE statement: no matching label and no ELSE.", (LONGINT)47); + break; + case -5: + Platform_errstring((CHAR*)"Type guard failed.", (LONGINT)19); + break; + case -6: + Platform_errstring((CHAR*)"Implicit type guard in record assignment failed.", (LONGINT)49); + break; + case -7: + Platform_errstring((CHAR*)"Invalid case in WITH statement.", (LONGINT)32); + break; + case -8: + Platform_errstring((CHAR*)"Value out of range.", (LONGINT)20); + break; + case -9: + Platform_errstring((CHAR*)"Heap interrupted while locked, but lockdepth = 0 at unlock.", (LONGINT)60); + break; + case -10: + Platform_errstring((CHAR*)"NIL access.", (LONGINT)12); + break; + case -11: + Platform_errstring((CHAR*)"Alignment error.", (LONGINT)17); + break; + case -12: + Platform_errstring((CHAR*)"Divide by zero.", (LONGINT)16); + break; + case -13: + Platform_errstring((CHAR*)"Arithmetic overflow/underflow.", (LONGINT)31); + break; + case -14: + Platform_errstring((CHAR*)"Invalid function argument.", (LONGINT)27); + break; + case -15: + Platform_errstring((CHAR*)"Internal error, e.g. Type descriptor size mismatch.", (LONGINT)52); + break; + case -20: + Platform_errstring((CHAR*)"Too many, or negative number of, elements in dynamic array.", (LONGINT)60); + break; + default: + break; + } +} + +void Platform_Halt (LONGINT code) +{ + INTEGER e; + Platform_HaltCode = code; + if (Platform_HaltHandler != NIL) { + (*Platform_HaltHandler)(code); + } + Platform_errstring((CHAR*)"Terminated by Halt(", (LONGINT)20); + Platform_errint(code); + Platform_errstring((CHAR*)"). ", (LONGINT)4); + if (code < 0) { + Platform_DisplayHaltCode(code); + } + Platform_errln(); + Platform_exit(__VAL(INTEGER, code)); +} + +void Platform_AssertFail (LONGINT code) +{ + INTEGER e; + Platform_errstring((CHAR*)"Assertion failure.", (LONGINT)19); + if (code != 0) { + Platform_errstring((CHAR*)" ASSERT code ", (LONGINT)14); + Platform_errint(code); + Platform_errstring((CHAR*)".", (LONGINT)2); + } + Platform_errln(); + Platform_exit(__VAL(INTEGER, code)); +} + +void Platform_SetHalt (Platform_HaltProcedure p) +{ + Platform_HaltHandler = p; +} + +static void Platform_TestLittleEndian (void) +{ + INTEGER i; + i = 1; + __GET((LONGINT)(uintptr_t)&i, Platform_LittleEndian, BOOLEAN); +} + +__TDESC(Platform_FileIdentity, 1, 0) = {__TDFLDS("FileIdentity", 12), {-4}}; + +export void *Platform__init(void) +{ + __DEFMOD; + __REGMOD("Platform", 0); + __INITYP(Platform_FileIdentity, Platform_FileIdentity, 0); +/* BEGIN */ + Platform_TestLittleEndian(); + Platform_HaltCode = -128; + Platform_HaltHandler = NIL; + Platform_TimeStart = Platform_Time(); + Platform_CWD[0] = 0x00; + Platform_getcwd((void*)Platform_CWD, ((LONGINT)(256))); + Platform_PID = Platform_getpid(); + Platform_SeekSet = Platform_seekset(); + Platform_SeekCur = Platform_seekcur(); + Platform_SeekEnd = Platform_seekend(); + Platform_nl[0] = 0x0a; + Platform_nl[1] = 0x00; + __ENDMOD; +} diff --git a/bootstrap/unix-44/Platform.h b/bootstrap/unix-44/Platform.h new file mode 100644 index 00000000..8b47d1c9 --- /dev/null +++ b/bootstrap/unix-44/Platform.h @@ -0,0 +1,82 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Platform__h +#define Platform__h + +#include "SYSTEM.h" + +typedef + struct Platform_FileIdentity { + LONGINT volume, index, mtime; + } Platform_FileIdentity; + +typedef + void (*Platform_HaltProcedure)(LONGINT); + +typedef + void (*Platform_SignalHandler)(INTEGER); + + +import BOOLEAN Platform_LittleEndian; +import LONGINT Platform_MainStackFrame, Platform_HaltCode; +import INTEGER Platform_PID; +import CHAR Platform_CWD[256]; +import INTEGER Platform_ArgCount; +import LONGINT Platform_ArgVector; +import INTEGER Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd; +import CHAR Platform_nl[3]; + +import LONGINT *Platform_FileIdentity__typ; + +import BOOLEAN Platform_Absent (INTEGER e); +import INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len); +import void Platform_AssertFail (LONGINT code); +import INTEGER Platform_Chdir (CHAR *n, LONGINT n__len); +import INTEGER Platform_Close (LONGINT h); +import BOOLEAN Platform_ConnectionFailed (INTEGER e); +import void Platform_Delay (LONGINT ms); +import BOOLEAN Platform_DifferentFilesystems (INTEGER e); +import INTEGER Platform_Error (void); +import void Platform_Exit (INTEGER code); +import void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len); +import void Platform_GetClock (LONGINT *t, LONGINT *d); +import void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len); +import void Platform_GetIntArg (INTEGER n, LONGINT *val); +import void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec); +import void Platform_Halt (LONGINT code); +import INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ); +import INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ); +import BOOLEAN Platform_Inaccessible (INTEGER e); +import void Platform_Init (INTEGER argc, LONGINT argvadr); +import void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d); +import INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h); +import BOOLEAN Platform_NoSuchDirectory (INTEGER e); +import LONGINT Platform_OSAllocate (LONGINT size); +import void Platform_OSFree (LONGINT address); +import INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h); +import INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h); +import INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n); +import INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n); +import INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len); +import BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2); +import BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2); +import INTEGER Platform_Seek (LONGINT h, LONGINT offset, INTEGER whence); +import void Platform_SetBadInstructionHandler (Platform_SignalHandler handler); +import void Platform_SetHalt (Platform_HaltProcedure p); +import void Platform_SetInterruptHandler (Platform_SignalHandler handler); +import void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source); +import void Platform_SetQuitHandler (Platform_SignalHandler handler); +import INTEGER Platform_Size (LONGINT h, LONGINT *l); +import INTEGER Platform_Sync (LONGINT h); +import INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len); +import LONGINT Platform_Time (void); +import BOOLEAN Platform_TimedOut (INTEGER e); +import BOOLEAN Platform_TooManyFiles (INTEGER e); +import INTEGER Platform_Truncate (LONGINT h, LONGINT l); +import INTEGER Platform_Unlink (CHAR *n, LONGINT n__len); +import INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l); +import BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len); +import void *Platform__init(void); + + +#endif diff --git a/bootstrap/unix-44/Reals.c b/bootstrap/unix-44/Reals.c new file mode 100644 index 00000000..65dad750 --- /dev/null +++ b/bootstrap/unix-44/Reals.c @@ -0,0 +1,155 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" + + + + +export void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len); +export void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len); +export void Reals_ConvertHL (LONGREAL y, CHAR *d, LONGINT d__len); +export void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len); +export INTEGER Reals_Expo (REAL x); +export INTEGER Reals_ExpoL (LONGREAL x); +export REAL Reals_Ten (INTEGER e); +export LONGREAL Reals_TenL (INTEGER e); +static CHAR Reals_ToHex (INTEGER i); + + +REAL Reals_Ten (INTEGER e) +{ + REAL _o_result; + LONGREAL r, power; + r = (LONGREAL)1; + power = (LONGREAL)10; + while (e > 0) { + if (__ODD(e)) { + r = r * power; + } + power = power * power; + e = __ASHR(e, 1); + } + _o_result = r; + return _o_result; +} + +LONGREAL Reals_TenL (INTEGER e) +{ + LONGREAL _o_result; + LONGREAL r, power; + r = (LONGREAL)1; + power = (LONGREAL)10; + for (;;) { + if (__ODD(e)) { + r = r * power; + } + e = __ASHR(e, 1); + if (e <= 0) { + _o_result = r; + return _o_result; + } + power = power * power; + } + __RETCHK; +} + +INTEGER Reals_Expo (REAL x) +{ + INTEGER _o_result; + _o_result = (int)__MASK(__ASHR((LONGINT)(__VAL(INTEGER, x)), 23), -256); + return _o_result; +} + +INTEGER Reals_ExpoL (LONGREAL x) +{ + INTEGER _o_result; + INTEGER i; + LONGINT l; + __GET((LONGINT)(uintptr_t)&x + 4, l, LONGINT); + _o_result = (int)__MASK(__ASHR(l, 20), -2048); + return _o_result; +} + +void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len) +{ + LONGINT i, j, k; + if (x < (LONGREAL)0) { + x = -x; + } + k = 0; + if (n > 9) { + i = __ENTIER(x / (LONGREAL)(LONGREAL)1000000000); + j = __ENTIER(x - i * (LONGREAL)1000000000); + if (j < 0) { + j = 0; + } + while (k < 9) { + d[__X(k, d__len)] = (CHAR)(__MOD(j, 10) + 48); + j = __DIV(j, 10); + k += 1; + } + } else { + i = __ENTIER(x); + } + while (k < (LONGINT)n) { + d[__X(k, d__len)] = (CHAR)(__MOD(i, 10) + 48); + i = __DIV(i, 10); + k += 1; + } +} + +void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len) +{ + Reals_ConvertL(x, n, (void*)d, d__len); +} + +static CHAR Reals_ToHex (INTEGER i) +{ + CHAR _o_result; + if (i < 10) { + _o_result = (CHAR)(i + 48); + return _o_result; + } else { + _o_result = (CHAR)(i + 55); + return _o_result; + } + __RETCHK; +} + +typedef + CHAR (*pc4__3)[4]; + +void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len) +{ + pc4__3 p = NIL; + INTEGER i; + p = (pc4__3)(uintptr_t)((LONGINT)(uintptr_t)&y); + i = 0; + while (i < 4) { + d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((int)(*p)[__X(i, ((LONGINT)(4)))], 4)); + d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((int)(*p)[__X(i, ((LONGINT)(4)))], -16)); + } +} + +typedef + CHAR (*pc8__5)[8]; + +void Reals_ConvertHL (LONGREAL y, CHAR *d, LONGINT d__len) +{ + pc8__5 p = NIL; + INTEGER i; + p = (pc8__5)(uintptr_t)((LONGINT)(uintptr_t)&y); + i = 0; + while (i < 8) { + d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((int)(*p)[__X(i, ((LONGINT)(8)))], 4)); + d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((int)(*p)[__X(i, ((LONGINT)(8)))], -16)); + } +} + + +export void *Reals__init(void) +{ + __DEFMOD; + __REGMOD("Reals", 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-44/Reals.h b/bootstrap/unix-44/Reals.h new file mode 100644 index 00000000..166e977b --- /dev/null +++ b/bootstrap/unix-44/Reals.h @@ -0,0 +1,22 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Reals__h +#define Reals__h + +#include "SYSTEM.h" + + + + +import void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len); +import void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len); +import void Reals_ConvertHL (LONGREAL y, CHAR *d, LONGINT d__len); +import void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len); +import INTEGER Reals_Expo (REAL x); +import INTEGER Reals_ExpoL (LONGREAL x); +import REAL Reals_Ten (INTEGER e); +import LONGREAL Reals_TenL (INTEGER e); +import void *Reals__init(void); + + +#endif diff --git a/bootstrap/unix-44/SYSTEM.c b/bootstrap/unix-44/SYSTEM.c new file mode 100644 index 00000000..0fcc5ee2 --- /dev/null +++ b/bootstrap/unix-44/SYSTEM.c @@ -0,0 +1,207 @@ +/* +* The body prefix file of the voc(jet backend) runtime system, Version 1.0 +* +* Copyright (c) Software Templ, 1994, 1995 +* +* Module SYSTEM is subject to change any time without prior notification. +* Software Templ disclaims all warranties with regard to module SYSTEM, +* in particular shall Software Templ not be liable for any damage resulting +* from inappropriate use or modification of module SYSTEM. +* +* Version 1.1 jt, 24.11.95 fixes for correct pointer arithmetic on Cray computers +* jt 31.1.2007 ANSI prototypes for malloc and exit in order to avoid cc warnings +* +*/ + +#include "SYSTEM.h" +#include "stdarg.h" +#include + + +LONGINT SYSTEM_XCHK(LONGINT i, LONGINT ub) {return __X(i, ub);} +LONGINT SYSTEM_RCHK(LONGINT i, LONGINT ub) {return __R(i, ub);} +LONGINT SYSTEM_ASH (LONGINT i, LONGINT n) {return __ASH(i, n);} +LONGINT SYSTEM_ABS (LONGINT i) {return __ABS(i);} +double SYSTEM_ABSD(double i) {return __ABS(i);} + +void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0) +{ + t -= __TPROC0OFF; + t0 -= __TPROC0OFF; + while (*t0 != __EOM) {*t = *t0; t--; t0--;} +} + + +void SYSTEM_ENUMP(void *adr, LONGINT n, void (*P)()) +{ + while (n > 0) { + P((LONGINT)(uintptr_t)(*((void**)(adr)))); + adr = ((void**)adr) + 1; + n--; + } +} + +void SYSTEM_ENUMR(void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)()) +{ + LONGINT *t, off; + typ++; + while (n > 0) { + t = typ; + off = *t; + while (off >= 0) {P(*(LONGINT*)((char*)adr+off)); t++; off = *t;} + adr = ((char*)adr) + size; + n--; + } +} + +LONGINT SYSTEM_DIV(unsigned LONGINT x, unsigned LONGINT y) +{ if ((LONGINT) x >= 0) return (x / y); + else return -((y - 1 - x) / y); +} + +LONGINT SYSTEM_MOD(unsigned LONGINT x, unsigned LONGINT y) +{ unsigned LONGINT m; + if ((LONGINT) x >= 0) return (x % y); + else { m = (-x) % y; + if (m != 0) return (y - m); else return 0; + } +} + +LONGINT SYSTEM_ENTIER(double x) +{ + LONGINT y; + if (x >= 0) + return (LONGINT)x; + else { + y = (LONGINT)x; + if (y <= x) return y; else return y - 1; + } +} + +extern void Heap_Lock(); +extern void Heap_Unlock(); + +SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim, int nofdyn, ...) +{ + LONGINT nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off; + va_list ap; + va_start(ap, nofdyn); + nofelems = 1; + while (nofdim > 0) { + nofelems = nofelems * va_arg(ap, LONGINT); nofdim--; + if (nofelems <= 0) __HALT(-20); + } + va_end(ap); + dataoff = nofdyn * sizeof(LONGINT); + if (elemalgn > sizeof(LONGINT)) { + n = dataoff % elemalgn; + if (n != 0) dataoff += elemalgn - n; + } + size = dataoff + nofelems * elemsz; + Heap_Lock(); + if (typ == NIL) { + /* element typ does not contain pointers */ + x = Heap_NEWBLK(size); + } + else if (typ == (LONGINT*)POINTER__typ) { + /* element type is a pointer */ + x = Heap_NEWBLK(size + nofelems * sizeof(LONGINT)); + p = (LONGINT*)(uintptr_t)x[-1]; + p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ + p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */ + while (n <= nofelems) {*p = n*sizeof(LONGINT); p++; n++;} + *p = - (nofelems + 1) * sizeof(LONGINT); /* sentinel */ + x[-1] -= nofelems * sizeof(LONGINT); + } + else { + /* element type is a record that contains pointers */ + ptab = typ + 1; nofptrs = 0; + while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */ + nptr = nofelems * nofptrs; /* total number of pointers */ + x = Heap_NEWBLK(size + nptr * sizeof(LONGINT)); + p = (LONGINT*)(uintptr_t)x[- 1]; + p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ + p -= nptr - 1; n = 0; off = dataoff; + while (n < nofelems) {i = 0; + while (i < nofptrs) {*p = off + ptab[i]; p++; i++;} + off += elemsz; n++; + } + *p = - (nptr + 1) * sizeof(LONGINT); /* sentinel */ + x[-1] -= nptr * sizeof(LONGINT); + } + if (nofdyn != 0) { + /* setup len vector for index checks */ + va_start(ap, nofdyn); + p = x; + while (nofdyn > 0) {*p = va_arg(ap, LONGINT); p++, nofdyn--;} + va_end(ap); + } + Heap_Unlock(); + return x; +} + + + + +typedef void (*SystemSignalHandler)(INTEGER); // = Platform_SignalHandler + +#ifndef _WIN32 + + SystemSignalHandler handler[3] = {0}; + + // Provide signal handling for Unix based systems + void signalHandler(int s) { + if (s >= 2 && s <= 4) handler[s-2](s); + // (Ignore other signals) + } + + void SystemSetHandler(int s, uintptr_t h) { + if (s >= 2 && s <= 4) { + int needtosetsystemhandler = handler[s-2] == 0; + handler[s-2] = (SystemSignalHandler)h; + if (needtosetsystemhandler) {signal(s, signalHandler);} + } + } + +#else + + // Provides Windows callback handlers for signal-like scenarios + #include "WindowsWrapper.h" + + SystemSignalHandler SystemInterruptHandler = 0; + SystemSignalHandler SystemQuitHandler = 0; + BOOL ConsoleCtrlHandlerSet = FALSE; + + BOOL WINAPI SystemConsoleCtrlHandler(DWORD ctrlType) { + if ((ctrlType == CTRL_C_EVENT) || (ctrlType == CTRL_BREAK_EVENT)) { + if (SystemInterruptHandler) { + SystemInterruptHandler(2); // SIGINT + return TRUE; + } + } else { // Close, logoff or shutdown + if (SystemQuitHandler) { + SystemQuitHandler(3); // SIGQUIT + return TRUE; + } + } + return FALSE; + } + + void EnsureConsoleCtrlHandler() { + if (!ConsoleCtrlHandlerSet) { + SetConsoleCtrlHandler(SystemConsoleCtrlHandler, TRUE); + ConsoleCtrlHandlerSet = TRUE; + } + } + + void SystemSetInterruptHandler(uintptr_t h) { + EnsureConsoleCtrlHandler(); + SystemInterruptHandler = (SystemSignalHandler)h; + } + + void SystemSetQuitHandler(uintptr_t h) { + EnsureConsoleCtrlHandler(); + SystemQuitHandler = (SystemSignalHandler)h; + } + +#endif diff --git a/bootstrap/unix-44/SYSTEM.h b/bootstrap/unix-44/SYSTEM.h new file mode 100644 index 00000000..f9e2f930 --- /dev/null +++ b/bootstrap/unix-44/SYSTEM.h @@ -0,0 +1,275 @@ +#ifndef SYSTEM__h +#define SYSTEM__h + +#ifndef _WIN32 + + // Building for a Unix/Linux based system + #include // For memcpy ... + #include // For uintptr_t ... + +#else + + // Building for Windows platform with either mingw under cygwin, or the MS C compiler + #ifdef _WIN64 + typedef unsigned long long size_t; + typedef unsigned long long uintptr_t; + #else + typedef unsigned int size_t; + typedef unsigned int uintptr_t; + #endif /* _WIN64 */ + + typedef unsigned int uint32_t; + void * __cdecl memcpy(void * dest, const void * source, size_t size); + +#endif + + +// The compiler uses 'import' and 'export' which translate to 'extern' and +// nothing respectively. + +#define import extern +#define export + + + +// Known constants + +#define NIL ((void*)0) +#define __MAXEXT 16 +#define POINTER__typ ((LONGINT*)(1)) // not NIL and not a valid type + + +// Oberon types + +#define BOOLEAN char +#define SYSTEM_BYTE unsigned char +#define CHAR unsigned char +#define SHORTINT signed char +#define REAL float +#define LONGREAL double +#define SYSTEM_PTR void* + +// For 32 bit builds, the size of LONGINT depends on a make option: + +#if (__SIZEOF_POINTER__ == 8) || defined(LARGE) || defined(_WIN64) + #define INTEGER int // INTEGER is 32 bit. + #define LONGINT long long // LONGINT is 64 bit. (long long is always 64 bits, while long can be 32 bits e.g. under MSC/MingW) +#else + #define INTEGER short int // INTEGER is 16 bit. + #define LONGINT long // LONGINT is 32 bit. +#endif + +#define SET unsigned LONGINT + + +// OS Memory allocation interfaces are in PlatformXXX.Mod + +extern LONGINT Platform_OSAllocate (LONGINT size); +extern void Platform_OSFree (LONGINT addr); + + +// Run time system routines in SYSTEM.c + +extern LONGINT SYSTEM_XCHK (LONGINT i, LONGINT ub); +extern LONGINT SYSTEM_RCHK (LONGINT i, LONGINT ub); +extern LONGINT SYSTEM_ASH (LONGINT i, LONGINT n); +extern LONGINT SYSTEM_ABS (LONGINT i); +extern double SYSTEM_ABSD (double i); +extern void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0); +extern void SYSTEM_ENUMP (void *adr, LONGINT n, void (*P)()); +extern void SYSTEM_ENUMR (void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)()); +extern LONGINT SYSTEM_DIV (unsigned LONGINT x, unsigned LONGINT y); +extern LONGINT SYSTEM_MOD (unsigned LONGINT x, unsigned LONGINT y); +extern LONGINT SYSTEM_ENTIER (double x); + + +// Signal handling in SYSTEM.c + +#ifndef _WIN32 + extern void SystemSetHandler(int s, uintptr_t h); +#else + extern void SystemSetInterruptHandler(uintptr_t h); + extern void SystemSetQuitHandler (uintptr_t h); +#endif + + + +// String comparison + +static int __str_cmp(CHAR *x, CHAR *y){ + LONGINT i = 0; + CHAR ch1, ch2; + do {ch1 = x[i]; ch2 = y[i]; i++; + if (!ch1) return -(int)ch2; + } while (ch1==ch2); + return (int)ch1 - (int)ch2; +} +#define __STRCMP(a,b) __str_cmp((CHAR*)(a), (CHAR*)(b)) + + + +// Inline string, record and array copy + +#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d; LONGINT _i=0,_t=n-1; \ + while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;} +#define __DUP(x, l, t) x=(void*)memcpy((void*)(uintptr_t)Platform_OSAllocate(l*sizeof(t)),x,l*sizeof(t)) +#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t)) +#define __DEL(x) Platform_OSFree((LONGINT)(uintptr_t)x) + + + + +/* SYSTEM ops */ + +#define __VAL(t, x) ((t)(x)) +#define __VALP(t, x) ((t)(uintptr_t)(x)) + +#define __GET(a, x, t) x= *(t*)(uintptr_t)(a) +#define __PUT(a, x, t) *(t*)(uintptr_t)(a)=x +#define __LSHL(x, n, t) ((t)((unsigned t)(x)<<(n))) +#define __LSHR(x, n, t) ((t)((unsigned t)(x)>>(n))) +#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) +#define __ROTL(x, n, t) ((t)((unsigned t)(x)<<(n)|(unsigned t)(x)>>(8*sizeof(t)-(n)))) +#define __ROTR(x, n, t) ((t)((unsigned t)(x)>>(n)|(unsigned t)(x)<<(8*sizeof(t)-(n)))) +#define __LSHR(x, n, t) ((t)((unsigned t)(x)>>(n))) +#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) +#define __ROTL(x, n, t) ((t)((unsigned t)(x)<<(n)|(unsigned t)(x)>>(8*sizeof(t)-(n)))) +#define __ROTR(x, n, t) ((t)((unsigned t)(x)>>(n)|(unsigned t)(x)<<(8*sizeof(t)-(n)))) +#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t)) +#define __BIT(x, n) (*(unsigned LONGINT*)(x)>>(n)&1) +#define __MOVE(s, d, n) memcpy((char*)(uintptr_t)(d),(char*)(uintptr_t)(s),n) +#define __ASHL(x, n) ((LONGINT)(x)<<(n)) +#define __ASHR(x, n) ((LONGINT)(x)>>(n)) +#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n))) +#define __ASHF(x, n) SYSTEM_ASH((LONGINT)(x), (LONGINT)(n)) +#define __SHORT(x, y) ((int)((unsigned LONGINT)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0))) +#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y))) +#define __CHR(x) ((CHAR)__R(x, 256)) +#define __CHRF(x) ((CHAR)__RF(x, 256)) +#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y))) +#define __DIVF(x, y) SYSTEM_DIV((LONGINT)(x),(LONGINT)(y)) +#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y)) +#define __MODF(x, y) SYSTEM_MOD((LONGINT)(x),(LONGINT)(y)) +#define __ENTIER(x) SYSTEM_ENTIER(x) +#define __ABS(x) (((x)<0)?-(x):(x)) +#define __ABSF(x) SYSTEM_ABS((LONGINT)(x)) +#define __ABSFD(x) SYSTEM_ABSD((double)(x)) +#define __CAP(ch) ((CHAR)((ch)&0x5f)) +#define __ODD(x) ((x)&1) +#define __IN(x, s) (((s)>>(x))&1) +#define __SETOF(x) ((SET)1<<(x)) +#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h))) +#define __MASK(x, m) ((x)&~(m)) + + + +// Runtime checks + +#define __X(i, ub) (((unsigned LONGINT)(i)<(unsigned LONGINT)(ub))?i:(__HALT(-2),0)) +#define __XF(i, ub) SYSTEM_XCHK((LONGINT)(i), (LONGINT)(ub)) +#define __R(i, ub) (((unsigned LONGINT)(i)<(unsigned LONGINT)(ub))?i:(__HALT(-8),0)) +#define __RF(i, ub) SYSTEM_RCHK((LONGINT)(i),(LONGINT)(ub)) +#define __RETCHK __retchk: __HALT(-3); return 0; +#define __CASECHK __HALT(-4) +#define __WITHCHK __HALT(-7) + +#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p))) +#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r)))) +#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p))) +#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p) +#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p) + + + +// Module entry/registration/exit + +extern void Heap_REGCMD(); +extern SYSTEM_PTR Heap_REGMOD(); +extern void Heap_REGTYP(); +extern void Heap_INCREF(); + +#define __DEFMOD static void *m; if (m!=0) {return m;} +#define __REGCMD(name, cmd) Heap_REGCMD(m, (CHAR*)name, cmd) +#define __REGMOD(name, enum) if (m==0) {m = Heap_REGMOD((CHAR*)name,enum);} +#define __ENDMOD return m +#define __MODULE_IMPORT(name) Heap_INCREF(name##__init()) + + + +// Main module initialisation, registration and finalisation + +extern void Platform_Init(INTEGER argc, LONGINT argv); +extern void *Platform_MainModule; +extern void Heap_FINALL(); + +#define __INIT(argc, argv) static void *m; Platform_Init((INTEGER)argc, (LONGINT)(uintptr_t)&argv); +#define __REGMAIN(name, enum) m = Heap_REGMOD((CHAR*)name,enum) +#define __FINI Heap_FINALL(); return 0 + + +// Assertions and Halts + +extern void Platform_Halt(LONGINT x); +extern void Platform_AssertFail(LONGINT x); + +#define __HALT(x) Platform_Halt(x) +#define __ASSERT(cond, x) if (!(cond)) Platform_AssertFail((LONGINT)(x)) + + +// Memory allocation + +extern SYSTEM_PTR Heap_NEWBLK (LONGINT size); +extern SYSTEM_PTR Heap_NEWREC (LONGINT tag); +extern SYSTEM_PTR SYSTEM_NEWARR(LONGINT*, LONGINT, int, int, int, ...); + +#define __SYSNEW(p, len) p = Heap_NEWBLK((LONGINT)(len)) +#define __NEW(p, t) p = Heap_NEWREC((LONGINT)(uintptr_t)t##__typ) +#define __NEWARR SYSTEM_NEWARR + + + +/* Type handling */ + +#define __TDESC(t, m, n) \ + static struct t##__desc { \ + LONGINT tproc[m]; /* Proc for each ptr field */ \ + LONGINT tag; \ + LONGINT next; /* Module table type list points here */ \ + LONGINT level; \ + LONGINT module; \ + char name[24]; \ + LONGINT basep[__MAXEXT]; /* List of bases this extends */ \ + LONGINT reserved; \ + LONGINT blksz; /* xxx_typ points here */ \ + LONGINT ptr[n+1]; /* Offsets of ptrs up to -ve sentinel */ \ + } t##__desc + +#define __BASEOFF (__MAXEXT+1) // blksz as index to base. +#define __TPROC0OFF (__BASEOFF+24/sizeof(LONGINT)+5) // blksz as index to tproc IFF m=1. +#define __EOM 1 +#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size +#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (LONGINT)(n), P) +#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (LONGINT)(size), (LONGINT)(n), P) + +#define __INITYP(t, t0, level) \ + t##__typ = (LONGINT*)&t##__desc.blksz; \ + memcpy(t##__desc.basep, t0##__typ - __BASEOFF, level*sizeof(LONGINT)); \ + t##__desc.basep[level] = (LONGINT)(uintptr_t)t##__typ; \ + t##__desc.module = (LONGINT)(uintptr_t)m; \ + if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \ + t##__desc.blksz = (t##__desc.blksz+5*sizeof(LONGINT)-1)/(4*sizeof(LONGINT))*(4*sizeof(LONGINT)); \ + Heap_REGTYP(m, (LONGINT)(uintptr_t)&t##__desc.next); \ + SYSTEM_INHERIT(t##__typ, t0##__typ) + +#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(LONGINT)(uintptr_t)typ##__typ) +#define __TYPEOF(p) ((LONGINT*)(uintptr_t)(*(((LONGINT*)(p))-1))) +#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level) + +// Oberon-2 type bound procedures support +#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(LONGINT)(uintptr_t)proc +#define __SEND(typ, num, funtyp, parlist) ((funtyp)((uintptr_t)*(typ-(__TPROC0OFF+num))))parlist + + + + +#endif diff --git a/bootstrap/unix-44/Strings.c b/bootstrap/unix-44/Strings.c new file mode 100644 index 00000000..5038ca68 --- /dev/null +++ b/bootstrap/unix-44/Strings.c @@ -0,0 +1,243 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" + + + + +export void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len); +export void Strings_Cap (CHAR *s, LONGINT s__len); +export void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n); +export void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len); +export void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len); +export INTEGER Strings_Length (CHAR *s, LONGINT s__len); +export BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len); +export INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos); +export void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len); + + +INTEGER Strings_Length (CHAR *s, LONGINT s__len) +{ + INTEGER _o_result; + INTEGER i; + __DUP(s, s__len, CHAR); + i = 0; + while (((LONGINT)i < s__len && s[__X(i, s__len)] != 0x00)) { + i += 1; + } + _o_result = i; + __DEL(s); + return _o_result; +} + +void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len) +{ + INTEGER n1, n2, i; + __DUP(extra, extra__len, CHAR); + n1 = Strings_Length(dest, dest__len); + n2 = Strings_Length(extra, extra__len); + i = 0; + while ((i < n2 && (LONGINT)(i + n1) < dest__len)) { + dest[__X(i + n1, dest__len)] = extra[__X(i, extra__len)]; + i += 1; + } + if ((LONGINT)(i + n1) < dest__len) { + dest[__X(i + n1, dest__len)] = 0x00; + } + __DEL(extra); +} + +void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len) +{ + INTEGER n1, n2, i; + __DUP(source, source__len, CHAR); + n1 = Strings_Length(dest, dest__len); + n2 = Strings_Length(source, source__len); + if (pos < 0) { + pos = 0; + } + if (pos > n1) { + Strings_Append(dest, dest__len, (void*)source, source__len); + return; + } + if ((LONGINT)(pos + n2) < dest__len) { + i = n1; + while (i >= pos) { + if ((LONGINT)(i + n2) < dest__len) { + dest[__X(i + n2, dest__len)] = dest[__X(i, dest__len)]; + } + i -= 1; + } + } + i = 0; + while (i < n2) { + dest[__X(pos + i, dest__len)] = source[__X(i, source__len)]; + i += 1; + } + __DEL(source); +} + +void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n) +{ + INTEGER len, i; + len = Strings_Length(s, s__len); + if (pos < 0) { + pos = 0; + } else if (pos >= len) { + return; + } + if (pos + n < len) { + i = pos + n; + while (i < len) { + s[__X(i - n, s__len)] = s[__X(i, s__len)]; + i += 1; + } + if ((LONGINT)(i - n) < s__len) { + s[__X(i - n, s__len)] = 0x00; + } + } else { + s[__X(pos, s__len)] = 0x00; + } +} + +void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len) +{ + __DUP(source, source__len, CHAR); + Strings_Delete((void*)dest, dest__len, pos, pos + Strings_Length(source, source__len)); + Strings_Insert(source, source__len, pos, (void*)dest, dest__len); + __DEL(source); +} + +void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len) +{ + INTEGER len, destLen, i; + __DUP(source, source__len, CHAR); + len = Strings_Length(source, source__len); + destLen = (int)dest__len - 1; + if (pos < 0) { + pos = 0; + } + if (pos >= len) { + dest[0] = 0x00; + return; + } + i = 0; + while (((((LONGINT)(pos + i) <= source__len && source[__X(pos + i, source__len)] != 0x00)) && i < n)) { + if (i < destLen) { + dest[__X(i, dest__len)] = source[__X(pos + i, source__len)]; + } + i += 1; + } + dest[__X(i, dest__len)] = 0x00; + __DEL(source); +} + +INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos) +{ + INTEGER _o_result; + INTEGER n1, n2, i, j; + __DUP(pattern, pattern__len, CHAR); + __DUP(s, s__len, CHAR); + n1 = Strings_Length(s, s__len); + n2 = Strings_Length(pattern, pattern__len); + if (n2 == 0) { + _o_result = 0; + __DEL(pattern); + __DEL(s); + return _o_result; + } + i = pos; + while (i <= n1 - n2) { + if (s[__X(i, s__len)] == pattern[0]) { + j = 1; + while ((j < n2 && s[__X(i + j, s__len)] == pattern[__X(j, pattern__len)])) { + j += 1; + } + if (j == n2) { + _o_result = i; + __DEL(pattern); + __DEL(s); + return _o_result; + } + } + i += 1; + } + _o_result = -1; + __DEL(pattern); + __DEL(s); + return _o_result; +} + +void Strings_Cap (CHAR *s, LONGINT s__len) +{ + INTEGER i; + i = 0; + while (s[__X(i, s__len)] != 0x00) { + if (('a' <= s[__X(i, s__len)] && s[__X(i, s__len)] <= 'z')) { + s[__X(i, s__len)] = __CAP(s[__X(i, s__len)]); + } + i += 1; + } +} + +static struct Match__7 { + struct Match__7 *lnk; +} *Match__7_s; + +static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INTEGER n, INTEGER m); + +static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INTEGER n, INTEGER m) +{ + BOOLEAN _o_result; + while ((((n >= 0 && m >= 0)) && mask[__X(m, mask__len)] != '*')) { + if (name[__X(n, name__len)] != mask[__X(m, mask__len)]) { + _o_result = 0; + return _o_result; + } + n -= 1; + m -= 1; + } + if (m < 0) { + _o_result = n < 0; + return _o_result; + } + while ((m >= 0 && mask[__X(m, mask__len)] == '*')) { + m -= 1; + } + if (m < 0) { + _o_result = 1; + return _o_result; + } + while (n >= 0) { + if (M__8(name, name__len, mask, mask__len, n, m)) { + _o_result = 1; + return _o_result; + } + n -= 1; + } + _o_result = 0; + return _o_result; +} + +BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len) +{ + BOOLEAN _o_result; + struct Match__7 _s; + __DUP(string, string__len, CHAR); + __DUP(pattern, pattern__len, CHAR); + _s.lnk = Match__7_s; + Match__7_s = &_s; + _o_result = M__8((void*)string, string__len, (void*)pattern, pattern__len, Strings_Length(string, string__len) - 1, Strings_Length(pattern, pattern__len) - 1); + Match__7_s = _s.lnk; + __DEL(string); + __DEL(pattern); + return _o_result; +} + + +export void *Strings__init(void) +{ + __DEFMOD; + __REGMOD("Strings", 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-44/Strings.h b/bootstrap/unix-44/Strings.h new file mode 100644 index 00000000..a8d8d207 --- /dev/null +++ b/bootstrap/unix-44/Strings.h @@ -0,0 +1,23 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Strings__h +#define Strings__h + +#include "SYSTEM.h" + + + + +import void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len); +import void Strings_Cap (CHAR *s, LONGINT s__len); +import void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n); +import void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len); +import void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len); +import INTEGER Strings_Length (CHAR *s, LONGINT s__len); +import BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len); +import INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos); +import void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len); +import void *Strings__init(void); + + +#endif diff --git a/bootstrap/unix-44/Texts.c b/bootstrap/unix-44/Texts.c new file mode 100644 index 00000000..1e81c3df --- /dev/null +++ b/bootstrap/unix-44/Texts.c @@ -0,0 +1,1838 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "Files.h" +#include "Modules.h" +#include "Reals.h" + +typedef + struct Texts_RunDesc *Texts_Run; + +typedef + struct Texts_FontDesc *Texts_FontsFont; + +typedef + struct Texts_RunDesc { + Texts_Run prev, next; + LONGINT len; + Texts_FontsFont fnt; + SHORTINT col, voff; + BOOLEAN ascii; + } Texts_RunDesc; + +typedef + struct Texts_ElemDesc *Texts_Elem; + +typedef + struct Texts_ElemMsg { + char _prvt0[1]; + } Texts_ElemMsg; + +typedef + void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, LONGINT *); + +typedef + struct Texts_TextDesc *Texts_Text; + +typedef + struct Texts_ElemDesc { + Texts_Run prev, next; + LONGINT len; + Texts_FontsFont fnt; + SHORTINT col, voff; + BOOLEAN ascii; + LONGINT W, H; + Texts_Handler handle; + Texts_Text base; + } Texts_ElemDesc; + +struct Texts__1 { /* Texts_ElemDesc */ + Texts_Run prev, next; + LONGINT len; + Texts_FontsFont fnt; + SHORTINT col, voff; + BOOLEAN ascii; + LONGINT W, H; + Texts_Handler handle; + Texts_Text base; + Files_File file; + LONGINT org, span; + CHAR mod[32], proc[32]; +}; + +typedef + struct Texts__1 *Texts_Alien; + +typedef + struct Texts_BufDesc { + LONGINT len; + Texts_Run head; + } Texts_BufDesc; + +typedef + Texts_BufDesc *Texts_Buffer; + +typedef + struct Texts_CopyMsg { /* Texts_ElemMsg */ + Texts_Elem e; + } Texts_CopyMsg; + +typedef + struct Texts_FileMsg { /* Texts_ElemMsg */ + INTEGER id; + LONGINT pos; + Files_Rider r; + } Texts_FileMsg; + +typedef + struct Texts_FontDesc { + CHAR name[32]; + } Texts_FontDesc; + +typedef + struct Texts_IdentifyMsg { /* Texts_ElemMsg */ + CHAR mod[32], proc[32]; + } Texts_IdentifyMsg; + +typedef + void (*Texts_Notifier)(Texts_Text, INTEGER, LONGINT, LONGINT); + +typedef + struct Texts_PieceDesc *Texts_Piece; + +typedef + struct Texts_PieceDesc { + Texts_Run prev, next; + LONGINT len; + Texts_FontsFont fnt; + SHORTINT col, voff; + BOOLEAN ascii; + Files_File file; + LONGINT org; + } Texts_PieceDesc; + +typedef + struct Texts_Reader { + BOOLEAN eot; + Texts_FontsFont fnt; + SHORTINT col, voff; + Texts_Elem elem; + Files_Rider rider; + Texts_Run run; + LONGINT org, off; + } Texts_Reader; + +typedef + struct Texts_Scanner { /* Texts_Reader */ + BOOLEAN eot; + Texts_FontsFont fnt; + SHORTINT col, voff; + Texts_Elem elem; + Files_Rider rider; + Texts_Run run; + LONGINT org, off; + CHAR nextCh; + INTEGER line, class; + LONGINT i; + REAL x; + LONGREAL y; + CHAR c; + SHORTINT len; + CHAR s[64]; + } Texts_Scanner; + +typedef + struct Texts_TextDesc { + LONGINT len; + Texts_Notifier notify; + Texts_Run head, cache; + LONGINT corg; + } Texts_TextDesc; + +typedef + struct Texts_Writer { + Texts_Buffer buf; + Texts_FontsFont fnt; + SHORTINT col, voff; + Files_Rider rider; + Files_File file; + } Texts_Writer; + + +export Texts_Elem Texts_new; +static Texts_Buffer Texts_del; +static Texts_FontsFont Texts_FontsDefault; + +export LONGINT *Texts_FontDesc__typ; +export LONGINT *Texts_RunDesc__typ; +export LONGINT *Texts_PieceDesc__typ; +export LONGINT *Texts_ElemMsg__typ; +export LONGINT *Texts_ElemDesc__typ; +export LONGINT *Texts_FileMsg__typ; +export LONGINT *Texts_CopyMsg__typ; +export LONGINT *Texts_IdentifyMsg__typ; +export LONGINT *Texts_BufDesc__typ; +export LONGINT *Texts_TextDesc__typ; +export LONGINT *Texts_Reader__typ; +export LONGINT *Texts_Scanner__typ; +export LONGINT *Texts_Writer__typ; +export LONGINT *Texts__1__typ; + +export void Texts_Append (Texts_Text T, Texts_Buffer B); +export void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff); +static Texts_Elem Texts_CloneElem (Texts_Elem e); +static Texts_Piece Texts_ClonePiece (Texts_Piece p); +export void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len); +export void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB); +export void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE); +export void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end); +export Texts_Text Texts_ElemBase (Texts_Elem E); +export LONGINT Texts_ElemPos (Texts_Elem E); +static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org, LONGINT *off); +static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len); +static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__typ); +export void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B); +export void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v); +export void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len); +export void Texts_OpenBuf (Texts_Buffer B); +export void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos); +export void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos); +export void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ); +export LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ); +export void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch); +export void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ); +export void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ); +export void Texts_Recall (Texts_Buffer *B); +export void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B); +export void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ); +export void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col); +export void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt); +export void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff); +static void Texts_Splice (Texts_Run un, Texts_Run v, Texts_Run w, Texts_Text base); +static void Texts_Split (LONGINT off, Texts_Run *u, Texts_Run *un); +export void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +export void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch); +export void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d); +export void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e); +export void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x); +export void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n); +export void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ); +export void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n); +export void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x); +export void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n); +export void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k); +export void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x); +export void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len); + + +static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len) +{ + Texts_FontsFont _o_result; + Texts_FontsFont F = NIL; + __NEW(F, Texts_FontDesc); + __COPY(name, F->name, ((LONGINT)(32))); + _o_result = F; + return _o_result; +} + +static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org, LONGINT *off) +{ + Texts_Run v = NIL; + LONGINT m; + if (*pos >= T->len) { + *pos = T->len; + *u = T->head; + *org = T->len; + *off = 0; + T->cache = T->head; + T->corg = 0; + } else { + v = T->cache->next; + m = *pos - T->corg; + if (*pos >= T->corg) { + while (m >= v->len) { + m -= v->len; + v = v->next; + } + } else { + while (m < 0) { + v = v->prev; + m += v->len; + } + } + *u = v; + *org = *pos - m; + *off = m; + T->cache = v->prev; + T->corg = *org; + } +} + +static void Texts_Split (LONGINT off, Texts_Run *u, Texts_Run *un) +{ + Texts_Piece p = NIL, U = NIL; + if (off == 0) { + *un = *u; + *u = (*un)->prev; + } else if (off >= (*u)->len) { + *un = (*u)->next; + } else { + __NEW(p, Texts_PieceDesc); + *un = (Texts_Run)p; + U = __GUARDP(*u, Texts_PieceDesc, 1); + __GUARDEQP(p, Texts_PieceDesc) = *U; + p->org += off; + p->len -= off; + U->len -= p->len; + p->ascii = (*u)->ascii; + p->prev = (Texts_Run)U; + p->next = U->next; + p->next->prev = (Texts_Run)p; + U->next = (Texts_Run)p; + } +} + +static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v) +{ + Texts_Piece p = NIL, q = NIL; + if ((((((((((__ISP(u, Texts_PieceDesc, 1) && __ISP(*v, Texts_PieceDesc, 1))) && __STRCMP(u->fnt->name, (*v)->fnt->name) == 0)) && u->col == (*v)->col)) && u->voff == (*v)->voff)) && __GUARDP(u, Texts_PieceDesc, 1)->ascii == __GUARDP(*v, Texts_PieceDesc, 1)->ascii)) { + p = __GUARDP(u, Texts_PieceDesc, 1); + q = __GUARDP(*v, Texts_PieceDesc, 1); + if ((p->file == q->file && p->org + p->len == q->org)) { + if (T->cache == u) { + T->corg += q->len; + } else if (T->cache == *v) { + T->cache = T->head; + T->corg = 0; + } + p->len += q->len; + *v = (*v)->next; + } + } +} + +static void Texts_Splice (Texts_Run un, Texts_Run v, Texts_Run w, Texts_Text base) +{ + Texts_Run u = NIL; + if (v != w->next) { + u = un->prev; + u->next = v; + v->prev = u; + un->prev = w; + w->next = un; + do { + if (__ISP(v, Texts_ElemDesc, 1)) { + __GUARDP(v, Texts_ElemDesc, 1)->base = base; + } + v = v->next; + } while (!(v == un)); + } +} + +static Texts_Piece Texts_ClonePiece (Texts_Piece p) +{ + Texts_Piece _o_result; + Texts_Piece q = NIL; + __NEW(q, Texts_PieceDesc); + __GUARDEQP(q, Texts_PieceDesc) = *p; + _o_result = q; + return _o_result; +} + +static Texts_Elem Texts_CloneElem (Texts_Elem e) +{ + Texts_Elem _o_result; + Texts_CopyMsg msg; + msg.e = NIL; + (*e->handle)(e, (void*)&msg, Texts_CopyMsg__typ); + _o_result = msg.e; + return _o_result; +} + +void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE) +{ + DE->len = SE->len; + DE->fnt = SE->fnt; + DE->col = SE->col; + DE->voff = SE->voff; + DE->W = SE->W; + DE->H = SE->H; + DE->handle = SE->handle; +} + +Texts_Text Texts_ElemBase (Texts_Elem E) +{ + Texts_Text _o_result; + _o_result = E->base; + return _o_result; +} + +LONGINT Texts_ElemPos (Texts_Elem E) +{ + LONGINT _o_result; + Texts_Run u = NIL; + LONGINT pos; + u = E->base->head->next; + pos = 0; + while (u != (void *) E) { + pos = pos + u->len; + u = u->next; + } + _o_result = pos; + return _o_result; +} + +static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__typ) +{ + Texts_Alien e = NIL; + Files_Rider r; + LONGINT i; + CHAR ch; + if (__ISP(E, Texts__1, 2)) { + if (__IS(msg__typ, Texts_CopyMsg, 1)) { + if (__IS(msg__typ, Texts_CopyMsg, 1)) { + Texts_CopyMsg *msg__ = (void*)msg; + __NEW(e, Texts__1); + Texts_CopyElem((void*)((Texts_Alien)E), (void*)e); + e->file = ((Texts_Alien)E)->file; + e->org = ((Texts_Alien)E)->org; + e->span = ((Texts_Alien)E)->span; + __COPY(((Texts_Alien)E)->mod, e->mod, ((LONGINT)(32))); + __COPY(((Texts_Alien)E)->proc, e->proc, ((LONGINT)(32))); + (*msg__).e = (Texts_Elem)e; + } else __WITHCHK; + } else if (__IS(msg__typ, Texts_IdentifyMsg, 1)) { + if (__IS(msg__typ, Texts_IdentifyMsg, 1)) { + Texts_IdentifyMsg *msg__ = (void*)msg; + __COPY(((Texts_Alien)E)->mod, (*msg__).mod, ((LONGINT)(32))); + __COPY(((Texts_Alien)E)->proc, (*msg__).proc, ((LONGINT)(32))); + (*msg__).mod[31] = 0x01; + } else __WITHCHK; + } else if (__IS(msg__typ, Texts_FileMsg, 1)) { + if (__IS(msg__typ, Texts_FileMsg, 1)) { + Texts_FileMsg *msg__ = (void*)msg; + if ((*msg__).id == 1) { + Files_Set(&r, Files_Rider__typ, ((Texts_Alien)E)->file, ((Texts_Alien)E)->org); + i = ((Texts_Alien)E)->span; + while (i > 0) { + Files_Read(&r, Files_Rider__typ, (void*)&ch); + Files_Write(&(*msg__).r, Files_Rider__typ, ch); + i -= 1; + } + } + } else __WITHCHK; + } + } else __WITHCHK; +} + +void Texts_OpenBuf (Texts_Buffer B) +{ + Texts_Run u = NIL; + __NEW(u, Texts_RunDesc); + u->next = u; + u->prev = u; + B->head = u; + B->len = 0; +} + +void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB) +{ + Texts_Run u = NIL, v = NIL, vn = NIL; + u = SB->head->next; + v = DB->head->prev; + while (u != SB->head) { + if (__ISP(u, Texts_PieceDesc, 1)) { + vn = (Texts_Run)Texts_ClonePiece(__GUARDP(u, Texts_PieceDesc, 1)); + } else { + vn = (Texts_Run)Texts_CloneElem(__GUARDP(u, Texts_ElemDesc, 1)); + } + v->next = vn; + vn->prev = v; + v = vn; + u = u->next; + } + v->next = DB->head; + DB->head->prev = v; + DB->len += SB->len; +} + +void Texts_Recall (Texts_Buffer *B) +{ + *B = Texts_del; + Texts_del = NIL; +} + +void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B) +{ + Texts_Run u = NIL, v = NIL, w = NIL, wn = NIL; + LONGINT uo, ud, vo, vd; + Texts_Find(T, &beg, &u, &uo, &ud); + Texts_Find(T, &end, &v, &vo, &vd); + w = B->head->prev; + while (u != v) { + if (__ISP(u, Texts_PieceDesc, 1)) { + wn = (Texts_Run)Texts_ClonePiece(__GUARDP(u, Texts_PieceDesc, 1)); + wn->len -= ud; + __GUARDP(wn, Texts_PieceDesc, 1)->org += ud; + } else { + wn = (Texts_Run)Texts_CloneElem(__GUARDP(u, Texts_ElemDesc, 1)); + } + w->next = wn; + wn->prev = w; + w = wn; + u = u->next; + ud = 0; + } + if (vd > 0) { + wn = (Texts_Run)Texts_ClonePiece(__GUARDP(v, Texts_PieceDesc, 1)); + wn->len = vd - ud; + __GUARDP(wn, Texts_PieceDesc, 1)->org += ud; + w->next = wn; + wn->prev = w; + w = wn; + } + w->next = B->head; + B->head->prev = w; + B->len += end - beg; +} + +void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B) +{ + Texts_Run u = NIL, un = NIL, v = NIL; + Texts_Piece p = NIL, q = NIL; + LONGINT uo, ud, len; + Texts_Find(T, &pos, &u, &uo, &ud); + Texts_Split(ud, &u, &un); + len = B->len; + v = B->head->next; + Texts_Merge(T, u, &v); + Texts_Splice(un, v, B->head->prev, T); + T->len += len; + B->head->next = B->head; + B->head->prev = B->head; + B->len = 0; + if (T->notify != NIL) { + (*T->notify)(T, 1, pos, pos + len); + } +} + +void Texts_Append (Texts_Text T, Texts_Buffer B) +{ + Texts_Run v = NIL; + LONGINT pos, len; + pos = T->len; + len = B->len; + v = B->head->next; + Texts_Merge(T, T->head->prev, &v); + Texts_Splice(T->head, v, B->head->prev, T); + T->len += len; + B->head->next = B->head; + B->head->prev = B->head; + B->len = 0; + if (T->notify != NIL) { + (*T->notify)(T, 1, pos, pos + len); + } +} + +void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end) +{ + Texts_Run c = NIL, u = NIL, un = NIL, v = NIL, vn = NIL; + LONGINT co, uo, ud, vo, vd; + Texts_Find(T, &beg, &u, &uo, &ud); + Texts_Split(ud, &u, &un); + c = T->cache; + co = T->corg; + Texts_Find(T, &end, &v, &vo, &vd); + Texts_Split(vd, &v, &vn); + T->cache = c; + T->corg = co; + __NEW(Texts_del, Texts_BufDesc); + Texts_OpenBuf(Texts_del); + Texts_del->len = end - beg; + Texts_Splice(Texts_del->head, un, v, NIL); + Texts_Merge(T, u, &vn); + u->next = vn; + vn->prev = u; + T->len -= end - beg; + if (T->notify != NIL) { + (*T->notify)(T, 2, beg, end); + } +} + +void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff) +{ + Texts_Run c = NIL, u = NIL, un = NIL, v = NIL, vn = NIL; + LONGINT co, uo, ud, vo, vd; + Texts_Find(T, &beg, &u, &uo, &ud); + Texts_Split(ud, &u, &un); + c = T->cache; + co = T->corg; + Texts_Find(T, &end, &v, &vo, &vd); + Texts_Split(vd, &v, &vn); + T->cache = c; + T->corg = co; + while (un != vn) { + if ((__IN(0, sel) && fnt != NIL)) { + un->fnt = fnt; + } + if (__IN(1, sel)) { + un->col = col; + } + if (__IN(2, sel)) { + un->voff = voff; + } + Texts_Merge(T, u, &un); + if (u->next == un) { + u = un; + un = un->next; + } else { + u->next = un; + un->prev = u; + } + } + Texts_Merge(T, u, &un); + u->next = un; + un->prev = u; + if (T->notify != NIL) { + (*T->notify)(T, 0, beg, end); + } +} + +void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos) +{ + Texts_Run u = NIL; + if (pos >= T->len) { + pos = T->len; + } + Texts_Find(T, &pos, &u, &(*R).org, &(*R).off); + (*R).run = u; + (*R).eot = 0; + if (__ISP(u, Texts_PieceDesc, 1)) { + Files_Set(&(*R).rider, Files_Rider__typ, __GUARDP(u, Texts_PieceDesc, 1)->file, __GUARDP(u, Texts_PieceDesc, 1)->org + (*R).off); + } +} + +void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch) +{ + Texts_Run u = NIL; + LONGINT pos; + CHAR nextch; + u = (*R).run; + (*R).fnt = u->fnt; + (*R).col = u->col; + (*R).voff = u->voff; + (*R).off += 1; + if (__ISP(u, Texts_PieceDesc, 1)) { + Files_Read(&(*R).rider, Files_Rider__typ, (void*)&*ch); + (*R).elem = NIL; + if ((*ch == 0x0a && __GUARDP(u, Texts_PieceDesc, 1)->ascii)) { + *ch = 0x0d; + } else if ((*ch == 0x0d && __GUARDP(u, Texts_PieceDesc, 1)->ascii)) { + pos = Files_Pos(&(*R).rider, Files_Rider__typ); + Files_Read(&(*R).rider, Files_Rider__typ, (void*)&nextch); + if (nextch == 0x0a) { + (*R).off += 1; + } else { + Files_Set(&(*R).rider, Files_Rider__typ, __GUARDP(u, Texts_PieceDesc, 1)->file, pos); + } + } + } else if (__ISP(u, Texts_ElemDesc, 1)) { + *ch = 0x1c; + (*R).elem = __GUARDP(u, Texts_ElemDesc, 1); + } else { + *ch = 0x00; + (*R).elem = NIL; + (*R).eot = 1; + } + if ((*R).off == u->len) { + (*R).org += u->len; + u = u->next; + if (__ISP(u, Texts_PieceDesc, 1)) { + if (__ISP(u, Texts_PieceDesc, 1)) { + Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org); + } else __WITHCHK; + } + (*R).run = u; + (*R).off = 0; + } +} + +void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ) +{ + Texts_Run u = NIL, un = NIL; + u = (*R).run; + while (__ISP(u, Texts_PieceDesc, 1)) { + (*R).org += u->len; + u = u->next; + } + if (__ISP(u, Texts_ElemDesc, 1)) { + un = u->next; + (*R).run = un; + (*R).org += 1; + (*R).off = 0; + (*R).fnt = u->fnt; + (*R).col = u->col; + (*R).voff = u->voff; + (*R).elem = __GUARDP(u, Texts_ElemDesc, 1); + if (__ISP(un, Texts_PieceDesc, 1)) { + if (__ISP(un, Texts_PieceDesc, 1)) { + Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)un)->file, ((Texts_Piece)un)->org); + } else __WITHCHK; + } + } else { + (*R).eot = 1; + (*R).elem = NIL; + } +} + +void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ) +{ + Texts_Run u = NIL; + u = (*R).run->prev; + while (__ISP(u, Texts_PieceDesc, 1)) { + (*R).org -= u->len; + u = u->prev; + } + if (__ISP(u, Texts_ElemDesc, 1)) { + (*R).run = u; + (*R).org -= 1; + (*R).off = 0; + (*R).fnt = u->fnt; + (*R).col = u->col; + (*R).voff = u->voff; + (*R).elem = __GUARDP(u, Texts_ElemDesc, 1); + } else { + (*R).eot = 1; + (*R).elem = NIL; + } +} + +LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ) +{ + LONGINT _o_result; + _o_result = (*R).org + (*R).off; + return _o_result; +} + +void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos) +{ + Texts_OpenReader((void*)&*S, S__typ, T, pos); + (*S).line = 0; + (*S).nextCh = ' '; +} + +static struct Scan__31 { + Texts_Scanner *S; + LONGINT *S__typ; + CHAR *ch; + BOOLEAN *negE; + INTEGER *e; + struct Scan__31 *lnk; +} *Scan__31_s; + +static void ReadScaleFactor__32 (void); + +static void ReadScaleFactor__32 (void) +{ + Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch); + if (*Scan__31_s->ch == '-') { + *Scan__31_s->negE = 1; + Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch); + } else { + *Scan__31_s->negE = 0; + if (*Scan__31_s->ch == '+') { + Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch); + } + } + while (('0' <= *Scan__31_s->ch && *Scan__31_s->ch <= '9')) { + *Scan__31_s->e = (*Scan__31_s->e * 10 + (int)*Scan__31_s->ch) - 48; + Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch); + } +} + +void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ) +{ + CHAR ch, term; + BOOLEAN neg, negE, hex; + SHORTINT i, j, h; + INTEGER e; + LONGINT k; + REAL x, f; + LONGREAL y, g; + CHAR d[32]; + struct Scan__31 _s; + _s.S = S; _s.S__typ = S__typ; + _s.ch = &ch; + _s.negE = &negE; + _s.e = &e; + _s.lnk = Scan__31_s; + Scan__31_s = &_s; + ch = (*S).nextCh; + i = 0; + for (;;) { + if (ch == 0x0d) { + (*S).line += 1; + } else if ((ch != ' ' && ch != 0x09)) { + break; + } + Texts_Read((void*)&*S, S__typ, &ch); + } + if ((('A' <= __CAP(ch) && __CAP(ch) <= 'Z') || ch == '/') || ch == '.') { + do { + (*S).s[__X(i, ((LONGINT)(64)))] = ch; + i += 1; + Texts_Read((void*)&*S, S__typ, &ch); + } while (!((((__CAP(ch) > 'Z' && ch != '_') || ('A' > __CAP(ch) && ch > '9')) || ((('0' > ch && ch != '.')) && ch != '/')) || i == 63)); + (*S).s[__X(i, ((LONGINT)(64)))] = 0x00; + (*S).len = i; + (*S).class = 1; + } else if (ch == '\"') { + Texts_Read((void*)&*S, S__typ, &ch); + while ((((ch != '\"' && ch >= ' ')) && i != 63)) { + (*S).s[__X(i, ((LONGINT)(64)))] = ch; + i += 1; + Texts_Read((void*)&*S, S__typ, &ch); + } + (*S).s[__X(i, ((LONGINT)(64)))] = 0x00; + (*S).len = i + 1; + Texts_Read((void*)&*S, S__typ, &ch); + (*S).class = 2; + } else { + if (ch == '-') { + neg = 1; + Texts_Read((void*)&*S, S__typ, &ch); + } else { + neg = 0; + } + if (('0' <= ch && ch <= '9')) { + hex = 0; + j = 0; + for (;;) { + d[__X(i, ((LONGINT)(32)))] = ch; + i += 1; + Texts_Read((void*)&*S, S__typ, &ch); + if (ch < '0') { + break; + } + if ('9' < ch) { + if (('A' <= ch && ch <= 'F')) { + hex = 1; + ch = (CHAR)((int)ch - 7); + } else if (('a' <= ch && ch <= 'f')) { + hex = 1; + ch = (CHAR)((int)ch - 39); + } else { + break; + } + } + } + if (ch == 'H') { + Texts_Read((void*)&*S, S__typ, &ch); + (*S).class = 3; + if (i - j > 8) { + j = i - 8; + } + k = (int)d[__X(j, ((LONGINT)(32)))] - 48; + j += 1; + if ((i - j == 7 && k >= 8)) { + k -= 16; + } + while (j < i) { + k = __ASHL(k, 4) + (LONGINT)((int)d[__X(j, ((LONGINT)(32)))] - 48); + j += 1; + } + if (neg) { + (*S).i = -k; + } else { + (*S).i = k; + } + } else if (ch == '.') { + Texts_Read((void*)&*S, S__typ, &ch); + h = i; + while (('0' <= ch && ch <= '9')) { + d[__X(i, ((LONGINT)(32)))] = ch; + i += 1; + Texts_Read((void*)&*S, S__typ, &ch); + } + if (ch == 'D') { + e = 0; + y = (LONGREAL)0; + g = (LONGREAL)1; + do { + y = y * (LONGREAL)10 + ((int)d[__X(j, ((LONGINT)(32)))] - 48); + j += 1; + } while (!(j == h)); + while (j < i) { + g = g / (LONGREAL)(LONGREAL)10; + y = ((int)d[__X(j, ((LONGINT)(32)))] - 48) * g + y; + j += 1; + } + ReadScaleFactor__32(); + if (negE) { + if (e <= 308) { + y = y / (LONGREAL)Reals_TenL(e); + } else { + y = (LONGREAL)0; + } + } else if (e > 0) { + if (e <= 308) { + y = Reals_TenL(e) * y; + } else { + __HALT(40); + } + } + if (neg) { + y = -y; + } + (*S).class = 5; + (*S).y = y; + } else { + e = 0; + x = (REAL)0; + f = (REAL)1; + do { + x = x * (REAL)10 + ((int)d[__X(j, ((LONGINT)(32)))] - 48); + j += 1; + } while (!(j == h)); + while (j < i) { + f = f / (REAL)(REAL)10; + x = ((int)d[__X(j, ((LONGINT)(32)))] - 48) * f + x; + j += 1; + } + if (ch == 'E') { + ReadScaleFactor__32(); + } + if (negE) { + if (e <= 38) { + x = x / (REAL)Reals_Ten(e); + } else { + x = (REAL)0; + } + } else if (e > 0) { + if (e <= 38) { + x = Reals_Ten(e) * x; + } else { + __HALT(40); + } + } + if (neg) { + x = -x; + } + (*S).class = 4; + (*S).x = x; + } + if (hex) { + (*S).class = 0; + } + } else { + (*S).class = 3; + k = 0; + do { + k = k * 10 + (LONGINT)((int)d[__X(j, ((LONGINT)(32)))] - 48); + j += 1; + } while (!(j == i)); + if (neg) { + (*S).i = -k; + } else { + (*S).i = k; + } + if (hex) { + (*S).class = 0; + } else { + (*S).class = 3; + } + } + } else { + (*S).class = 6; + if (neg) { + (*S).c = '-'; + } else { + (*S).c = ch; + Texts_Read((void*)&*S, S__typ, &ch); + } + } + } + (*S).nextCh = ch; + Scan__31_s = _s.lnk; +} + +void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ) +{ + __NEW((*W).buf, Texts_BufDesc); + Texts_OpenBuf((*W).buf); + (*W).fnt = Texts_FontsDefault; + (*W).col = 15; + (*W).voff = 0; + (*W).file = Files_New((CHAR*)"", (LONGINT)1); + Files_Set(&(*W).rider, Files_Rider__typ, (*W).file, ((LONGINT)(0))); +} + +void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt) +{ + (*W).fnt = fnt; +} + +void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col) +{ + (*W).col = col; +} + +void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff) +{ + (*W).voff = voff; +} + +void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch) +{ + Texts_Run u = NIL, un = NIL; + Texts_Piece p = NIL; + Files_Write(&(*W).rider, Files_Rider__typ, ch); + (*W).buf->len += 1; + un = (*W).buf->head; + u = un->prev; + if ((((((((((__ISP(u, Texts_PieceDesc, 1) && __GUARDP(u, Texts_PieceDesc, 1)->file == (*W).file)) && __STRCMP(u->fnt->name, (*W).fnt->name) == 0)) && u->col == (*W).col)) && u->voff == (*W).voff)) && !__GUARDP(u, Texts_PieceDesc, 1)->ascii)) { + u->len += 1; + } else { + __NEW(p, Texts_PieceDesc); + u->next = (Texts_Run)p; + p->prev = u; + p->next = un; + un->prev = (Texts_Run)p; + p->len = 1; + p->fnt = (*W).fnt; + p->col = (*W).col; + p->voff = (*W).voff; + p->file = (*W).file; + p->org = Files_Length((*W).file) - 1; + p->ascii = 0; + } +} + +void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e) +{ + Texts_Run u = NIL, un = NIL; + if (e->base != NIL) { + __HALT(99); + } + (*W).buf->len += 1; + e->len = 1; + e->fnt = (*W).fnt; + e->col = (*W).col; + e->voff = (*W).voff; + un = (*W).buf->head; + u = un->prev; + u->next = (Texts_Run)e; + e->prev = u; + e->next = un; + un->prev = (Texts_Run)e; +} + +void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ) +{ + Texts_Write(&*W, W__typ, 0x0d); +} + +void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len) +{ + INTEGER i; + __DUP(s, s__len, CHAR); + i = 0; + while (s[__X(i, s__len)] >= ' ') { + Texts_Write(&*W, W__typ, s[__X(i, s__len)]); + i += 1; + } + __DEL(s); +} + +void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n) +{ + INTEGER i; + LONGINT x0; + CHAR a[22]; + i = 0; + if (x < 0) { + if (x == (-2147483647-1)) { + Texts_WriteString(&*W, W__typ, (CHAR*)" -2147483648", (LONGINT)13); + return; + } else { + n -= 1; + x0 = -x; + } + } else { + x0 = x; + } + do { + a[__X(i, ((LONGINT)(22)))] = (CHAR)(__MOD(x0, 10) + 48); + x0 = __DIV(x0, 10); + i += 1; + } while (!(x0 == 0)); + while (n > (LONGINT)i) { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } + if (x < 0) { + Texts_Write(&*W, W__typ, '-'); + } + do { + i -= 1; + Texts_Write(&*W, W__typ, a[__X(i, ((LONGINT)(22)))]); + } while (!(i == 0)); +} + +void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x) +{ + INTEGER i; + LONGINT y; + CHAR a[20]; + i = 0; + Texts_Write(&*W, W__typ, ' '); + do { + y = __MASK(x, -16); + if (y < 10) { + a[__X(i, ((LONGINT)(20)))] = (CHAR)(y + 48); + } else { + a[__X(i, ((LONGINT)(20)))] = (CHAR)(y + 55); + } + x = __ASHR(x, 4); + i += 1; + } while (!(i == 8)); + do { + i -= 1; + Texts_Write(&*W, W__typ, a[__X(i, ((LONGINT)(20)))]); + } while (!(i == 0)); +} + +void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n) +{ + INTEGER e; + REAL x0; + CHAR d[9]; + e = Reals_Expo(x); + if (e == 0) { + Texts_WriteString(&*W, W__typ, (CHAR*)" 0", (LONGINT)4); + do { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } while (!(n <= 3)); + } else if (e == 255) { + Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5); + while (n > 4) { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } + } else { + if (n <= 9) { + n = 3; + } else { + n -= 6; + } + do { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } while (!(n <= 8)); + if (x < (REAL)0) { + Texts_Write(&*W, W__typ, '-'); + x = -x; + } else { + Texts_Write(&*W, W__typ, ' '); + } + e = __ASHR((e - 127) * 77, 8); + if (e >= 0) { + x = x / (REAL)Reals_Ten(e); + } else { + x = Reals_Ten(-e) * x; + } + if (x >= (REAL)10) { + x = 1.0000000e-001 * x; + e += 1; + } + x0 = Reals_Ten(n - 1); + x = x0 * x + 5.0000000e-001; + if (x >= (REAL)10 * x0) { + x = x * 1.0000000e-001; + e += 1; + } + Reals_Convert(x, n, (void*)d, ((LONGINT)(9))); + n -= 1; + Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(9)))]); + Texts_Write(&*W, W__typ, '.'); + do { + n -= 1; + Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(9)))]); + } while (!(n == 0)); + Texts_Write(&*W, W__typ, 'E'); + if (e < 0) { + Texts_Write(&*W, W__typ, '-'); + e = -e; + } else { + Texts_Write(&*W, W__typ, '+'); + } + Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48)); + Texts_Write(&*W, W__typ, (CHAR)((int)__MOD(e, 10) + 48)); + } +} + +static struct WriteRealFix__53 { + Texts_Writer *W; + LONGINT *W__typ; + INTEGER *i; + CHAR (*d)[9]; + struct WriteRealFix__53 *lnk; +} *WriteRealFix__53_s; + +static void dig__54 (INTEGER n); +static void seq__56 (CHAR ch, INTEGER n); + +static void seq__56 (CHAR ch, INTEGER n) +{ + while (n > 0) { + Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, ch); + n -= 1; + } +} + +static void dig__54 (INTEGER n) +{ + while (n > 0) { + *WriteRealFix__53_s->i -= 1; + Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, (*WriteRealFix__53_s->d)[__X(*WriteRealFix__53_s->i, ((LONGINT)(9)))]); + n -= 1; + } +} + +void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k) +{ + INTEGER e, i; + CHAR sign; + REAL x0; + CHAR d[9]; + struct WriteRealFix__53 _s; + _s.W = W; _s.W__typ = W__typ; + _s.i = &i; + _s.d = (void*)d; + _s.lnk = WriteRealFix__53_s; + WriteRealFix__53_s = &_s; + e = Reals_Expo(x); + if (k < 0) { + k = 0; + } + if (e == 0) { + seq__56(' ', (n - k) - 2); + Texts_Write(&*W, W__typ, '0'); + seq__56(' ', k + 1); + } else if (e == 255) { + Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5); + seq__56(' ', n - 4); + } else { + e = __ASHR((e - 127) * 77, 8); + if (x < (REAL)0) { + sign = '-'; + x = -x; + } else { + sign = ' '; + } + if (e >= 0) { + x = x / (REAL)Reals_Ten(e); + } else { + x = Reals_Ten(-e) * x; + } + if (x >= (REAL)10) { + x = 1.0000000e-001 * x; + e += 1; + } + if (k + e >= 8) { + k = 8 - e; + } else if (k + e < 0) { + k = -e; + x = (REAL)0; + } + x0 = Reals_Ten(k + e); + x = x0 * x + 5.0000000e-001; + if (x >= (REAL)10 * x0) { + e += 1; + } + e += 1; + i = k + e; + Reals_Convert(x, i, (void*)d, ((LONGINT)(9))); + if (e > 0) { + seq__56(' ', ((n - e) - k) - 2); + Texts_Write(&*W, W__typ, sign); + dig__54(e); + Texts_Write(&*W, W__typ, '.'); + dig__54(k); + } else { + seq__56(' ', (n - k) - 3); + Texts_Write(&*W, W__typ, sign); + Texts_Write(&*W, W__typ, '0'); + Texts_Write(&*W, W__typ, '.'); + seq__56('0', -e); + dig__54(k + e); + } + } + WriteRealFix__53_s = _s.lnk; +} + +void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x) +{ + INTEGER i; + CHAR d[8]; + Reals_ConvertH(x, (void*)d, ((LONGINT)(8))); + i = 0; + do { + Texts_Write(&*W, W__typ, d[__X(i, ((LONGINT)(8)))]); + i += 1; + } while (!(i == 8)); +} + +void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n) +{ + INTEGER e; + LONGREAL x0; + CHAR d[16]; + e = Reals_ExpoL(x); + if (e == 0) { + Texts_WriteString(&*W, W__typ, (CHAR*)" 0", (LONGINT)4); + do { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } while (!(n <= 3)); + } else if (e == 2047) { + Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5); + while (n > 4) { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } + } else { + if (n <= 10) { + n = 3; + } else { + n -= 7; + } + do { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } while (!(n <= 16)); + if (x < (LONGREAL)0) { + Texts_Write(&*W, W__typ, '-'); + x = -x; + } else { + Texts_Write(&*W, W__typ, ' '); + } + e = (int)__ASHR((LONGINT)(e - 1023) * 77, 8); + if (e >= 0) { + x = x / (LONGREAL)Reals_TenL(e); + } else { + x = Reals_TenL(-e) * x; + } + if (x >= (LONGREAL)10) { + x = 1.00000000000000e-001 * x; + e += 1; + } + x0 = Reals_TenL(n - 1); + x = x0 * x + 5.00000000000000e-001; + if (x >= (LONGREAL)10 * x0) { + x = 1.00000000000000e-001 * x; + e += 1; + } + Reals_ConvertL(x, n, (void*)d, ((LONGINT)(16))); + n -= 1; + Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(16)))]); + Texts_Write(&*W, W__typ, '.'); + do { + n -= 1; + Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(16)))]); + } while (!(n == 0)); + Texts_Write(&*W, W__typ, 'D'); + if (e < 0) { + Texts_Write(&*W, W__typ, '-'); + e = -e; + } else { + Texts_Write(&*W, W__typ, '+'); + } + Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 100) + 48)); + e = (int)__MOD(e, 100); + Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48)); + Texts_Write(&*W, W__typ, (CHAR)((int)__MOD(e, 10) + 48)); + } +} + +void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x) +{ + INTEGER i; + CHAR d[16]; + Reals_ConvertHL(x, (void*)d, ((LONGINT)(16))); + i = 0; + do { + Texts_Write(&*W, W__typ, d[__X(i, ((LONGINT)(16)))]); + i += 1; + } while (!(i == 16)); +} + +static struct WriteDate__43 { + Texts_Writer *W; + LONGINT *W__typ; + struct WriteDate__43 *lnk; +} *WriteDate__43_s; + +static void WritePair__44 (CHAR ch, LONGINT x); + +static void WritePair__44 (CHAR ch, LONGINT x) +{ + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, ch); + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__DIV(x, 10) + 48)); + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__MOD(x, 10) + 48)); +} + +void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d) +{ + struct WriteDate__43 _s; + _s.W = W; _s.W__typ = W__typ; + _s.lnk = WriteDate__43_s; + WriteDate__43_s = &_s; + WritePair__44(' ', __MASK(d, -32)); + WritePair__44('.', __MASK(__ASHR(d, 5), -16)); + WritePair__44('.', __MASK(__ASHR(d, 9), -128)); + WritePair__44(' ', __MASK(__ASHR(t, 12), -32)); + WritePair__44(':', __MASK(__ASHR(t, 6), -64)); + WritePair__44(':', __MASK(t, -64)); + WriteDate__43_s = _s.lnk; +} + +static struct Load0__16 { + Texts_Text *T; + SHORTINT *ecnt; + Files_File *f; + Texts_FileMsg *msg; + CHAR (*mods)[64][32], (*procs)[64][32]; + struct Load0__16 *lnk; +} *Load0__16_s; + +static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT span, Texts_Elem *e); + +static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT span, Texts_Elem *e) +{ + Modules_Module M = NIL; + Modules_Command Cmd; + Texts_Alien a = NIL; + LONGINT org, ew, eh; + SHORTINT eno; + Texts_new = NIL; + Files_ReadLInt(&*r, r__typ, &ew); + Files_ReadLInt(&*r, r__typ, &eh); + Files_Read(&*r, r__typ, (void*)&eno); + if (eno > *Load0__16_s->ecnt) { + *Load0__16_s->ecnt = eno; + Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32))); + Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32))); + } + org = Files_Pos(&*r, r__typ); + M = Modules_ThisMod((*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32))); + if (M != NIL) { + Cmd = Modules_ThisCommand(M, (*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32))); + if (Cmd != NIL) { + (*Cmd)(); + } + } + *e = Texts_new; + if (*e != NIL) { + (*e)->W = ew; + (*e)->H = eh; + (*e)->base = *Load0__16_s->T; + (*Load0__16_s->msg).pos = pos; + (*(*e)->handle)(*e, (void*)&*Load0__16_s->msg, Texts_FileMsg__typ); + if (Files_Pos(&*r, r__typ) != org + span) { + *e = NIL; + } + } + if (*e == NIL) { + Files_Set(&*r, r__typ, *Load0__16_s->f, org + span); + __NEW(a, Texts__1); + a->W = ew; + a->H = eh; + a->handle = Texts_HandleAlien; + a->base = *Load0__16_s->T; + a->file = *Load0__16_s->f; + a->org = org; + a->span = span; + __COPY((*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], a->mod, ((LONGINT)(32))); + __COPY((*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], a->proc, ((LONGINT)(32))); + *e = (Texts_Elem)a; + } +} + +static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T) +{ + Texts_Run u = NIL, un = NIL; + Texts_Piece p = NIL; + Texts_Elem e = NIL; + LONGINT org, pos, hlen, plen; + SHORTINT ecnt, fno, fcnt, col, voff; + Files_File f = NIL; + Texts_FileMsg msg; + CHAR mods[64][32], procs[64][32]; + CHAR name[32]; + Texts_FontsFont fnts[32]; + struct Load0__16 _s; + _s.T = &T; + _s.ecnt = &ecnt; + _s.f = &f; + _s.msg = &msg; + _s.mods = (void*)mods; + _s.procs = (void*)procs; + _s.lnk = Load0__16_s; + Load0__16_s = &_s; + pos = Files_Pos(&*r, r__typ); + f = Files_Base(&*r, r__typ); + __NEW(u, Texts_RunDesc); + u->len = 2147483647; + u->fnt = NIL; + u->col = 15; + T->head = u; + ecnt = 0; + fcnt = 0; + msg.id = 0; + msg.r = *r; + Files_ReadLInt(&msg.r, Files_Rider__typ, &hlen); + org = (pos - 2) + hlen; + pos = org; + Files_Read(&msg.r, Files_Rider__typ, (void*)&fno); + while (fno != 0) { + if (fno > fcnt) { + fcnt = fno; + Files_ReadString(&msg.r, Files_Rider__typ, (void*)name, ((LONGINT)(32))); + fnts[__X(fno, ((LONGINT)(32)))] = Texts_FontsThis((void*)name, ((LONGINT)(32))); + } + Files_Read(&msg.r, Files_Rider__typ, (void*)&col); + Files_Read(&msg.r, Files_Rider__typ, (void*)&voff); + Files_ReadLInt(&msg.r, Files_Rider__typ, &plen); + if (plen > 0) { + __NEW(p, Texts_PieceDesc); + p->file = f; + p->org = pos; + p->ascii = 0; + un = (Texts_Run)p; + un->len = plen; + } else { + LoadElem__17(&msg.r, Files_Rider__typ, pos - org, -plen, &e); + un = (Texts_Run)e; + un->len = 1; + } + un->col = col; + un->voff = voff; + pos += un->len; + u->next = un; + un->prev = u; + u = un; + Files_Read(&msg.r, Files_Rider__typ, (void*)&fno); + } + u->next = T->head; + T->head->prev = u; + T->cache = T->head; + T->corg = 0; + Files_ReadLInt(&msg.r, Files_Rider__typ, &T->len); + Files_Set(&*r, r__typ, f, Files_Pos(&msg.r, Files_Rider__typ) + T->len); + Load0__16_s = _s.lnk; +} + +void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T) +{ + INTEGER tag; + Files_ReadInt(&*r, r__typ, &tag); + if (tag != -4095) { + Files_Set(&*r, r__typ, Files_Base(&*r, r__typ), Files_Pos(&*r, r__typ) - 2); + } + Texts_Load0(&*r, r__typ, T); +} + +void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len) +{ + Files_File f = NIL; + Files_Rider r; + Texts_Run u = NIL; + Texts_Piece p = NIL; + CHAR tag, version; + LONGINT hlen; + __DUP(name, name__len, CHAR); + f = Files_Old(name, name__len); + if (f == NIL) { + f = Files_New((CHAR*)"", (LONGINT)1); + } + Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(0))); + Files_Read(&r, Files_Rider__typ, (void*)&tag); + Files_Read(&r, Files_Rider__typ, (void*)&version); + if (tag == 0xf0 || (tag == 0x01 && version == 0xf0)) { + Texts_Load0(&r, Files_Rider__typ, T); + } else { + __NEW(u, Texts_RunDesc); + u->len = 2147483647; + u->fnt = NIL; + u->col = 15; + __NEW(p, Texts_PieceDesc); + if ((tag == 0xf7 && version == 0x07)) { + Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(28))); + Files_ReadLInt(&r, Files_Rider__typ, &hlen); + Files_Set(&r, Files_Rider__typ, f, 22 + hlen); + Files_ReadLInt(&r, Files_Rider__typ, &T->len); + p->org = 26 + hlen; + } else { + T->len = Files_Length(f); + p->org = 0; + } + if (T->len > 0) { + p->len = T->len; + p->fnt = Texts_FontsDefault; + p->col = 15; + p->voff = 0; + p->file = f; + p->ascii = 1; + u->next = (Texts_Run)p; + u->prev = (Texts_Run)p; + p->next = u; + p->prev = u; + } else { + u->next = u; + u->prev = u; + } + T->head = u; + T->cache = T->head; + T->corg = 0; + } + __DEL(name); +} + +static struct Store__39 { + SHORTINT *ecnt; + Texts_FileMsg *msg; + Texts_IdentifyMsg *iden; + CHAR (*mods)[64][32], (*procs)[64][32]; + struct Store__39 *lnk; +} *Store__39_s; + +static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_Elem e); + +static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_Elem e) +{ + Files_Rider r1; + LONGINT org, span; + SHORTINT eno; + __COPY((*Store__39_s->iden).mod, (*Store__39_s->mods)[__X(*Store__39_s->ecnt, ((LONGINT)(64)))], ((LONGINT)(32))); + __COPY((*Store__39_s->iden).proc, (*Store__39_s->procs)[__X(*Store__39_s->ecnt, ((LONGINT)(64)))], ((LONGINT)(32))); + eno = 1; + while (__STRCMP((*Store__39_s->mods)[__X(eno, ((LONGINT)(64)))], (*Store__39_s->iden).mod) != 0 || __STRCMP((*Store__39_s->procs)[__X(eno, ((LONGINT)(64)))], (*Store__39_s->iden).proc) != 0) { + eno += 1; + } + Files_Set(&r1, Files_Rider__typ, Files_Base(&*r, r__typ), Files_Pos(&*r, r__typ)); + Files_WriteLInt(&*r, r__typ, ((LONGINT)(0))); + Files_WriteLInt(&*r, r__typ, ((LONGINT)(0))); + Files_WriteLInt(&*r, r__typ, ((LONGINT)(0))); + Files_Write(&*r, r__typ, eno); + if (eno == *Store__39_s->ecnt) { + *Store__39_s->ecnt += 1; + Files_WriteString(&*r, r__typ, (*Store__39_s->iden).mod, ((LONGINT)(32))); + Files_WriteString(&*r, r__typ, (*Store__39_s->iden).proc, ((LONGINT)(32))); + } + (*Store__39_s->msg).pos = pos; + org = Files_Pos(&*r, r__typ); + (*e->handle)(e, (void*)&*Store__39_s->msg, Texts_FileMsg__typ); + span = Files_Pos(&*r, r__typ) - org; + Files_WriteLInt(&r1, Files_Rider__typ, -span); + Files_WriteLInt(&r1, Files_Rider__typ, e->W); + Files_WriteLInt(&r1, Files_Rider__typ, e->H); +} + +void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T) +{ + Files_Rider r1; + Texts_Run u = NIL, un = NIL; + Texts_Elem e = NIL; + LONGINT org, pos, delta, hlen, rlen; + SHORTINT ecnt, fno, fcnt; + CHAR ch; + Texts_FileMsg msg; + Texts_IdentifyMsg iden; + CHAR mods[64][32], procs[64][32]; + Texts_FontsFont fnts[32]; + CHAR block[1024]; + struct Store__39 _s; + _s.ecnt = &ecnt; + _s.msg = &msg; + _s.iden = &iden; + _s.mods = (void*)mods; + _s.procs = (void*)procs; + _s.lnk = Store__39_s; + Store__39_s = &_s; + org = Files_Pos(&*r, r__typ); + msg.id = 1; + msg.r = *r; + Files_WriteLInt(&msg.r, Files_Rider__typ, ((LONGINT)(0))); + u = T->head->next; + pos = 0; + delta = 0; + fcnt = 1; + ecnt = 1; + while (u != T->head) { + if (__ISP(u, Texts_ElemDesc, 1)) { + iden.mod[0] = 0x00; + (*__GUARDP(u, Texts_ElemDesc, 1)->handle)(__GUARDP(u, Texts_ElemDesc, 1), (void*)&iden, Texts_IdentifyMsg__typ); + } else { + iden.mod[0] = 0x01; + } + if (iden.mod[0] != 0x00) { + fnts[__X(fcnt, ((LONGINT)(32)))] = u->fnt; + fno = 1; + while (__STRCMP(fnts[__X(fno, ((LONGINT)(32)))]->name, u->fnt->name) != 0) { + fno += 1; + } + Files_Write(&msg.r, Files_Rider__typ, fno); + if (fno == fcnt) { + fcnt += 1; + Files_WriteString(&msg.r, Files_Rider__typ, u->fnt->name, ((LONGINT)(32))); + } + Files_Write(&msg.r, Files_Rider__typ, u->col); + Files_Write(&msg.r, Files_Rider__typ, u->voff); + } + if (__ISP(u, Texts_PieceDesc, 1)) { + rlen = u->len; + un = u->next; + while ((((((__ISP(un, Texts_PieceDesc, 1) && un->fnt == u->fnt)) && un->col == u->col)) && un->voff == u->voff)) { + rlen += un->len; + un = un->next; + } + Files_WriteLInt(&msg.r, Files_Rider__typ, rlen); + pos += rlen; + u = un; + } else if (iden.mod[0] != 0x00) { + StoreElem__40(&msg.r, Files_Rider__typ, pos, __GUARDP(u, Texts_ElemDesc, 1)); + pos += 1; + u = u->next; + } else { + delta += 1; + u = u->next; + } + } + Files_Write(&msg.r, Files_Rider__typ, 0); + Files_WriteLInt(&msg.r, Files_Rider__typ, T->len - delta); + hlen = (Files_Pos(&msg.r, Files_Rider__typ) - org) + 2; + Files_Set(&r1, Files_Rider__typ, Files_Base(&msg.r, Files_Rider__typ), org); + Files_WriteLInt(&r1, Files_Rider__typ, hlen); + u = T->head->next; + while (u != T->head) { + if (__ISP(u, Texts_PieceDesc, 1)) { + if (__ISP(u, Texts_PieceDesc, 1)) { + if (((Texts_Piece)u)->ascii) { + Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org); + delta = ((Texts_Piece)u)->len; + while (delta > 0) { + Files_Read(&r1, Files_Rider__typ, (void*)&ch); + delta -= 1; + if (ch == 0x0a) { + Files_Write(&msg.r, Files_Rider__typ, 0x0d); + } else { + Files_Write(&msg.r, Files_Rider__typ, ch); + } + } + } else { + Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org); + delta = ((Texts_Piece)u)->len; + while (delta > 1024) { + Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), ((LONGINT)(1024))); + Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), ((LONGINT)(1024))); + delta -= 1024; + } + Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), delta); + Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), delta); + } + } else __WITHCHK; + } else { + iden.mod[0] = 0x00; + (*__GUARDP(u, Texts_ElemDesc, 1)->handle)(__GUARDP(u, Texts_ElemDesc, 1), (void*)&iden, Texts_IdentifyMsg__typ); + if (iden.mod[0] != 0x00) { + Files_Write(&msg.r, Files_Rider__typ, 0x1c); + } + } + u = u->next; + } + __GUARDEQR(r, r__typ, Files_Rider) = msg.r; + if (T->notify != NIL) { + (*T->notify)(T, 3, ((LONGINT)(0)), ((LONGINT)(0))); + } + Store__39_s = _s.lnk; +} + +void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len) +{ + Files_File f = NIL; + Files_Rider r; + INTEGER i, res; + CHAR bak[64]; + __DUP(name, name__len, CHAR); + f = Files_New(name, name__len); + Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(0))); + Files_Write(&r, Files_Rider__typ, 0xf0); + Files_Write(&r, Files_Rider__typ, 0x01); + Texts_Store(&r, Files_Rider__typ, T); + i = 0; + while (name[__X(i, name__len)] != 0x00) { + i += 1; + } + __COPY(name, bak, ((LONGINT)(64))); + bak[__X(i, ((LONGINT)(64)))] = '.'; + bak[__X(i + 1, ((LONGINT)(64)))] = 'B'; + bak[__X(i + 2, ((LONGINT)(64)))] = 'a'; + bak[__X(i + 3, ((LONGINT)(64)))] = 'k'; + bak[__X(i + 4, ((LONGINT)(64)))] = 0x00; + Files_Rename(name, name__len, bak, ((LONGINT)(64)), &res); + Files_Register(f); + __DEL(name); +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(Texts_new); + P(Texts_del); + P(Texts_FontsDefault); +} + +__TDESC(Texts_FontDesc, 1, 0) = {__TDFLDS("FontDesc", 32), {-4}}; +__TDESC(Texts_RunDesc, 1, 3) = {__TDFLDS("RunDesc", 20), {0, 4, 12, -16}}; +__TDESC(Texts_PieceDesc, 1, 4) = {__TDFLDS("PieceDesc", 28), {0, 4, 12, 20, -20}}; +__TDESC(Texts_ElemMsg, 1, 0) = {__TDFLDS("ElemMsg", 1), {-4}}; +__TDESC(Texts_ElemDesc, 1, 4) = {__TDFLDS("ElemDesc", 36), {0, 4, 12, 32, -20}}; +__TDESC(Texts_FileMsg, 1, 1) = {__TDFLDS("FileMsg", 28), {16, -8}}; +__TDESC(Texts_CopyMsg, 1, 1) = {__TDFLDS("CopyMsg", 4), {0, -8}}; +__TDESC(Texts_IdentifyMsg, 1, 0) = {__TDFLDS("IdentifyMsg", 64), {-4}}; +__TDESC(Texts_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 8), {4, -8}}; +__TDESC(Texts_TextDesc, 1, 2) = {__TDFLDS("TextDesc", 20), {8, 12, -12}}; +__TDESC(Texts_Reader, 1, 4) = {__TDFLDS("Reader", 48), {4, 12, 24, 36, -20}}; +__TDESC(Texts_Scanner, 1, 4) = {__TDFLDS("Scanner", 140), {4, 12, 24, 36, -20}}; +__TDESC(Texts_Writer, 1, 4) = {__TDFLDS("Writer", 36), {0, 4, 20, 32, -20}}; +__TDESC(Texts__1, 1, 5) = {__TDFLDS("", 112), {0, 4, 12, 32, 36, -24}}; + +export void *Texts__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Files); + __MODULE_IMPORT(Modules); + __MODULE_IMPORT(Reals); + __REGMOD("Texts", EnumPtrs); + __INITYP(Texts_FontDesc, Texts_FontDesc, 0); + __INITYP(Texts_RunDesc, Texts_RunDesc, 0); + __INITYP(Texts_PieceDesc, Texts_RunDesc, 1); + __INITYP(Texts_ElemMsg, Texts_ElemMsg, 0); + __INITYP(Texts_ElemDesc, Texts_RunDesc, 1); + __INITYP(Texts_FileMsg, Texts_ElemMsg, 1); + __INITYP(Texts_CopyMsg, Texts_ElemMsg, 1); + __INITYP(Texts_IdentifyMsg, Texts_ElemMsg, 1); + __INITYP(Texts_BufDesc, Texts_BufDesc, 0); + __INITYP(Texts_TextDesc, Texts_TextDesc, 0); + __INITYP(Texts_Reader, Texts_Reader, 0); + __INITYP(Texts_Scanner, Texts_Reader, 1); + __INITYP(Texts_Writer, Texts_Writer, 0); + __INITYP(Texts__1, Texts_ElemDesc, 2); +/* BEGIN */ + Texts_del = NIL; + __NEW(Texts_FontsDefault, Texts_FontDesc); + __MOVE("Syntax10.Scn.Fnt", Texts_FontsDefault->name, 17); + __ENDMOD; +} diff --git a/bootstrap/unix-44/Texts.h b/bootstrap/unix-44/Texts.h new file mode 100644 index 00000000..354c7ce7 --- /dev/null +++ b/bootstrap/unix-44/Texts.h @@ -0,0 +1,172 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Texts__h +#define Texts__h + +#include "SYSTEM.h" +#include "Files.h" + +typedef + struct Texts_BufDesc { + LONGINT len; + char _prvt0[4]; + } Texts_BufDesc; + +typedef + Texts_BufDesc *Texts_Buffer; + +typedef + struct Texts_ElemMsg { + char _prvt0[1]; + } Texts_ElemMsg; + +typedef + struct Texts_ElemDesc *Texts_Elem; + +typedef + struct Texts_CopyMsg { /* Texts_ElemMsg */ + Texts_Elem e; + } Texts_CopyMsg; + +typedef + struct Texts_RunDesc { + LONGINT _prvt0; + char _prvt1[15]; + } Texts_RunDesc; + +typedef + void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, LONGINT *); + +typedef + struct Texts_ElemDesc { + char _prvt0[20]; + LONGINT W, H; + Texts_Handler handle; + char _prvt1[4]; + } Texts_ElemDesc; + +typedef + struct Texts_FileMsg { /* Texts_ElemMsg */ + INTEGER id; + LONGINT pos; + Files_Rider r; + } Texts_FileMsg; + +typedef + struct Texts_FontDesc { + char _prvt0[32]; + } Texts_FontDesc; + +typedef + Texts_FontDesc *Texts_FontsFont; + +typedef + struct Texts_IdentifyMsg { /* Texts_ElemMsg */ + CHAR mod[32], proc[32]; + } Texts_IdentifyMsg; + +typedef + struct Texts_TextDesc *Texts_Text; + +typedef + void (*Texts_Notifier)(Texts_Text, INTEGER, LONGINT, LONGINT); + +typedef + struct Texts_Reader { + BOOLEAN eot; + Texts_FontsFont fnt; + SHORTINT col, voff; + Texts_Elem elem; + char _prvt0[32]; + } Texts_Reader; + +typedef + struct Texts_Scanner { /* Texts_Reader */ + BOOLEAN eot; + Texts_FontsFont fnt; + SHORTINT col, voff; + Texts_Elem elem; + char _prvt0[32]; + CHAR nextCh; + INTEGER line, class; + LONGINT i; + REAL x; + LONGREAL y; + CHAR c; + SHORTINT len; + CHAR s[64]; + } Texts_Scanner; + +typedef + struct Texts_TextDesc { + LONGINT len; + Texts_Notifier notify; + char _prvt0[12]; + } Texts_TextDesc; + +typedef + struct Texts_Writer { + Texts_Buffer buf; + Texts_FontsFont fnt; + SHORTINT col, voff; + char _prvt0[26]; + } Texts_Writer; + + +import Texts_Elem Texts_new; + +import LONGINT *Texts_FontDesc__typ; +import LONGINT *Texts_RunDesc__typ; +import LONGINT *Texts_ElemMsg__typ; +import LONGINT *Texts_ElemDesc__typ; +import LONGINT *Texts_FileMsg__typ; +import LONGINT *Texts_CopyMsg__typ; +import LONGINT *Texts_IdentifyMsg__typ; +import LONGINT *Texts_BufDesc__typ; +import LONGINT *Texts_TextDesc__typ; +import LONGINT *Texts_Reader__typ; +import LONGINT *Texts_Scanner__typ; +import LONGINT *Texts_Writer__typ; + +import void Texts_Append (Texts_Text T, Texts_Buffer B); +import void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff); +import void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len); +import void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB); +import void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE); +import void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end); +import Texts_Text Texts_ElemBase (Texts_Elem E); +import LONGINT Texts_ElemPos (Texts_Elem E); +import void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B); +import void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +import void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len); +import void Texts_OpenBuf (Texts_Buffer B); +import void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos); +import void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos); +import void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ); +import LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ); +import void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch); +import void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ); +import void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ); +import void Texts_Recall (Texts_Buffer *B); +import void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B); +import void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ); +import void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col); +import void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt); +import void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff); +import void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +import void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch); +import void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d); +import void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e); +import void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x); +import void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n); +import void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ); +import void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n); +import void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x); +import void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n); +import void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k); +import void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x); +import void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len); +import void *Texts__init(void); + + +#endif diff --git a/bootstrap/unix-44/Vishap.c b/bootstrap/unix-44/Vishap.c new file mode 100644 index 00000000..2b9c3901 --- /dev/null +++ b/bootstrap/unix-44/Vishap.c @@ -0,0 +1,168 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkamSf */ +#include "SYSTEM.h" +#include "Configuration.h" +#include "Heap.h" +#include "OPB.h" +#include "OPC.h" +#include "OPM.h" +#include "OPP.h" +#include "OPT.h" +#include "OPV.h" +#include "Platform.h" +#include "Strings.h" +#include "extTools.h" +#include "vt100.h" + + +static CHAR Vishap_mname[256]; + + +export void Vishap_Module (BOOLEAN *done); +static void Vishap_PropagateElementaryTypeSizes (void); +export void Vishap_Translate (void); +static void Vishap_Trap (INTEGER sig); + + +void Vishap_Module (BOOLEAN *done) +{ + BOOLEAN ext, new; + OPT_Node p = NIL; + OPP_Module(&p, OPM_opt); + if (OPM_noerr) { + OPV_Init(); + OPV_AdrAndSize(OPT_topScope); + OPT_Export(&ext, &new); + if (OPM_noerr) { + OPM_OpenFiles((void*)OPT_SelfName, ((LONGINT)(256))); + OPC_Init(); + OPV_Module(p); + if (OPM_noerr) { + if (((OPM_mainProg || OPM_mainLinkStat) && __STRCMP(OPM_modName, "SYSTEM") != 0)) { + OPM_DeleteNewSym(); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"32m", (LONGINT)4); + } + OPM_LogWStr((CHAR*)" Main program.", (LONGINT)16); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + } else { + if (new) { + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"32m", (LONGINT)4); + } + OPM_LogWStr((CHAR*)" New symbol file.", (LONGINT)19); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + OPM_RegisterNewSym(); + } else if (ext) { + OPM_LogWStr((CHAR*)" Extended symbol file.", (LONGINT)24); + OPM_RegisterNewSym(); + } + } + } else { + OPM_DeleteNewSym(); + } + } + } + OPM_CloseFiles(); + OPT_Close(); + OPM_LogWLn(); + *done = OPM_noerr; +} + +static void Vishap_PropagateElementaryTypeSizes (void) +{ + OPT_bytetyp->size = OPM_ByteSize; + OPT_sysptrtyp->size = OPM_PointerSize; + OPT_chartyp->size = OPM_CharSize; + OPT_settyp->size = OPM_SetSize; + OPT_realtyp->size = OPM_RealSize; + OPT_inttyp->size = OPM_IntSize; + OPT_linttyp->size = OPM_LIntSize; + OPT_lrltyp->size = OPM_LRealSize; + OPT_sinttyp->size = OPM_SIntSize; + OPT_booltyp->size = OPM_BoolSize; +} + +void Vishap_Translate (void) +{ + BOOLEAN done; + CHAR modulesobj[2048]; + modulesobj[0] = 0x00; + if (OPM_OpenPar()) { + for (;;) { + OPM_Init(&done, (void*)Vishap_mname, ((LONGINT)(256))); + if (!done) { + return; + } + OPM_InitOptions(); + Vishap_PropagateElementaryTypeSizes(); + Heap_GC(0); + Vishap_Module(&done); + if (!done) { + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Module compilation failed.", (LONGINT)27); + OPM_LogWLn(); + Platform_Exit(1); + } + if (!OPM_dontAsm) { + if (OPM_dontLink) { + extTools_Assemble(OPM_modName, ((LONGINT)(32))); + } else { + if (!(OPM_mainProg || OPM_mainLinkStat)) { + extTools_Assemble(OPM_modName, ((LONGINT)(32))); + Strings_Append((CHAR*)" ", (LONGINT)2, (void*)modulesobj, ((LONGINT)(2048))); + Strings_Append(OPM_modName, ((LONGINT)(32)), (void*)modulesobj, ((LONGINT)(2048))); + Strings_Append((CHAR*)".o", (LONGINT)3, (void*)modulesobj, ((LONGINT)(2048))); + } else { + extTools_LinkMain((void*)OPM_modName, ((LONGINT)(32)), OPM_mainLinkStat, modulesobj, ((LONGINT)(2048))); + } + } + } + } + } +} + +static void Vishap_Trap (INTEGER sig) +{ + Heap_FINALL(); + if (sig == 3) { + Platform_Exit(0); + } else { + if ((sig == 4 && Platform_HaltCode == -15)) { + OPM_LogWStr((CHAR*)" --- Vishap Oberon: internal error", (LONGINT)35); + OPM_LogWLn(); + } + Platform_Exit(2); + } +} + + +export int main(int argc, char **argv) +{ + __INIT(argc, argv); + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Heap); + __MODULE_IMPORT(OPB); + __MODULE_IMPORT(OPC); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPP); + __MODULE_IMPORT(OPT); + __MODULE_IMPORT(OPV); + __MODULE_IMPORT(Platform); + __MODULE_IMPORT(Strings); + __MODULE_IMPORT(extTools); + __MODULE_IMPORT(vt100); + __REGMAIN("Vishap", 0); + __REGCMD("Translate", Vishap_Translate); +/* BEGIN */ + Platform_SetInterruptHandler(Vishap_Trap); + Platform_SetQuitHandler(Vishap_Trap); + Platform_SetBadInstructionHandler(Vishap_Trap); + OPB_typSize = OPV_TypSize; + OPT_typSize = OPV_TypSize; + Vishap_Translate(); + __FINI; +} diff --git a/bootstrap/unix-44/WindowsWrapper.h b/bootstrap/unix-44/WindowsWrapper.h new file mode 100644 index 00000000..cdb8714c --- /dev/null +++ b/bootstrap/unix-44/WindowsWrapper.h @@ -0,0 +1,9 @@ +// WindowsWrapper.h +// +// Includes Windows.h while avoiding conflicts with Oberon types. + +#undef BOOLEAN +#undef CHAR +#include +#define BOOLEAN char +#define CHAR unsigned char diff --git a/bootstrap/unix-44/errors.c b/bootstrap/unix-44/errors.c new file mode 100644 index 00000000..25a074a9 --- /dev/null +++ b/bootstrap/unix-44/errors.c @@ -0,0 +1,198 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" + +typedef + CHAR errors_string[128]; + + +export errors_string errors_errors[350]; + + + + + +export void *errors__init(void) +{ + __DEFMOD; + __REGMOD("errors", 0); +/* BEGIN */ + __MOVE("undeclared identifier", errors_errors[0], 22); + __MOVE("multiply defined identifier", errors_errors[1], 28); + __MOVE("illegal character in number", errors_errors[2], 28); + __MOVE("illegal character in string", errors_errors[3], 28); + __MOVE("identifier does not match procedure name", errors_errors[4], 41); + __MOVE("comment not closed", errors_errors[5], 19); + errors_errors[6][0] = 0x00; + errors_errors[7][0] = 0x00; + errors_errors[8][0] = 0x00; + __MOVE("\'=\' expected", errors_errors[9], 13); + errors_errors[10][0] = 0x00; + errors_errors[11][0] = 0x00; + __MOVE("type definition starts with incorrect symbol", errors_errors[12], 45); + __MOVE("factor starts with incorrect symbol", errors_errors[13], 36); + __MOVE("statement starts with incorrect symbol", errors_errors[14], 39); + __MOVE("declaration followed by incorrect symbol", errors_errors[15], 41); + __MOVE("MODULE expected", errors_errors[16], 16); + errors_errors[17][0] = 0x00; + __MOVE("\'.\' missing", errors_errors[18], 12); + __MOVE("\',\' missing", errors_errors[19], 12); + __MOVE("\':\' missing", errors_errors[20], 12); + errors_errors[21][0] = 0x00; + __MOVE("\')\' missing", errors_errors[22], 12); + __MOVE("\']\' missing", errors_errors[23], 12); + __MOVE("\'}\' missing", errors_errors[24], 12); + __MOVE("OF missing", errors_errors[25], 11); + __MOVE("THEN missing", errors_errors[26], 13); + __MOVE("DO missing", errors_errors[27], 11); + __MOVE("TO missing", errors_errors[28], 11); + errors_errors[29][0] = 0x00; + __MOVE("\'(\' missing", errors_errors[30], 12); + errors_errors[31][0] = 0x00; + errors_errors[32][0] = 0x00; + errors_errors[33][0] = 0x00; + __MOVE("\':=\' missing", errors_errors[34], 13); + __MOVE("\',\' or OF expected", errors_errors[35], 19); + errors_errors[36][0] = 0x00; + errors_errors[37][0] = 0x00; + __MOVE("identifier expected", errors_errors[38], 20); + __MOVE("\';\' missing", errors_errors[39], 12); + errors_errors[40][0] = 0x00; + __MOVE("END missing", errors_errors[41], 12); + errors_errors[42][0] = 0x00; + errors_errors[43][0] = 0x00; + __MOVE("UNTIL missing", errors_errors[44], 14); + errors_errors[45][0] = 0x00; + __MOVE("EXIT not within loop statement", errors_errors[46], 31); + __MOVE("illegally marked identifier", errors_errors[47], 28); + errors_errors[48][0] = 0x00; + errors_errors[49][0] = 0x00; + __MOVE("expression should be constant", errors_errors[50], 30); + __MOVE("constant not an integer", errors_errors[51], 24); + __MOVE("identifier does not denote a type", errors_errors[52], 34); + __MOVE("identifier does not denote a record type", errors_errors[53], 41); + __MOVE("result type of procedure is not a basic type", errors_errors[54], 45); + __MOVE("procedure call of a function", errors_errors[55], 29); + __MOVE("assignment to non-variable", errors_errors[56], 27); + __MOVE("pointer not bound to record or array type", errors_errors[57], 42); + __MOVE("recursive type definition", errors_errors[58], 26); + __MOVE("illegal open array parameter", errors_errors[59], 29); + __MOVE("wrong type of case label", errors_errors[60], 25); + __MOVE("inadmissible type of case label", errors_errors[61], 32); + __MOVE("case label defined more than once", errors_errors[62], 34); + __MOVE("illegal value of constant", errors_errors[63], 26); + __MOVE("more actual than formal parameters", errors_errors[64], 35); + __MOVE("fewer actual than formal parameters", errors_errors[65], 36); + __MOVE("element types of actual array and formal open array differ", errors_errors[66], 59); + __MOVE("actual parameter corresponding to open array is not an array", errors_errors[67], 61); + __MOVE("control variable must be integer", errors_errors[68], 33); + __MOVE("parameter must be an integer constant", errors_errors[69], 38); + __MOVE("pointer or VAR record required as formal receiver", errors_errors[70], 50); + __MOVE("pointer expected as actual receiver", errors_errors[71], 36); + __MOVE("procedure must be bound to a record of the same scope", errors_errors[72], 54); + __MOVE("procedure must have level 0", errors_errors[73], 28); + __MOVE("procedure unknown in base type", errors_errors[74], 31); + __MOVE("invalid call of base procedure", errors_errors[75], 31); + __MOVE("this variable (field) is read only", errors_errors[76], 35); + __MOVE("object is not a record", errors_errors[77], 23); + __MOVE("dereferenced object is not a variable", errors_errors[78], 38); + __MOVE("indexed object is not a variable", errors_errors[79], 33); + __MOVE("index expression is not an integer", errors_errors[80], 35); + __MOVE("index out of specified bounds", errors_errors[81], 30); + __MOVE("indexed variable is not an array", errors_errors[82], 33); + __MOVE("undefined record field", errors_errors[83], 23); + __MOVE("dereferenced variable is not a pointer", errors_errors[84], 39); + __MOVE("guard or test type is not an extension of variable type", errors_errors[85], 56); + __MOVE("guard or testtype is not a pointer", errors_errors[86], 35); + __MOVE("guarded or tested variable is neither a pointer nor a VAR-parameter record", errors_errors[87], 75); + __MOVE("open array not allowed as variable, record field or array element", errors_errors[88], 66); + errors_errors[89][0] = 0x00; + errors_errors[90][0] = 0x00; + errors_errors[91][0] = 0x00; + __MOVE("operand of IN not an integer, or not a set", errors_errors[92], 43); + __MOVE("set element type is not an integer", errors_errors[93], 35); + __MOVE("operand of & is not of type BOOLEAN", errors_errors[94], 36); + __MOVE("operand of OR is not of type BOOLEAN", errors_errors[95], 37); + __MOVE("operand not applicable to (unary) +", errors_errors[96], 36); + __MOVE("operand not applicable to (unary) -", errors_errors[97], 36); + __MOVE("operand of ~ is not of type BOOLEAN", errors_errors[98], 36); + __MOVE("ASSERT fault", errors_errors[99], 13); + __MOVE("incompatible operands of dyadic operator", errors_errors[100], 41); + __MOVE("operand type inapplicable to *", errors_errors[101], 31); + __MOVE("operand type inapplicable to /", errors_errors[102], 31); + __MOVE("operand type inapplicable to DIV", errors_errors[103], 33); + __MOVE("operand type inapplicable to MOD", errors_errors[104], 33); + __MOVE("operand type inapplicable to +", errors_errors[105], 31); + __MOVE("operand type inapplicable to -", errors_errors[106], 31); + __MOVE("operand type inapplicable to = or #", errors_errors[107], 36); + __MOVE("operand type inapplicable to relation", errors_errors[108], 38); + __MOVE("overriding method must be exported", errors_errors[109], 35); + __MOVE("operand is not a type", errors_errors[110], 22); + __MOVE("operand inapplicable to (this) function", errors_errors[111], 40); + __MOVE("operand is not a variable", errors_errors[112], 26); + __MOVE("incompatible assignment", errors_errors[113], 24); + __MOVE("string too long to be assigned", errors_errors[114], 31); + __MOVE("parameter doesn\'t match", errors_errors[115], 24); + __MOVE("number of parameters doesn\'t match", errors_errors[116], 35); + __MOVE("result type doesn\'t match", errors_errors[117], 26); + __MOVE("export mark doesn\'t match with forward declaration", errors_errors[118], 51); + __MOVE("redefinition textually precedes procedure bound to base type", errors_errors[119], 61); + __MOVE("type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN", errors_errors[120], 71); + __MOVE("called object is not a procedure (or is an interrupt procedure)", errors_errors[121], 64); + __MOVE("actual VAR-parameter is not a variable", errors_errors[122], 39); + __MOVE("type of actual parameter is not identical with that of formal VAR-parameter", errors_errors[123], 76); + __MOVE("type of result expression differs from that of procedure", errors_errors[124], 57); + __MOVE("type of case expression is neither INTEGER nor CHAR", errors_errors[125], 52); + __MOVE("this expression cannot be a type or a procedure", errors_errors[126], 48); + __MOVE("illegal use of object", errors_errors[127], 22); + __MOVE("unsatisfied forward reference", errors_errors[128], 30); + __MOVE("unsatisfied forward procedure", errors_errors[129], 30); + __MOVE("WITH clause does not specify a variable", errors_errors[130], 40); + __MOVE("LEN not applied to array", errors_errors[131], 25); + __MOVE("dimension in LEN too large or negative", errors_errors[132], 39); + __MOVE("SYSTEM not imported", errors_errors[135], 20); + __MOVE("key inconsistency of imported module", errors_errors[150], 37); + __MOVE("incorrect symbol file", errors_errors[151], 22); + __MOVE("symbol file of imported module not found", errors_errors[152], 41); + __MOVE("object or symbol file not opened (disk full\?)", errors_errors[153], 46); + __MOVE("recursive import not allowed", errors_errors[154], 29); + __MOVE("generation of new symbol file not allowed", errors_errors[155], 42); + __MOVE("parameter file not found", errors_errors[156], 25); + __MOVE("syntax error in parameter file", errors_errors[157], 31); + __MOVE("not yet implemented", errors_errors[200], 20); + __MOVE("lower bound of set range greater than higher bound", errors_errors[201], 51); + __MOVE("set element greater than MAX(SET) or less than 0", errors_errors[202], 49); + __MOVE("number too large", errors_errors[203], 17); + __MOVE("product too large", errors_errors[204], 18); + __MOVE("division by zero", errors_errors[205], 17); + __MOVE("sum too large", errors_errors[206], 14); + __MOVE("difference too large", errors_errors[207], 21); + __MOVE("overflow in arithmetic shift", errors_errors[208], 29); + __MOVE("case range too large", errors_errors[209], 21); + __MOVE("too many cases in case statement", errors_errors[213], 33); + __MOVE("illegal value of parameter (0 <= p < 256)", errors_errors[218], 42); + __MOVE("machine registers cannot be accessed", errors_errors[219], 37); + __MOVE("illegal value of parameter", errors_errors[220], 27); + __MOVE("too many pointers in a record", errors_errors[221], 30); + __MOVE("too many global pointers", errors_errors[222], 25); + __MOVE("too many record types", errors_errors[223], 22); + __MOVE("too many pointer types", errors_errors[224], 23); + __MOVE("address of pointer variable too large (move forward in text)", errors_errors[225], 61); + __MOVE("too many exported procedures", errors_errors[226], 29); + __MOVE("too many imported modules", errors_errors[227], 26); + __MOVE("too many exported structures", errors_errors[228], 29); + __MOVE("too many nested records for import", errors_errors[229], 35); + __MOVE("too many constants (strings) in module", errors_errors[230], 39); + __MOVE("too many link table entries (external procedures)", errors_errors[231], 50); + __MOVE("too many commands in module", errors_errors[232], 28); + __MOVE("record extension hierarchy too high", errors_errors[233], 36); + __MOVE("export of recursive type not allowed", errors_errors[234], 37); + __MOVE("identifier too long", errors_errors[240], 20); + __MOVE("string too long", errors_errors[241], 16); + __MOVE("address overflow", errors_errors[242], 17); + __MOVE("cyclic type definition not allowed", errors_errors[244], 35); + __MOVE("guarded pointer variable may be manipulated by non-local operations; use auxiliary pointer variable", errors_errors[245], 100); + __MOVE("implicit type cast", errors_errors[301], 19); + __MOVE("inappropriate symbol file ignored", errors_errors[306], 34); + __MOVE("no ELSE symbol after CASE statement sequence may lead to trap", errors_errors[307], 62); + __ENDMOD; +} diff --git a/bootstrap/unix-44/errors.h b/bootstrap/unix-44/errors.h new file mode 100644 index 00000000..c4fe8850 --- /dev/null +++ b/bootstrap/unix-44/errors.h @@ -0,0 +1,18 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef errors__h +#define errors__h + +#include "SYSTEM.h" + +typedef + CHAR errors_string[128]; + + +import errors_string errors_errors[350]; + + +import void *errors__init(void); + + +#endif diff --git a/bootstrap/unix-44/extTools.c b/bootstrap/unix-44/extTools.c new file mode 100644 index 00000000..6f1a6654 --- /dev/null +++ b/bootstrap/unix-44/extTools.c @@ -0,0 +1,112 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "Configuration.h" +#include "Console.h" +#include "OPM.h" +#include "Platform.h" +#include "Strings.h" + + +static CHAR extTools_compilationOptions[1023], extTools_CFLAGS[1023]; + + +export void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len); +export void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len); +static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len); + + +static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len) +{ + INTEGER r, status, exitcode; + __DUP(title, title__len, CHAR); + __DUP(cmd, cmd__len, CHAR); + if (OPM_Verbose) { + Console_String(title, title__len); + Console_String(cmd, cmd__len); + Console_Ln(); + } + r = Platform_System(cmd, cmd__len); + status = __MASK(r, -128); + exitcode = __ASHR(r, 8); + if (exitcode > 127) { + exitcode = exitcode - 256; + } + if (r != 0) { + Console_String(title, title__len); + Console_String(cmd, cmd__len); + Console_Ln(); + Console_String((CHAR*)"-- failed: status ", (LONGINT)19); + Console_Int(status, ((LONGINT)(1))); + Console_String((CHAR*)", exitcode ", (LONGINT)12); + Console_Int(exitcode, ((LONGINT)(1))); + Console_String((CHAR*)".", (LONGINT)2); + Console_Ln(); + if ((status == 0 && exitcode == 127)) { + Console_String((CHAR*)"Is the C compiler in the current command path\?", (LONGINT)47); + Console_Ln(); + } + if (status != 0) { + Platform_Halt(status); + } else { + Platform_Halt(exitcode); + } + } + __DEL(title); + __DEL(cmd); +} + +void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len) +{ + CHAR cmd[1023]; + __DUP(moduleName, moduleName__len, CHAR); + __MOVE("gcc -g", cmd, 7); + Strings_Append(extTools_compilationOptions, ((LONGINT)(1023)), (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)"-c ", (LONGINT)4, (void*)cmd, ((LONGINT)(1023))); + Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)".c", (LONGINT)3, (void*)cmd, ((LONGINT)(1023))); + extTools_execute((CHAR*)"Assemble: ", (LONGINT)11, cmd, ((LONGINT)(1023))); + __DEL(moduleName); +} + +void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len) +{ + CHAR cmd[1023]; + __DUP(additionalopts, additionalopts__len, CHAR); + __MOVE("gcc -g", cmd, 7); + Strings_Append((CHAR*)" ", (LONGINT)2, (void*)cmd, ((LONGINT)(1023))); + Strings_Append(extTools_compilationOptions, ((LONGINT)(1023)), (void*)cmd, ((LONGINT)(1023))); + Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)".c ", (LONGINT)4, (void*)cmd, ((LONGINT)(1023))); + Strings_Append(additionalopts, additionalopts__len, (void*)cmd, ((LONGINT)(1023))); + if (statically) { + Strings_Append((CHAR*)"-static", (LONGINT)8, (void*)cmd, ((LONGINT)(1023))); + } + Strings_Append((CHAR*)" -o ", (LONGINT)5, (void*)cmd, ((LONGINT)(1023))); + Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)" -L\"", (LONGINT)5, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)"/lib\"", (LONGINT)6, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)" -l voc", (LONGINT)8, (void*)cmd, ((LONGINT)(1023))); + extTools_execute((CHAR*)"Assemble and link: ", (LONGINT)20, cmd, ((LONGINT)(1023))); + __DEL(additionalopts); +} + + +export void *extTools__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Console); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(Platform); + __MODULE_IMPORT(Strings); + __REGMOD("extTools", 0); +/* BEGIN */ + Strings_Append((CHAR*)" -I \"", (LONGINT)6, (void*)extTools_compilationOptions, ((LONGINT)(1023))); + Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)extTools_compilationOptions, ((LONGINT)(1023))); + Strings_Append((CHAR*)"/include\" ", (LONGINT)11, (void*)extTools_compilationOptions, ((LONGINT)(1023))); + Platform_GetEnv((CHAR*)"CFLAGS", (LONGINT)7, (void*)extTools_CFLAGS, ((LONGINT)(1023))); + Strings_Append(extTools_CFLAGS, ((LONGINT)(1023)), (void*)extTools_compilationOptions, ((LONGINT)(1023))); + Strings_Append((CHAR*)" ", (LONGINT)2, (void*)extTools_compilationOptions, ((LONGINT)(1023))); + __ENDMOD; +} diff --git a/bootstrap/unix-44/extTools.h b/bootstrap/unix-44/extTools.h new file mode 100644 index 00000000..95d07ddd --- /dev/null +++ b/bootstrap/unix-44/extTools.h @@ -0,0 +1,16 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef extTools__h +#define extTools__h + +#include "SYSTEM.h" + + + + +import void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len); +import void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len); +import void *extTools__init(void); + + +#endif diff --git a/bootstrap/unix-44/vt100.c b/bootstrap/unix-44/vt100.c new file mode 100644 index 00000000..649ea068 --- /dev/null +++ b/bootstrap/unix-44/vt100.c @@ -0,0 +1,258 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "Console.h" +#include "Strings.h" + + +export CHAR vt100_CSI[5]; +static CHAR vt100_tmpstr[32]; + + +export void vt100_CHA (INTEGER n); +export void vt100_CNL (INTEGER n); +export void vt100_CPL (INTEGER n); +export void vt100_CUB (INTEGER n); +export void vt100_CUD (INTEGER n); +export void vt100_CUF (INTEGER n); +export void vt100_CUP (INTEGER n, INTEGER m); +export void vt100_CUU (INTEGER n); +export void vt100_DECTCEMh (void); +export void vt100_DECTCEMl (void); +export void vt100_DSR (INTEGER n); +export void vt100_ED (INTEGER n); +export void vt100_EL (INTEGER n); +static void vt100_EscSeq (INTEGER n, CHAR *letter, LONGINT letter__len); +static void vt100_EscSeq0 (CHAR *letter, LONGINT letter__len); +static void vt100_EscSeq2 (INTEGER n, INTEGER m, CHAR *letter, LONGINT letter__len); +static void vt100_EscSeqSwapped (INTEGER n, CHAR *letter, LONGINT letter__len); +export void vt100_HVP (INTEGER n, INTEGER m); +export void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len); +export void vt100_RCP (void); +static void vt100_Reverse0 (CHAR *str, LONGINT str__len, INTEGER start, INTEGER end); +export void vt100_SCP (void); +export void vt100_SD (INTEGER n); +export void vt100_SGR (INTEGER n); +export void vt100_SGR2 (INTEGER n, INTEGER m); +export void vt100_SU (INTEGER n); +export void vt100_SetAttr (CHAR *attr, LONGINT attr__len); + + +static void vt100_Reverse0 (CHAR *str, LONGINT str__len, INTEGER start, INTEGER end) +{ + CHAR h; + while (start < end) { + h = str[__X(start, str__len)]; + str[__X(start, str__len)] = str[__X(end, str__len)]; + str[__X(end, str__len)] = h; + start += 1; + end -= 1; + } +} + +void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len) +{ + CHAR b[21]; + INTEGER s, e; + SHORTINT maxLength; + maxLength = 11; + if (int_ == (-2147483647-1)) { + __MOVE("-2147483648", b, 12); + e = 11; + } else { + if (int_ < 0) { + b[0] = '-'; + int_ = -int_; + s = 1; + } else { + s = 0; + } + e = s; + do { + b[__X(e, ((LONGINT)(21)))] = (CHAR)(__MOD(int_, 10) + 48); + int_ = __DIV(int_, 10); + e += 1; + } while (!(int_ == 0)); + b[__X(e, ((LONGINT)(21)))] = 0x00; + vt100_Reverse0((void*)b, ((LONGINT)(21)), s, e - 1); + } + __COPY(b, str, str__len); +} + +static void vt100_EscSeq0 (CHAR *letter, LONGINT letter__len) +{ + CHAR cmd[9]; + __DUP(letter, letter__len, CHAR); + __COPY(vt100_CSI, cmd, ((LONGINT)(9))); + Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(9))); + Console_String(cmd, ((LONGINT)(9))); + __DEL(letter); +} + +static void vt100_EscSeq (INTEGER n, CHAR *letter, LONGINT letter__len) +{ + CHAR nstr[2]; + CHAR cmd[7]; + __DUP(letter, letter__len, CHAR); + vt100_IntToStr(n, (void*)nstr, ((LONGINT)(2))); + __COPY(vt100_CSI, cmd, ((LONGINT)(7))); + Strings_Append(nstr, ((LONGINT)(2)), (void*)cmd, ((LONGINT)(7))); + Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(7))); + Console_String(cmd, ((LONGINT)(7))); + __DEL(letter); +} + +static void vt100_EscSeqSwapped (INTEGER n, CHAR *letter, LONGINT letter__len) +{ + CHAR nstr[2]; + CHAR cmd[7]; + __DUP(letter, letter__len, CHAR); + vt100_IntToStr(n, (void*)nstr, ((LONGINT)(2))); + __COPY(vt100_CSI, cmd, ((LONGINT)(7))); + Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(7))); + Strings_Append(nstr, ((LONGINT)(2)), (void*)cmd, ((LONGINT)(7))); + Console_String(cmd, ((LONGINT)(7))); + __DEL(letter); +} + +static void vt100_EscSeq2 (INTEGER n, INTEGER m, CHAR *letter, LONGINT letter__len) +{ + CHAR nstr[5], mstr[5]; + CHAR cmd[12]; + __DUP(letter, letter__len, CHAR); + vt100_IntToStr(n, (void*)nstr, ((LONGINT)(5))); + vt100_IntToStr(m, (void*)mstr, ((LONGINT)(5))); + __COPY(vt100_CSI, cmd, ((LONGINT)(12))); + Strings_Append(nstr, ((LONGINT)(5)), (void*)cmd, ((LONGINT)(12))); + Strings_Append((CHAR*)";", (LONGINT)2, (void*)cmd, ((LONGINT)(12))); + Strings_Append(mstr, ((LONGINT)(5)), (void*)cmd, ((LONGINT)(12))); + Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(12))); + Console_String(cmd, ((LONGINT)(12))); + __DEL(letter); +} + +void vt100_CUU (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"A", (LONGINT)2); +} + +void vt100_CUD (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"B", (LONGINT)2); +} + +void vt100_CUF (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"C", (LONGINT)2); +} + +void vt100_CUB (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"D", (LONGINT)2); +} + +void vt100_CNL (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"E", (LONGINT)2); +} + +void vt100_CPL (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"F", (LONGINT)2); +} + +void vt100_CHA (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"G", (LONGINT)2); +} + +void vt100_CUP (INTEGER n, INTEGER m) +{ + vt100_EscSeq2(n, m, (CHAR*)"H", (LONGINT)2); +} + +void vt100_ED (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"J", (LONGINT)2); +} + +void vt100_EL (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"K", (LONGINT)2); +} + +void vt100_SU (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"S", (LONGINT)2); +} + +void vt100_SD (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"T", (LONGINT)2); +} + +void vt100_HVP (INTEGER n, INTEGER m) +{ + vt100_EscSeq2(n, m, (CHAR*)"f", (LONGINT)2); +} + +void vt100_SGR (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"m", (LONGINT)2); +} + +void vt100_SGR2 (INTEGER n, INTEGER m) +{ + vt100_EscSeq2(n, m, (CHAR*)"m", (LONGINT)2); +} + +void vt100_DSR (INTEGER n) +{ + vt100_EscSeq(6, (CHAR*)"n", (LONGINT)2); +} + +void vt100_SCP (void) +{ + vt100_EscSeq0((CHAR*)"s", (LONGINT)2); +} + +void vt100_RCP (void) +{ + vt100_EscSeq0((CHAR*)"u", (LONGINT)2); +} + +void vt100_DECTCEMl (void) +{ + vt100_EscSeq0((CHAR*)"\?25l", (LONGINT)5); +} + +void vt100_DECTCEMh (void) +{ + vt100_EscSeq0((CHAR*)"\?25h", (LONGINT)5); +} + +void vt100_SetAttr (CHAR *attr, LONGINT attr__len) +{ + CHAR tmpstr[16]; + __DUP(attr, attr__len, CHAR); + __COPY(vt100_CSI, tmpstr, ((LONGINT)(16))); + Strings_Append(attr, attr__len, (void*)tmpstr, ((LONGINT)(16))); + Console_String(tmpstr, ((LONGINT)(16))); + __DEL(attr); +} + + +export void *vt100__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Console); + __MODULE_IMPORT(Strings); + __REGMOD("vt100", 0); + __REGCMD("DECTCEMh", vt100_DECTCEMh); + __REGCMD("DECTCEMl", vt100_DECTCEMl); + __REGCMD("RCP", vt100_RCP); + __REGCMD("SCP", vt100_SCP); +/* BEGIN */ + __COPY("", vt100_CSI, ((LONGINT)(5))); + Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5))); + __ENDMOD; +} diff --git a/bootstrap/unix-44/vt100.h b/bootstrap/unix-44/vt100.h new file mode 100644 index 00000000..6d210ec9 --- /dev/null +++ b/bootstrap/unix-44/vt100.h @@ -0,0 +1,37 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef vt100__h +#define vt100__h + +#include "SYSTEM.h" + + +import CHAR vt100_CSI[5]; + + +import void vt100_CHA (INTEGER n); +import void vt100_CNL (INTEGER n); +import void vt100_CPL (INTEGER n); +import void vt100_CUB (INTEGER n); +import void vt100_CUD (INTEGER n); +import void vt100_CUF (INTEGER n); +import void vt100_CUP (INTEGER n, INTEGER m); +import void vt100_CUU (INTEGER n); +import void vt100_DECTCEMh (void); +import void vt100_DECTCEMl (void); +import void vt100_DSR (INTEGER n); +import void vt100_ED (INTEGER n); +import void vt100_EL (INTEGER n); +import void vt100_HVP (INTEGER n, INTEGER m); +import void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len); +import void vt100_RCP (void); +import void vt100_SCP (void); +import void vt100_SD (INTEGER n); +import void vt100_SGR (INTEGER n); +import void vt100_SGR2 (INTEGER n, INTEGER m); +import void vt100_SU (INTEGER n); +import void vt100_SetAttr (CHAR *attr, LONGINT attr__len); +import void *vt100__init(void); + + +#endif diff --git a/bootstrap/unix-48/Configuration.c b/bootstrap/unix-48/Configuration.c new file mode 100644 index 00000000..a1992033 --- /dev/null +++ b/bootstrap/unix-48/Configuration.c @@ -0,0 +1,16 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" + + + + + + + +export void *Configuration__init(void) +{ + __DEFMOD; + __REGMOD("Configuration", 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-48/Configuration.h b/bootstrap/unix-48/Configuration.h new file mode 100644 index 00000000..e7aed50a --- /dev/null +++ b/bootstrap/unix-48/Configuration.h @@ -0,0 +1,14 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Configuration__h +#define Configuration__h + +#include "SYSTEM.h" + + + + +import void *Configuration__init(void); + + +#endif diff --git a/bootstrap/unix-48/Console.c b/bootstrap/unix-48/Console.c new file mode 100644 index 00000000..7f8fd8c0 --- /dev/null +++ b/bootstrap/unix-48/Console.c @@ -0,0 +1,150 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "Platform.h" + + +static CHAR Console_line[128]; +static INTEGER Console_pos; + + +export void Console_Bool (BOOLEAN b); +export void Console_Char (CHAR ch); +export void Console_Flush (void); +export void Console_Hex (LONGINT i); +export void Console_Int (LONGINT i, LONGINT n); +export void Console_Ln (void); +export void Console_Read (CHAR *ch); +export void Console_ReadLine (CHAR *line, LONGINT line__len); +export void Console_String (CHAR *s, LONGINT s__len); + + +void Console_Flush (void) +{ + INTEGER error; + error = Platform_Write(((LONGINT)(1)), (LONGINT)(uintptr_t)Console_line, Console_pos); + Console_pos = 0; +} + +void Console_Char (CHAR ch) +{ + if (Console_pos == 128) { + Console_Flush(); + } + Console_line[__X(Console_pos, ((LONGINT)(128)))] = ch; + Console_pos += 1; + if (ch == 0x0a) { + Console_Flush(); + } +} + +void Console_String (CHAR *s, LONGINT s__len) +{ + INTEGER i; + __DUP(s, s__len, CHAR); + i = 0; + while (s[__X(i, s__len)] != 0x00) { + Console_Char(s[__X(i, s__len)]); + i += 1; + } + __DEL(s); +} + +void Console_Int (LONGINT i, LONGINT n) +{ + CHAR s[32]; + LONGINT i1, k; + if (i == __LSHL(1, 31, LONGINT)) { + __MOVE("8463847412", s, 11); + k = 10; + } else { + i1 = __ABS(i); + s[0] = (CHAR)(__MOD(i1, 10) + 48); + i1 = __DIV(i1, 10); + k = 1; + while (i1 > 0) { + s[__X(k, ((LONGINT)(32)))] = (CHAR)(__MOD(i1, 10) + 48); + i1 = __DIV(i1, 10); + k += 1; + } + } + if (i < 0) { + s[__X(k, ((LONGINT)(32)))] = '-'; + k += 1; + } + while (n > k) { + Console_Char(' '); + n -= 1; + } + while (k > 0) { + k -= 1; + Console_Char(s[__X(k, ((LONGINT)(32)))]); + } +} + +void Console_Ln (void) +{ + Console_Char(0x0a); +} + +void Console_Bool (BOOLEAN b) +{ + if (b) { + Console_String((CHAR*)"TRUE", (LONGINT)5); + } else { + Console_String((CHAR*)"FALSE", (LONGINT)6); + } +} + +void Console_Hex (LONGINT i) +{ + LONGINT k, n; + k = -28; + while (k <= 0) { + n = __MASK(__ASH(i, k), -16); + if (n <= 9) { + Console_Char((CHAR)(48 + n)); + } else { + Console_Char((CHAR)(55 + n)); + } + k += 4; + } +} + +void Console_Read (CHAR *ch) +{ + LONGINT n; + INTEGER error; + Console_Flush(); + error = Platform_ReadBuf(((LONGINT)(0)), (void*)&*ch, ((LONGINT)(1)), &n); + if (n != 1) { + *ch = 0x00; + } +} + +void Console_ReadLine (CHAR *line, LONGINT line__len) +{ + LONGINT i; + CHAR ch; + Console_Flush(); + i = 0; + Console_Read(&ch); + while ((((i < line__len - 1 && ch != 0x0a)) && ch != 0x00)) { + line[__X(i, line__len)] = ch; + i += 1; + Console_Read(&ch); + } + line[__X(i, line__len)] = 0x00; +} + + +export void *Console__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Platform); + __REGMOD("Console", 0); + __REGCMD("Flush", Console_Flush); + __REGCMD("Ln", Console_Ln); +/* BEGIN */ + Console_pos = 0; + __ENDMOD; +} diff --git a/bootstrap/unix-48/Console.h b/bootstrap/unix-48/Console.h new file mode 100644 index 00000000..316e7e46 --- /dev/null +++ b/bootstrap/unix-48/Console.h @@ -0,0 +1,23 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Console__h +#define Console__h + +#include "SYSTEM.h" + + + + +import void Console_Bool (BOOLEAN b); +import void Console_Char (CHAR ch); +import void Console_Flush (void); +import void Console_Hex (LONGINT i); +import void Console_Int (LONGINT i, LONGINT n); +import void Console_Ln (void); +import void Console_Read (CHAR *ch); +import void Console_ReadLine (CHAR *line, LONGINT line__len); +import void Console_String (CHAR *s, LONGINT s__len); +import void *Console__init(void); + + +#endif diff --git a/bootstrap/unix-48/Files.c b/bootstrap/unix-48/Files.c new file mode 100644 index 00000000..f3b9b280 --- /dev/null +++ b/bootstrap/unix-48/Files.c @@ -0,0 +1,1078 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tspkaSfF */ +#include "SYSTEM.h" +#include "Configuration.h" +#include "Console.h" +#include "Heap.h" +#include "Platform.h" +#include "Strings.h" + +typedef + struct Files_Handle *Files_File; + +typedef + struct Files_BufDesc { + Files_File f; + BOOLEAN chg; + LONGINT org, size; + SYSTEM_BYTE data[4096]; + } Files_BufDesc; + +typedef + Files_BufDesc *Files_Buffer; + +typedef + CHAR Files_FileName[101]; + +typedef + struct Files_Handle { + Files_FileName workName, registerName; + BOOLEAN tempFile; + Platform_FileIdentity identity; + LONGINT fd, len, pos; + Files_Buffer bufs[4]; + INTEGER swapper, state; + } Files_Handle; + +typedef + struct Files_Rider { + LONGINT res; + BOOLEAN eof; + Files_Buffer buf; + LONGINT org, offset; + } Files_Rider; + + +static LONGINT Files_fileTab[256]; +static INTEGER Files_tempno; +static CHAR Files_HOME[1024]; +static struct { + LONGINT len[1]; + CHAR data[1]; +} *Files_SearchPath; + +export LONGINT *Files_Handle__typ; +export LONGINT *Files_BufDesc__typ; +export LONGINT *Files_Rider__typ; + +export Files_File Files_Base (Files_Rider *r, LONGINT *r__typ); +static Files_File Files_CacheEntry (Platform_FileIdentity identity); +export void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res); +export void Files_Close (Files_File f); +static void Files_Create (Files_File f); +export void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res); +static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INTEGER errcode); +static void Files_Finalize (SYSTEM_PTR o); +static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len); +static void Files_Flush (Files_Buffer buf); +export void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d); +export void Files_GetName (Files_File f, CHAR *name, LONGINT name__len); +static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len); +static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len); +static void Files_Init (void); +export LONGINT Files_Length (Files_File f); +static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len); +export Files_File Files_New (CHAR *name, LONGINT name__len); +export Files_File Files_Old (CHAR *name, LONGINT name__len); +export LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ); +export void Files_Purge (Files_File f); +export void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x); +export void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x); +export void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len); +export void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n); +export void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x); +export void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x); +export void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x); +export void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +export void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x); +export void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x); +export void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x); +export void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +export void Files_Register (Files_File f); +export void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res); +static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len); +export void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos); +export void Files_SetSearchPath (CHAR *path, LONGINT path__len); +export void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x); +export void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x); +export void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n); +export void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x); +export void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x); +export void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x); +export void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x); +export void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x); +export void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x); +export void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); + +#define Files_IdxTrap() __HALT(-1) + +static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INTEGER errcode) +{ + __DUP(s, s__len, CHAR); + Console_Ln(); + Console_String((CHAR*)"-- ", (LONGINT)4); + Console_String(s, s__len); + Console_String((CHAR*)": ", (LONGINT)3); + if (f != NIL) { + if (f->registerName[0] != 0x00) { + Console_String(f->registerName, ((LONGINT)(101))); + } else { + Console_String(f->workName, ((LONGINT)(101))); + } + if (f->fd != 0) { + Console_String((CHAR*)"f.fd = ", (LONGINT)8); + Console_Int(f->fd, ((LONGINT)(1))); + } + } + if (errcode != 0) { + Console_String((CHAR*)" errcode = ", (LONGINT)12); + Console_Int(errcode, ((LONGINT)(1))); + } + Console_Ln(); + __HALT(99); + __DEL(s); +} + +static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len) +{ + INTEGER i, j; + __DUP(dir, dir__len, CHAR); + __DUP(name, name__len, CHAR); + i = 0; + j = 0; + while (dir[i] != 0x00) { + dest[i] = dir[i]; + i += 1; + } + if (dest[i - 1] != '/') { + dest[i] = '/'; + i += 1; + } + while (name[j] != 0x00) { + dest[i] = name[j]; + i += 1; + j += 1; + } + dest[i] = 0x00; + __DEL(dir); + __DEL(name); +} + +static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len) +{ + LONGINT n, i, j; + __DUP(finalName, finalName__len, CHAR); + Files_tempno += 1; + n = Files_tempno; + i = 0; + if (finalName[0] != '/') { + while (Platform_CWD[i] != 0x00) { + name[i] = Platform_CWD[i]; + i += 1; + } + if (Platform_CWD[i - 1] != '/') { + name[i] = '/'; + i += 1; + } + } + j = 0; + while (finalName[j] != 0x00) { + name[i] = finalName[j]; + i += 1; + j += 1; + } + i -= 1; + while (name[i] != '/') { + i -= 1; + } + name[i + 1] = '.'; + name[i + 2] = 't'; + name[i + 3] = 'm'; + name[i + 4] = 'p'; + name[i + 5] = '.'; + i += 6; + while (n > 0) { + name[i] = (CHAR)(__MOD(n, 10) + 48); + n = __DIV(n, 10); + i += 1; + } + name[i] = '.'; + i += 1; + n = Platform_PID; + while (n > 0) { + name[i] = (CHAR)(__MOD(n, 10) + 48); + n = __DIV(n, 10); + i += 1; + } + name[i] = 0x00; + __DEL(finalName); +} + +static void Files_Create (Files_File f) +{ + Platform_FileIdentity identity; + BOOLEAN done; + INTEGER error; + CHAR err[32]; + if (f->fd == -1) { + if (f->state == 1) { + Files_GetTempName(f->registerName, ((LONGINT)(101)), (void*)f->workName, ((LONGINT)(101))); + f->tempFile = 1; + } else if (f->state == 2) { + __COPY(f->registerName, f->workName, ((LONGINT)(101))); + f->registerName[0] = 0x00; + f->tempFile = 0; + } + error = Platform_Unlink((void*)f->workName, ((LONGINT)(101))); + error = Platform_New((void*)f->workName, ((LONGINT)(101)), &f->fd); + done = error == 0; + if ((!done && Platform_TooManyFiles(error)) || (done && f->fd >= 256)) { + if ((done && f->fd >= 256)) { + error = Platform_Close(f->fd); + } + Heap_GC(1); + error = Platform_New((void*)f->workName, ((LONGINT)(101)), &f->fd); + done = f->fd == 0; + } + if (done) { + if (f->fd >= 256) { + error = Platform_Close(f->fd); + Files_Err((CHAR*)"too many files open", (LONGINT)20, f, 0); + } else { + Files_fileTab[f->fd] = (LONGINT)(uintptr_t)f; + Heap_FileCount += 1; + Heap_RegisterFinalizer((void*)f, Files_Finalize); + f->state = 0; + f->pos = 0; + error = Platform_Identify(f->fd, &f->identity, Platform_FileIdentity__typ); + } + } else { + if (Platform_NoSuchDirectory(error)) { + __MOVE("no such directory", err, 18); + } else if (Platform_TooManyFiles(error)) { + __MOVE("too many files open", err, 20); + } else { + __MOVE("file not created", err, 17); + } + Files_Err(err, ((LONGINT)(32)), f, error); + } + } +} + +static void Files_Flush (Files_Buffer buf) +{ + INTEGER error; + Files_File f = NIL; + if (buf->chg) { + f = buf->f; + Files_Create(f); + if (buf->org != f->pos) { + error = Platform_Seek(f->fd, buf->org, Platform_SeekSet); + } + error = Platform_Write(f->fd, (LONGINT)(uintptr_t)buf->data, buf->size); + if (error != 0) { + Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error); + } + f->pos = buf->org + buf->size; + buf->chg = 0; + error = Platform_Identify(f->fd, &f->identity, Platform_FileIdentity__typ); + if (error != 0) { + Files_Err((CHAR*)"error identifying file", (LONGINT)23, f, error); + } + } +} + +void Files_Close (Files_File f) +{ + LONGINT i; + INTEGER error; + if (f->state != 1 || f->registerName[0] != 0x00) { + Files_Create(f); + i = 0; + while ((i < 4 && f->bufs[i] != NIL)) { + Files_Flush(f->bufs[i]); + i += 1; + } + error = Platform_Sync(f->fd); + if (error != 0) { + Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error); + } + Files_fileTab[f->fd] = 0; + error = Platform_Close(f->fd); + f->fd = -1; + f->state = 1; + Heap_FileCount -= 1; + } +} + +LONGINT Files_Length (Files_File f) +{ + LONGINT _o_result; + _o_result = f->len; + return _o_result; +} + +Files_File Files_New (CHAR *name, LONGINT name__len) +{ + Files_File _o_result; + Files_File f = NIL; + __DUP(name, name__len, CHAR); + __NEW(f, Files_Handle); + f->workName[0] = 0x00; + __COPY(name, f->registerName, ((LONGINT)(101))); + f->fd = -1; + f->state = 1; + f->len = 0; + f->pos = 0; + f->swapper = -1; + _o_result = f; + __DEL(name); + return _o_result; +} + +static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len) +{ + INTEGER i; + CHAR ch; + i = 0; + if (Files_SearchPath == NIL) { + if (*pos == 0) { + dir[0] = '.'; + i = 1; + *pos += 1; + } + } else { + ch = (Files_SearchPath->data)[*pos]; + while (ch == ' ' || ch == ';') { + *pos += 1; + ch = (Files_SearchPath->data)[*pos]; + } + if (ch == '~') { + *pos += 1; + ch = (Files_SearchPath->data)[*pos]; + while (Files_HOME[i] != 0x00) { + dir[i] = Files_HOME[i]; + i += 1; + } + if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) { + while ((i > 0 && dir[i - 1] != '/')) { + i -= 1; + } + } + } + while ((ch != 0x00 && ch != ';')) { + dir[i] = ch; + i += 1; + *pos += 1; + ch = (Files_SearchPath->data)[*pos]; + } + while ((i > 0 && dir[i - 1] == ' ')) { + i -= 1; + } + } + dir[i] = 0x00; +} + +static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len) +{ + BOOLEAN _o_result; + INTEGER i; + CHAR ch; + i = 0; + ch = name[0]; + while ((ch != 0x00 && ch != '/')) { + i += 1; + ch = name[i]; + } + _o_result = ch == '/'; + return _o_result; +} + +static Files_File Files_CacheEntry (Platform_FileIdentity identity) +{ + Files_File _o_result; + Files_File f = NIL; + INTEGER i, error; + i = 0; + while (i < 256) { + f = (Files_File)(uintptr_t)Files_fileTab[i]; + if ((f != NIL && Platform_SameFile(identity, f->identity))) { + if (!Platform_SameFileTime(identity, f->identity)) { + i = 0; + while (i < 4) { + if (f->bufs[i] != NIL) { + f->bufs[i]->org = -1; + f->bufs[i] = NIL; + } + i += 1; + } + f->swapper = -1; + f->identity = identity; + error = Platform_Size(f->fd, &f->len); + } + _o_result = f; + return _o_result; + } + i += 1; + } + _o_result = NIL; + return _o_result; +} + +Files_File Files_Old (CHAR *name, LONGINT name__len) +{ + Files_File _o_result; + Files_File f = NIL; + LONGINT fd; + INTEGER pos; + BOOLEAN done; + CHAR dir[256], path[256]; + INTEGER error; + Platform_FileIdentity identity; + __DUP(name, name__len, CHAR); + if (name[0] != 0x00) { + if (Files_HasDir((void*)name, name__len)) { + dir[0] = 0x00; + __COPY(name, path, ((LONGINT)(256))); + } else { + pos = 0; + Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256))); + Files_MakeFileName(dir, ((LONGINT)(256)), name, name__len, (void*)path, ((LONGINT)(256))); + Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256))); + } + for (;;) { + error = Platform_OldRW((void*)path, ((LONGINT)(256)), &fd); + done = error == 0; + if ((!done && Platform_TooManyFiles(error)) || (done && fd >= 256)) { + if ((done && fd >= 256)) { + error = Platform_Close(fd); + } + Heap_GC(1); + error = Platform_OldRW((void*)path, ((LONGINT)(256)), &fd); + done = error == 0; + if ((!done && Platform_TooManyFiles(error))) { + Files_Err((CHAR*)"too many files open", (LONGINT)20, f, error); + } + } + if ((!done && Platform_Inaccessible(error))) { + error = Platform_OldRO((void*)path, ((LONGINT)(256)), &fd); + done = error == 0; + } + if ((!done && !Platform_Absent(error))) { + Console_String((CHAR*)"Warning: Files.Old ", (LONGINT)20); + Console_String(name, name__len); + Console_String((CHAR*)" error = ", (LONGINT)10); + Console_Int(error, ((LONGINT)(0))); + Console_Ln(); + } + if (done) { + error = Platform_Identify(fd, &identity, Platform_FileIdentity__typ); + f = Files_CacheEntry(identity); + if (f != NIL) { + error = Platform_Close(fd); + _o_result = f; + __DEL(name); + return _o_result; + } else if (fd >= 256) { + error = Platform_Close(fd); + Files_Err((CHAR*)"too many files open", (LONGINT)20, f, 0); + } else { + __NEW(f, Files_Handle); + Files_fileTab[fd] = (LONGINT)(uintptr_t)f; + Heap_FileCount += 1; + Heap_RegisterFinalizer((void*)f, Files_Finalize); + f->fd = fd; + f->state = 0; + f->pos = 0; + f->swapper = -1; + error = Platform_Size(fd, &f->len); + __COPY(name, f->workName, ((LONGINT)(101))); + f->registerName[0] = 0x00; + f->tempFile = 0; + f->identity = identity; + _o_result = f; + __DEL(name); + return _o_result; + } + } else if (dir[0] == 0x00) { + _o_result = NIL; + __DEL(name); + return _o_result; + } else { + Files_MakeFileName(dir, ((LONGINT)(256)), name, name__len, (void*)path, ((LONGINT)(256))); + Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256))); + } + } + } else { + _o_result = NIL; + __DEL(name); + return _o_result; + } + __RETCHK; +} + +void Files_Purge (Files_File f) +{ + INTEGER i; + Platform_FileIdentity identity; + INTEGER error; + i = 0; + while (i < 4) { + if (f->bufs[i] != NIL) { + f->bufs[i]->org = -1; + f->bufs[i] = NIL; + } + i += 1; + } + if (f->fd != -1) { + error = Platform_Truncate(f->fd, ((LONGINT)(0))); + error = Platform_Seek(f->fd, ((LONGINT)(0)), Platform_SeekSet); + } + f->pos = 0; + f->len = 0; + f->swapper = -1; + error = Platform_Identify(f->fd, &identity, Platform_FileIdentity__typ); + Platform_SetMTime(&f->identity, Platform_FileIdentity__typ, identity); +} + +void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d) +{ + Platform_FileIdentity identity; + INTEGER error; + Files_Create(f); + error = Platform_Identify(f->fd, &identity, Platform_FileIdentity__typ); + Platform_MTimeAsClock(identity, &*t, &*d); +} + +LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ) +{ + LONGINT _o_result; + _o_result = (*r).org + (*r).offset; + return _o_result; +} + +void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos) +{ + LONGINT org, offset, i, n; + Files_Buffer buf = NIL; + INTEGER error; + if (f != NIL) { + if (pos > f->len) { + pos = f->len; + } else if (pos < 0) { + pos = 0; + } + offset = __MASK(pos, -4096); + org = pos - offset; + i = 0; + while ((((i < 4 && f->bufs[i] != NIL)) && org != f->bufs[i]->org)) { + i += 1; + } + if (i < 4) { + if (f->bufs[i] == NIL) { + __NEW(buf, Files_BufDesc); + buf->chg = 0; + buf->org = -1; + buf->f = f; + f->bufs[i] = buf; + } else { + buf = f->bufs[i]; + } + } else { + f->swapper = __MASK(f->swapper + 1, -4); + buf = f->bufs[f->swapper]; + Files_Flush(buf); + } + if (buf->org != org) { + if (org == f->len) { + buf->size = 0; + } else { + Files_Create(f); + if (f->pos != org) { + error = Platform_Seek(f->fd, org, Platform_SeekSet); + } + error = Platform_ReadBuf(f->fd, (void*)buf->data, ((LONGINT)(4096)), &n); + if (error != 0) { + Files_Err((CHAR*)"read from file not done", (LONGINT)24, f, error); + } + f->pos = org + n; + buf->size = n; + } + buf->org = org; + buf->chg = 0; + } + } else { + buf = NIL; + org = 0; + offset = 0; + } + (*r).buf = buf; + (*r).org = org; + (*r).offset = offset; + (*r).eof = 0; + (*r).res = 0; +} + +void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x) +{ + LONGINT offset; + Files_Buffer buf = NIL; + buf = (*r).buf; + offset = (*r).offset; + if ((*r).org != buf->org) { + Files_Set(&*r, r__typ, buf->f, (*r).org + offset); + buf = (*r).buf; + offset = (*r).offset; + } + if (offset < buf->size) { + *x = buf->data[offset]; + (*r).offset = offset + 1; + } else if ((*r).org + offset < buf->f->len) { + Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset); + *x = (*r).buf->data[0]; + (*r).offset = 1; + } else { + *x = 0x00; + (*r).eof = 1; + } +} + +void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n) +{ + LONGINT xpos, min, restInBuf, offset; + Files_Buffer buf = NIL; + if (n > x__len) { + Files_IdxTrap(); + } + xpos = 0; + buf = (*r).buf; + offset = (*r).offset; + while (n > 0) { + if ((*r).org != buf->org || offset >= 4096) { + Files_Set(&*r, r__typ, buf->f, (*r).org + offset); + buf = (*r).buf; + offset = (*r).offset; + } + restInBuf = buf->size - offset; + if (restInBuf == 0) { + (*r).res = n; + (*r).eof = 1; + return; + } else if (n > restInBuf) { + min = restInBuf; + } else { + min = n; + } + __MOVE((LONGINT)(uintptr_t)buf->data + offset, (LONGINT)(uintptr_t)x + xpos, min); + offset += min; + (*r).offset = offset; + xpos += min; + n -= min; + } + (*r).res = 0; + (*r).eof = 0; +} + +void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len) +{ + Files_ReadBytes(&*r, r__typ, (void*)x, x__len * ((LONGINT)(1)), ((LONGINT)(1))); +} + +Files_File Files_Base (Files_Rider *r, LONGINT *r__typ) +{ + Files_File _o_result; + _o_result = (*r).buf->f; + return _o_result; +} + +void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x) +{ + Files_Buffer buf = NIL; + LONGINT offset; + buf = (*r).buf; + offset = (*r).offset; + if ((*r).org != buf->org || offset >= 4096) { + Files_Set(&*r, r__typ, buf->f, (*r).org + offset); + buf = (*r).buf; + offset = (*r).offset; + } + buf->data[offset] = x; + buf->chg = 1; + if (offset == buf->size) { + buf->size += 1; + buf->f->len += 1; + } + (*r).offset = offset + 1; + (*r).res = 0; +} + +void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n) +{ + LONGINT xpos, min, restInBuf, offset; + Files_Buffer buf = NIL; + if (n > x__len) { + Files_IdxTrap(); + } + xpos = 0; + buf = (*r).buf; + offset = (*r).offset; + while (n > 0) { + if ((*r).org != buf->org || offset >= 4096) { + Files_Set(&*r, r__typ, buf->f, (*r).org + offset); + buf = (*r).buf; + offset = (*r).offset; + } + restInBuf = 4096 - offset; + if (n > restInBuf) { + min = restInBuf; + } else { + min = n; + } + __MOVE((LONGINT)(uintptr_t)x + xpos, (LONGINT)(uintptr_t)buf->data + offset, min); + offset += min; + (*r).offset = offset; + if (offset > buf->size) { + buf->f->len += offset - buf->size; + buf->size = offset; + } + xpos += min; + n -= min; + buf->chg = 1; + } + (*r).res = 0; +} + +void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res) +{ + __DUP(name, name__len, CHAR); + *res = Platform_Unlink((void*)name, name__len); + __DEL(name); +} + +void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res) +{ + LONGINT fdold, fdnew, n; + INTEGER error, ignore; + Platform_FileIdentity oldidentity, newidentity; + CHAR buf[4096]; + __DUP(old, old__len, CHAR); + __DUP(new, new__len, CHAR); + error = Platform_IdentifyByName(old, old__len, &oldidentity, Platform_FileIdentity__typ); + if (error == 0) { + error = Platform_IdentifyByName(new, new__len, &newidentity, Platform_FileIdentity__typ); + if ((error != 0 && !Platform_SameFile(oldidentity, newidentity))) { + Files_Delete(new, new__len, &error); + } + error = Platform_Rename((void*)old, old__len, (void*)new, new__len); + if (!Platform_DifferentFilesystems(error)) { + *res = error; + return; + } else { + error = Platform_OldRO((void*)old, old__len, &fdold); + if (error != 0) { + *res = 2; + return; + } + error = Platform_New((void*)new, new__len, &fdnew); + if (error != 0) { + error = Platform_Close(fdold); + *res = 3; + return; + } + error = Platform_Read(fdold, (LONGINT)(uintptr_t)buf, ((LONGINT)(4096)), &n); + while (n > 0) { + error = Platform_Write(fdnew, (LONGINT)(uintptr_t)buf, n); + if (error != 0) { + ignore = Platform_Close(fdold); + ignore = Platform_Close(fdnew); + Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error); + } + error = Platform_Read(fdold, (LONGINT)(uintptr_t)buf, ((LONGINT)(4096)), &n); + } + ignore = Platform_Close(fdold); + ignore = Platform_Close(fdnew); + if (n == 0) { + error = Platform_Unlink((void*)old, old__len); + *res = 0; + } else { + Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error); + } + } + } else { + *res = 2; + } + __DEL(old); + __DEL(new); +} + +void Files_Register (Files_File f) +{ + INTEGER idx, errcode; + Files_File f1 = NIL; + CHAR file[104]; + if ((f->state == 1 && f->registerName[0] != 0x00)) { + f->state = 2; + } + Files_Close(f); + if (f->registerName[0] != 0x00) { + Files_Rename(f->workName, ((LONGINT)(101)), f->registerName, ((LONGINT)(101)), &errcode); + if (errcode != 0) { + __COPY(f->registerName, file, ((LONGINT)(104))); + __HALT(99); + } + __COPY(f->registerName, f->workName, ((LONGINT)(101))); + f->registerName[0] = 0x00; + f->tempFile = 0; + } +} + +void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res) +{ + __DUP(path, path__len, CHAR); + *res = Platform_Chdir((void*)path, path__len); + __DEL(path); +} + +static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len) +{ + LONGINT i, j; + if (!Platform_LittleEndian) { + i = src__len; + j = 0; + while (i > 0) { + i -= 1; + dest[j] = src[i]; + j += 1; + } + } else { + __MOVE((LONGINT)(uintptr_t)src, (LONGINT)(uintptr_t)dest, src__len); + } +} + +void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x) +{ + Files_Read(&*R, R__typ, (CHAR*)(void*)&*x); +} + +void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x) +{ + CHAR b[2]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(2)), ((LONGINT)(2))); + *x = (int)b[0] + __ASHL((int)b[1], 8); +} + +void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x) +{ + CHAR b[4]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); + *x = ((LONGINT)((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((LONGINT)b[2], 16)) + __ASHL((LONGINT)b[3], 24); +} + +void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x) +{ + CHAR b[4]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); + *x = (SET)(((LONGINT)((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((LONGINT)b[2], 16)) + __ASHL((LONGINT)b[3], 24)); +} + +void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x) +{ + CHAR b[4]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); + Files_FlipBytes((void*)b, ((LONGINT)(4)), (void*)&*x, ((LONGINT)(4))); +} + +void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x) +{ + CHAR b[8]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(8)), ((LONGINT)(8))); + Files_FlipBytes((void*)b, ((LONGINT)(8)), (void*)&*x, ((LONGINT)(8))); +} + +void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len) +{ + INTEGER i; + CHAR ch; + i = 0; + do { + Files_Read(&*R, R__typ, (void*)&ch); + x[i] = ch; + i += 1; + } while (!(ch == 0x00)); +} + +void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len) +{ + INTEGER i; + CHAR ch; + BOOLEAN b; + i = 0; + b = 0; + do { + Files_Read(&*R, R__typ, (void*)&ch); + if ((ch == 0x00 || ch == 0x0a) || ch == 0x0d) { + b = 1; + } else { + x[i] = ch; + i += 1; + } + } while (!b); +} + +void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x) +{ + SHORTINT s; + CHAR ch; + LONGINT n; + s = 0; + n = 0; + Files_Read(&*R, R__typ, (void*)&ch); + while ((int)ch >= 128) { + n += __ASH((LONGINT)((int)ch - 128), s); + s += 7; + Files_Read(&*R, R__typ, (void*)&ch); + } + n += __ASH((LONGINT)(__MASK((int)ch, -64) - __ASHL(__ASHR((int)ch, 6), 6)), s); + *x = n; +} + +void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x) +{ + Files_Write(&*R, R__typ, __VAL(CHAR, x)); +} + +void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x) +{ + CHAR b[2]; + b[0] = (CHAR)x; + b[1] = (CHAR)__ASHR(x, 8); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(2)), ((LONGINT)(2))); +} + +void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x) +{ + CHAR b[4]; + b[0] = (CHAR)x; + b[1] = (CHAR)__ASHR(x, 8); + b[2] = (CHAR)__ASHR(x, 16); + b[3] = (CHAR)__ASHR(x, 24); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); +} + +void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x) +{ + CHAR b[4]; + LONGINT i; + i = (LONGINT)x; + b[0] = (CHAR)i; + b[1] = (CHAR)__ASHR(i, 8); + b[2] = (CHAR)__ASHR(i, 16); + b[3] = (CHAR)__ASHR(i, 24); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); +} + +void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x) +{ + CHAR b[4]; + Files_FlipBytes((void*)&x, ((LONGINT)(4)), (void*)b, ((LONGINT)(4))); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); +} + +void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x) +{ + CHAR b[8]; + Files_FlipBytes((void*)&x, ((LONGINT)(8)), (void*)b, ((LONGINT)(8))); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(8)), ((LONGINT)(8))); +} + +void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len) +{ + INTEGER i; + i = 0; + while (x[i] != 0x00) { + i += 1; + } + Files_WriteBytes(&*R, R__typ, (void*)x, x__len * ((LONGINT)(1)), i + 1); +} + +void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x) +{ + while (x < -64 || x > 63) { + Files_Write(&*R, R__typ, (CHAR)(__MASK(x, -128) + 128)); + x = __ASHR(x, 7); + } + Files_Write(&*R, R__typ, (CHAR)__MASK(x, -128)); +} + +void Files_GetName (Files_File f, CHAR *name, LONGINT name__len) +{ + __COPY(f->workName, name, name__len); +} + +static void Files_Finalize (SYSTEM_PTR o) +{ + Files_File f = NIL; + LONGINT res; + f = (Files_File)(uintptr_t)o; + if (f->fd >= 0) { + Files_fileTab[f->fd] = 0; + res = Platform_Close(f->fd); + f->fd = -1; + Heap_FileCount -= 1; + if (f->tempFile) { + res = Platform_Unlink((void*)f->workName, ((LONGINT)(101))); + } + } +} + +void Files_SetSearchPath (CHAR *path, LONGINT path__len) +{ + __DUP(path, path__len, CHAR); + if (Strings_Length(path, path__len) != 0) { + Files_SearchPath = __NEWARR(NIL, ((LONGINT)(1)), 1, 1, 1, (LONGINT)(Strings_Length(path, path__len) + 1)); + __COPY(path, Files_SearchPath->data, Files_SearchPath->len[0]); + } else { + Files_SearchPath = NIL; + } + __DEL(path); +} + +static void Files_Init (void) +{ + LONGINT i; + i = 0; + while (i < 256) { + Files_fileTab[i] = 0; + i += 1; + } + Files_tempno = -1; + Heap_FileCount = 0; + Files_SearchPath = NIL; + Files_HOME[0] = 0x00; + Platform_GetEnv((CHAR*)"HOME", (LONGINT)5, (void*)Files_HOME, ((LONGINT)(1024))); +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(Files_SearchPath); +} + +__TDESC(Files_Handle, 1, 4) = {__TDFLDS("Handle", 248), {228, 232, 236, 240, -20}}; +__TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4112), {0, -8}}; +__TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 20), {8, -8}}; + +export void *Files__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Console); + __MODULE_IMPORT(Heap); + __MODULE_IMPORT(Platform); + __MODULE_IMPORT(Strings); + __REGMOD("Files", EnumPtrs); + __INITYP(Files_Handle, Files_Handle, 0); + __INITYP(Files_BufDesc, Files_BufDesc, 0); + __INITYP(Files_Rider, Files_Rider, 0); +/* BEGIN */ + Files_Init(); + __ENDMOD; +} diff --git a/bootstrap/unix-48/Files.h b/bootstrap/unix-48/Files.h new file mode 100644 index 00000000..002d2dc5 --- /dev/null +++ b/bootstrap/unix-48/Files.h @@ -0,0 +1,70 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tspkaSfF */ + +#ifndef Files__h +#define Files__h + +#include "SYSTEM.h" + +typedef + struct Files_Handle *Files_File; + +typedef + struct Files_Handle { + char _prvt0[216]; + LONGINT fd; + char _prvt1[28]; + } Files_Handle; + +typedef + struct Files_Rider { + LONGINT res; + BOOLEAN eof; + char _prvt0[15]; + } Files_Rider; + + + +import LONGINT *Files_Handle__typ; +import LONGINT *Files_Rider__typ; + +import Files_File Files_Base (Files_Rider *r, LONGINT *r__typ); +import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res); +import void Files_Close (Files_File f); +import void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res); +import void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d); +import void Files_GetName (Files_File f, CHAR *name, LONGINT name__len); +import LONGINT Files_Length (Files_File f); +import Files_File Files_New (CHAR *name, LONGINT name__len); +import Files_File Files_Old (CHAR *name, LONGINT name__len); +import LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ); +import void Files_Purge (Files_File f); +import void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x); +import void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x); +import void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len); +import void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n); +import void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x); +import void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x); +import void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x); +import void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +import void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x); +import void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x); +import void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x); +import void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +import void Files_Register (Files_File f); +import void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res); +import void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos); +import void Files_SetSearchPath (CHAR *path, LONGINT path__len); +import void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x); +import void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x); +import void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n); +import void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x); +import void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x); +import void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x); +import void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x); +import void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x); +import void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x); +import void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +import void *Files__init(void); + + +#endif diff --git a/bootstrap/unix-48/Heap.c b/bootstrap/unix-48/Heap.c new file mode 100644 index 00000000..cbb21626 --- /dev/null +++ b/bootstrap/unix-48/Heap.c @@ -0,0 +1,752 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tskSfF */ +#include "SYSTEM.h" + +struct Heap__1 { + CHAR ch; + SYSTEM_PTR p; +}; + +typedef + struct Heap_CmdDesc *Heap_Cmd; + +typedef + CHAR Heap_CmdName[24]; + +typedef + void (*Heap_Command)(void); + +typedef + struct Heap_CmdDesc { + Heap_Cmd next; + Heap_CmdName name; + Heap_Command cmd; + } Heap_CmdDesc; + +typedef + void (*Heap_EnumProc)(void(*)(SYSTEM_PTR)); + +typedef + struct Heap_FinDesc *Heap_FinNode; + +typedef + void (*Heap_Finalizer)(SYSTEM_PTR); + +typedef + struct Heap_FinDesc { + Heap_FinNode next; + LONGINT obj; + BOOLEAN marked; + Heap_Finalizer finalize; + } Heap_FinDesc; + +typedef + struct Heap_ModuleDesc *Heap_Module; + +typedef + CHAR Heap_ModuleName[20]; + +typedef + struct Heap_ModuleDesc { + Heap_Module next; + Heap_ModuleName name; + LONGINT refcnt; + Heap_Cmd cmds; + LONGINT types; + Heap_EnumProc enumPtrs; + LONGINT reserved1, reserved2; + } Heap_ModuleDesc; + + +export SYSTEM_PTR Heap_modules; +static LONGINT Heap_freeList[10]; +static LONGINT Heap_bigBlocks; +export LONGINT Heap_allocated; +static BOOLEAN Heap_firstTry; +static LONGINT Heap_heap, Heap_heapend; +export LONGINT Heap_heapsize; +static Heap_FinNode Heap_fin; +static INTEGER Heap_lockdepth; +static BOOLEAN Heap_interrupted; +export INTEGER Heap_FileCount; + +export LONGINT *Heap_ModuleDesc__typ; +export LONGINT *Heap_CmdDesc__typ; +export LONGINT *Heap_FinDesc__typ; +export LONGINT *Heap__1__typ; + +static void Heap_CheckFin (void); +static void Heap_ExtendHeap (LONGINT blksz); +export void Heap_FINALL (void); +static void Heap_Finalize (void); +export void Heap_GC (BOOLEAN markStack); +static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len); +export void Heap_INCREF (Heap_Module m); +export void Heap_InitHeap (void); +export void Heap_Lock (void); +static void Heap_Mark (LONGINT q); +static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len); +static void Heap_MarkP (SYSTEM_PTR p); +static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len); +export SYSTEM_PTR Heap_NEWBLK (LONGINT size); +export SYSTEM_PTR Heap_NEWREC (LONGINT tag); +static LONGINT Heap_NewChunk (LONGINT blksz); +export void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd); +export SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs); +export void Heap_REGTYP (Heap_Module m, LONGINT typ); +export void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize); +static void Heap_Scan (void); +static void Heap_Sift (LONGINT l, LONGINT r, LONGINT *a, LONGINT a__len); +export void Heap_Unlock (void); + +extern void *Heap__init(); +extern LONGINT Platform_MainStackFrame; +extern LONGINT Platform_OSAllocate(LONGINT size); +#define Heap_FetchAddress(pointer) (LONGINT)(uintptr_t)(*((void**)((uintptr_t)pointer))) +#define Heap_HeapModuleInit() Heap__init() +#define Heap_OSAllocate(size) Platform_OSAllocate(size) +#define Heap_PlatformHalt(code) Platform_Halt(code) +#define Heap_PlatformMainStackFrame() Platform_MainStackFrame + +void Heap_Lock (void) +{ + Heap_lockdepth += 1; +} + +void Heap_Unlock (void) +{ + Heap_lockdepth -= 1; + if ((Heap_interrupted && Heap_lockdepth == 0)) { + Heap_PlatformHalt(((LONGINT)(-9))); + } +} + +SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs) +{ + SYSTEM_PTR _o_result; + Heap_Module m; + if (__STRCMP(name, "Heap") == 0) { + __SYSNEW(m, 48); + } else { + __NEW(m, Heap_ModuleDesc); + } + m->types = 0; + m->cmds = NIL; + __COPY(name, m->name, ((LONGINT)(20))); + m->refcnt = 0; + m->enumPtrs = enumPtrs; + m->next = (Heap_Module)(uintptr_t)Heap_modules; + Heap_modules = (SYSTEM_PTR)m; + _o_result = (void*)m; + return _o_result; +} + +void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd) +{ + Heap_Cmd c; + if (__STRCMP(m->name, "Heap") == 0) { + __SYSNEW(c, 32); + } else { + __NEW(c, Heap_CmdDesc); + } + __COPY(name, c->name, ((LONGINT)(24))); + c->cmd = cmd; + c->next = m->cmds; + m->cmds = c; +} + +void Heap_REGTYP (Heap_Module m, LONGINT typ) +{ + __PUT(typ, m->types, LONGINT); + m->types = typ; +} + +void Heap_INCREF (Heap_Module m) +{ + m->refcnt += 1; +} + +static LONGINT Heap_NewChunk (LONGINT blksz) +{ + LONGINT _o_result; + LONGINT chnk; + chnk = Heap_OSAllocate(blksz + 12); + if (chnk != 0) { + __PUT(chnk + 4, chnk + (12 + blksz), LONGINT); + __PUT(chnk + 12, chnk + 16, LONGINT); + __PUT(chnk + 16, blksz, LONGINT); + __PUT(chnk + 20, -4, LONGINT); + __PUT(chnk + 24, Heap_bigBlocks, LONGINT); + Heap_bigBlocks = chnk + 12; + Heap_heapsize += blksz; + } + _o_result = chnk; + return _o_result; +} + +static void Heap_ExtendHeap (LONGINT blksz) +{ + LONGINT size, chnk, j, next; + if (blksz > 160000) { + size = blksz; + } else { + size = 160000; + } + chnk = Heap_NewChunk(size); + if (chnk != 0) { + if (chnk < Heap_heap) { + __PUT(chnk, Heap_heap, LONGINT); + Heap_heap = chnk; + } else { + j = Heap_heap; + next = Heap_FetchAddress(j); + while ((next != 0 && chnk > next)) { + j = next; + next = Heap_FetchAddress(j); + } + __PUT(chnk, next, LONGINT); + __PUT(j, chnk, LONGINT); + } + if (next == 0) { + Heap_heapend = Heap_FetchAddress(chnk + 4); + } + } +} + +SYSTEM_PTR Heap_NEWREC (LONGINT tag) +{ + SYSTEM_PTR _o_result; + LONGINT i, i0, di, blksz, restsize, t, adr, end, next, prev; + SYSTEM_PTR new; + Heap_Lock(); + blksz = Heap_FetchAddress(tag); + i0 = __ASHR(blksz, 4); + i = i0; + if (i < 9) { + adr = Heap_freeList[i]; + while (adr == 0) { + i += 1; + adr = Heap_freeList[i]; + } + } + if (i < 9) { + next = Heap_FetchAddress(adr + 12); + Heap_freeList[i] = next; + if (i != i0) { + di = i - i0; + restsize = __ASHL(di, 4); + end = adr + restsize; + __PUT(end + 4, blksz, LONGINT); + __PUT(end + 8, -4, LONGINT); + __PUT(end, end + 4, LONGINT); + __PUT(adr + 4, restsize, LONGINT); + __PUT(adr + 12, Heap_freeList[di], LONGINT); + Heap_freeList[di] = adr; + adr += restsize; + } + } else { + adr = Heap_bigBlocks; + prev = 0; + for (;;) { + if (adr == 0) { + if (Heap_firstTry) { + Heap_GC(1); + blksz += 16; + if (__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2) < Heap_heapsize) { + Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize); + } + Heap_firstTry = 0; + new = Heap_NEWREC(tag); + Heap_firstTry = 1; + if (new == NIL) { + Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize); + new = Heap_NEWREC(tag); + } + Heap_Unlock(); + _o_result = new; + return _o_result; + } else { + Heap_Unlock(); + _o_result = NIL; + return _o_result; + } + } + t = Heap_FetchAddress(adr + 4); + if (t >= blksz) { + break; + } + prev = adr; + adr = Heap_FetchAddress(adr + 12); + } + restsize = t - blksz; + end = adr + restsize; + __PUT(end + 4, blksz, LONGINT); + __PUT(end + 8, -4, LONGINT); + __PUT(end, end + 4, LONGINT); + if (restsize > 144) { + __PUT(adr + 4, restsize, LONGINT); + } else { + next = Heap_FetchAddress(adr + 12); + if (prev == 0) { + Heap_bigBlocks = next; + } else { + __PUT(prev + 12, next, LONGINT); + } + if (restsize > 0) { + di = __ASHR(restsize, 4); + __PUT(adr + 4, restsize, LONGINT); + __PUT(adr + 12, Heap_freeList[di], LONGINT); + Heap_freeList[di] = adr; + } + } + adr += restsize; + } + i = adr + 16; + end = adr + blksz; + while (i < end) { + __PUT(i, 0, LONGINT); + __PUT(i + 4, 0, LONGINT); + __PUT(i + 8, 0, LONGINT); + __PUT(i + 12, 0, LONGINT); + i += 16; + } + __PUT(adr + 12, 0, LONGINT); + __PUT(adr, tag, LONGINT); + __PUT(adr + 4, 0, LONGINT); + __PUT(adr + 8, 0, LONGINT); + Heap_allocated += blksz; + Heap_Unlock(); + _o_result = (SYSTEM_PTR)(uintptr_t)(adr + 4); + return _o_result; +} + +SYSTEM_PTR Heap_NEWBLK (LONGINT size) +{ + SYSTEM_PTR _o_result; + LONGINT blksz, tag; + SYSTEM_PTR new; + Heap_Lock(); + blksz = __ASHL(__ASHR(size + 31, 4), 4); + new = Heap_NEWREC((LONGINT)(uintptr_t)&blksz); + tag = ((LONGINT)(uintptr_t)new + blksz) - 12; + __PUT(tag - 4, 0, LONGINT); + __PUT(tag, blksz, LONGINT); + __PUT(tag + 4, -4, LONGINT); + __PUT((LONGINT)(uintptr_t)new - 4, tag, LONGINT); + Heap_Unlock(); + _o_result = new; + return _o_result; +} + +static void Heap_Mark (LONGINT q) +{ + LONGINT p, tag, fld, n, offset, tagbits; + if (q != 0) { + tagbits = Heap_FetchAddress(q - 4); + if (!__ODD(tagbits)) { + __PUT(q - 4, tagbits + 1, LONGINT); + p = 0; + tag = tagbits + 4; + for (;;) { + __GET(tag, offset, LONGINT); + if (offset < 0) { + __PUT(q - 4, (tag + offset) + 1, LONGINT); + if (p == 0) { + break; + } + n = q; + q = p; + tag = Heap_FetchAddress(q - 4); + tag -= 1; + __GET(tag, offset, LONGINT); + fld = q + offset; + p = Heap_FetchAddress(fld); + __PUT(fld, (SYSTEM_PTR)(uintptr_t)n, SYSTEM_PTR); + } else { + fld = q + offset; + n = Heap_FetchAddress(fld); + if (n != 0) { + tagbits = Heap_FetchAddress(n - 4); + if (!__ODD(tagbits)) { + __PUT(n - 4, tagbits + 1, LONGINT); + __PUT(q - 4, tag + 1, LONGINT); + __PUT(fld, (SYSTEM_PTR)(uintptr_t)p, SYSTEM_PTR); + p = q; + q = n; + tag = tagbits; + } + } + } + tag += 4; + } + } + } +} + +static void Heap_MarkP (SYSTEM_PTR p) +{ + Heap_Mark((LONGINT)(uintptr_t)p); +} + +static void Heap_Scan (void) +{ + LONGINT chnk, adr, end, start, tag, i, size, freesize; + Heap_bigBlocks = 0; + i = 1; + while (i < 9) { + Heap_freeList[i] = 0; + i += 1; + } + freesize = 0; + Heap_allocated = 0; + chnk = Heap_heap; + while (chnk != 0) { + adr = chnk + 12; + end = Heap_FetchAddress(chnk + 4); + while (adr < end) { + tag = Heap_FetchAddress(adr); + if (__ODD(tag)) { + if (freesize > 0) { + start = adr - freesize; + __PUT(start, start + 4, LONGINT); + __PUT(start + 4, freesize, LONGINT); + __PUT(start + 8, -4, LONGINT); + i = __ASHR(freesize, 4); + freesize = 0; + if (i < 9) { + __PUT(start + 12, Heap_freeList[i], LONGINT); + Heap_freeList[i] = start; + } else { + __PUT(start + 12, Heap_bigBlocks, LONGINT); + Heap_bigBlocks = start; + } + } + tag -= 1; + __PUT(adr, tag, LONGINT); + size = Heap_FetchAddress(tag); + Heap_allocated += size; + adr += size; + } else { + size = Heap_FetchAddress(tag); + freesize += size; + adr += size; + } + } + if (freesize > 0) { + start = adr - freesize; + __PUT(start, start + 4, LONGINT); + __PUT(start + 4, freesize, LONGINT); + __PUT(start + 8, -4, LONGINT); + i = __ASHR(freesize, 4); + freesize = 0; + if (i < 9) { + __PUT(start + 12, Heap_freeList[i], LONGINT); + Heap_freeList[i] = start; + } else { + __PUT(start + 12, Heap_bigBlocks, LONGINT); + Heap_bigBlocks = start; + } + } + chnk = Heap_FetchAddress(chnk); + } +} + +static void Heap_Sift (LONGINT l, LONGINT r, LONGINT *a, LONGINT a__len) +{ + LONGINT i, j, x; + j = l; + x = a[j]; + for (;;) { + i = j; + j = __ASHL(j, 1) + 1; + if ((j < r && a[j] < a[j + 1])) { + j += 1; + } + if (j > r || a[j] <= x) { + break; + } + a[i] = a[j]; + } + a[i] = x; +} + +static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len) +{ + LONGINT l, r, x; + l = __ASHR(n, 1); + r = n - 1; + while (l > 0) { + l -= 1; + Heap_Sift(l, r, (void*)a, a__len); + } + while (r > 0) { + x = a[0]; + a[0] = a[r]; + a[r] = x; + r -= 1; + Heap_Sift(l, r, (void*)a, a__len); + } +} + +static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len) +{ + LONGINT chnk, adr, tag, next, lim, lim1, i, ptr, size; + chnk = Heap_heap; + i = 0; + lim = cand[n - 1]; + while ((chnk != 0 && chnk < lim)) { + adr = chnk + 12; + lim1 = Heap_FetchAddress(chnk + 4); + if (lim < lim1) { + lim1 = lim; + } + while (adr < lim1) { + tag = Heap_FetchAddress(adr); + if (__ODD(tag)) { + size = Heap_FetchAddress(tag - 1); + adr += size; + } else { + size = Heap_FetchAddress(tag); + ptr = adr + 4; + while (cand[i] < ptr) { + i += 1; + } + if (i == n) { + return; + } + next = adr + size; + if (cand[i] < next) { + Heap_Mark(ptr); + } + adr = next; + } + } + chnk = Heap_FetchAddress(chnk); + } +} + +static void Heap_CheckFin (void) +{ + Heap_FinNode n; + LONGINT tag; + n = Heap_fin; + while (n != NIL) { + tag = Heap_FetchAddress(n->obj - 4); + if (!__ODD(tag)) { + n->marked = 0; + Heap_Mark(n->obj); + } else { + n->marked = 1; + } + n = n->next; + } +} + +static void Heap_Finalize (void) +{ + Heap_FinNode n, prev; + n = Heap_fin; + prev = NIL; + while (n != NIL) { + if (!n->marked) { + if (n == Heap_fin) { + Heap_fin = Heap_fin->next; + } else { + prev->next = n->next; + } + (*n->finalize)((SYSTEM_PTR)(uintptr_t)n->obj); + if (prev == NIL) { + n = Heap_fin; + } else { + n = n->next; + } + } else { + prev = n; + n = n->next; + } + } +} + +void Heap_FINALL (void) +{ + Heap_FinNode n; + while (Heap_fin != NIL) { + n = Heap_fin; + Heap_fin = Heap_fin->next; + (*n->finalize)((SYSTEM_PTR)(uintptr_t)n->obj); + } +} + +static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len) +{ + SYSTEM_PTR frame; + LONGINT inc, nofcand, sp, p, stack0, ptr; + struct Heap__1 align; + if (n > 0) { + Heap_MarkStack(n - 1, cand, cand__len); + if (n > 100) { + return; + } + } + if (n == 0) { + nofcand = 0; + sp = (LONGINT)(uintptr_t)&frame; + stack0 = Heap_PlatformMainStackFrame(); + inc = (LONGINT)(uintptr_t)&align.p - (LONGINT)(uintptr_t)&align; + if (sp > stack0) { + inc = -inc; + } + while (sp != stack0) { + __GET(sp, p, LONGINT); + if ((p > Heap_heap && p < Heap_heapend)) { + if (nofcand == cand__len) { + Heap_HeapSort(nofcand, (void*)cand, cand__len); + Heap_MarkCandidates(nofcand, (void*)cand, cand__len); + nofcand = 0; + } + cand[nofcand] = p; + nofcand += 1; + } + sp += inc; + } + if (nofcand > 0) { + Heap_HeapSort(nofcand, (void*)cand, cand__len); + Heap_MarkCandidates(nofcand, (void*)cand, cand__len); + } + } +} + +void Heap_GC (BOOLEAN markStack) +{ + Heap_Module m; + LONGINT i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23; + LONGINT cand[10000]; + if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) { + Heap_Lock(); + m = (Heap_Module)(uintptr_t)Heap_modules; + while (m != NIL) { + if (m->enumPtrs != NIL) { + (*m->enumPtrs)(Heap_MarkP); + } + m = m->next; + } + if (markStack) { + i0 = -100; + i1 = -101; + i2 = -102; + i3 = -103; + i4 = -104; + i5 = -105; + i6 = -106; + i7 = -107; + i8 = 1; + i9 = 2; + i10 = 3; + i11 = 4; + i12 = 5; + i13 = 6; + i14 = 7; + i15 = 8; + i16 = 9; + i17 = 10; + i18 = 11; + i19 = 12; + i20 = 13; + i21 = 14; + i22 = 15; + i23 = 16; + for (;;) { + i0 += 1; + i1 += 2; + i2 += 3; + i3 += 4; + i4 += 5; + i5 += 6; + i6 += 7; + i7 += 8; + i8 += 9; + i9 += 10; + i10 += 11; + i11 += 12; + i12 += 13; + i13 += 14; + i14 += 15; + i15 += 16; + i16 += 17; + i17 += 18; + i18 += 19; + i19 += 20; + i20 += 21; + i21 += 22; + i22 += 23; + i23 += 24; + if ((i0 == -99 && i15 == 24)) { + Heap_MarkStack(((LONGINT)(32)), (void*)cand, ((LONGINT)(10000))); + break; + } + } + if (((((((((((((((((((((((i0 + i1) + i2) + i3) + i4) + i5) + i6) + i7) + i8) + i9) + i10) + i11) + i12) + i13) + i14) + i15) + i16) + i17) + i18) + i19) + i20) + i21) + i22) + i23 > 10000) { + return; + } + } + Heap_CheckFin(); + Heap_Scan(); + Heap_Finalize(); + Heap_Unlock(); + } +} + +void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize) +{ + Heap_FinNode f; + __NEW(f, Heap_FinDesc); + f->obj = (LONGINT)(uintptr_t)obj; + f->finalize = finalize; + f->marked = 1; + f->next = Heap_fin; + Heap_fin = f; +} + +void Heap_InitHeap (void) +{ + Heap_heap = Heap_NewChunk(128000); + Heap_heapend = Heap_FetchAddress(Heap_heap + 4); + __PUT(Heap_heap, 0, LONGINT); + Heap_allocated = 0; + Heap_firstTry = 1; + Heap_freeList[9] = 1; + Heap_lockdepth = 0; + Heap_FileCount = 0; + Heap_modules = NIL; + Heap_heapsize = 0; + Heap_bigBlocks = 0; + Heap_fin = NIL; + Heap_interrupted = 0; + Heap_HeapModuleInit(); +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(Heap_modules); + P(Heap_fin); +} + +__TDESC(Heap_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 48), {0, 28, -12}}; +__TDESC(Heap_CmdDesc, 1, 1) = {__TDFLDS("CmdDesc", 32), {0, -8}}; +__TDESC(Heap_FinDesc, 1, 1) = {__TDFLDS("FinDesc", 16), {0, -8}}; +__TDESC(Heap__1, 1, 1) = {__TDFLDS("", 8), {4, -8}}; + +export void *Heap__init(void) +{ + __DEFMOD; + __REGMOD("Heap", EnumPtrs); + __REGCMD("FINALL", Heap_FINALL); + __REGCMD("InitHeap", Heap_InitHeap); + __REGCMD("Lock", Heap_Lock); + __REGCMD("Unlock", Heap_Unlock); + __INITYP(Heap_ModuleDesc, Heap_ModuleDesc, 0); + __INITYP(Heap_CmdDesc, Heap_CmdDesc, 0); + __INITYP(Heap_FinDesc, Heap_FinDesc, 0); + __INITYP(Heap__1, Heap__1, 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-48/Heap.h b/bootstrap/unix-48/Heap.h new file mode 100644 index 00000000..d270a455 --- /dev/null +++ b/bootstrap/unix-48/Heap.h @@ -0,0 +1,54 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tskSfF */ + +#ifndef Heap__h +#define Heap__h + +#include "SYSTEM.h" + +typedef + CHAR Heap_CmdName[24]; + +typedef + void (*Heap_Command)(void); + +typedef + void (*Heap_EnumProc)(void(*)(SYSTEM_PTR)); + +typedef + void (*Heap_Finalizer)(SYSTEM_PTR); + +typedef + struct Heap_ModuleDesc *Heap_Module; + +typedef + struct Heap_ModuleDesc { + LONGINT _prvt0; + char _prvt1[44]; + } Heap_ModuleDesc; + +typedef + CHAR Heap_ModuleName[20]; + + +import SYSTEM_PTR Heap_modules; +import LONGINT Heap_allocated, Heap_heapsize; +import INTEGER Heap_FileCount; + +import LONGINT *Heap_ModuleDesc__typ; + +import void Heap_FINALL (void); +import void Heap_GC (BOOLEAN markStack); +import void Heap_INCREF (Heap_Module m); +import void Heap_InitHeap (void); +import void Heap_Lock (void); +import SYSTEM_PTR Heap_NEWBLK (LONGINT size); +import SYSTEM_PTR Heap_NEWREC (LONGINT tag); +import void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd); +import SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs); +import void Heap_REGTYP (Heap_Module m, LONGINT typ); +import void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize); +import void Heap_Unlock (void); +import void *Heap__init(void); + + +#endif diff --git a/bootstrap/unix-48/Modules.c b/bootstrap/unix-48/Modules.c new file mode 100644 index 00000000..6c0f5e0b --- /dev/null +++ b/bootstrap/unix-48/Modules.c @@ -0,0 +1,171 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "Console.h" +#include "Heap.h" + +typedef + struct Modules_CmdDesc *Modules_Cmd; + +typedef + void (*Modules_Command)(void); + +typedef + struct Modules_CmdDesc { + Modules_Cmd next; + CHAR name[24]; + Modules_Command cmd; + } Modules_CmdDesc; + +typedef + struct Modules_ModuleDesc *Modules_Module; + +typedef + CHAR Modules_ModuleName[20]; + +typedef + struct Modules_ModuleDesc { + Modules_Module next; + Modules_ModuleName name; + LONGINT refcnt; + Modules_Cmd cmds; + LONGINT types; + void (*enumPtrs)(void(*)(LONGINT)); + LONGINT reserved1, reserved2; + } Modules_ModuleDesc; + + +export INTEGER Modules_res; +export CHAR Modules_resMsg[256]; +export Modules_ModuleName Modules_imported, Modules_importing; + +export LONGINT *Modules_ModuleDesc__typ; +export LONGINT *Modules_CmdDesc__typ; + +static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len); +export void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all); +export Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len); +export Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len); + +#define Modules_modules() (Modules_Module)Heap_modules +#define Modules_setmodules(m) Heap_modules = m + +static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len) +{ + INTEGER i, j; + __DUP(b, b__len, CHAR); + i = 0; + while (a[__X(i, a__len)] != 0x00) { + i += 1; + } + j = 0; + while (b[__X(j, b__len)] != 0x00) { + a[__X(i, a__len)] = b[__X(j, b__len)]; + i += 1; + j += 1; + } + a[__X(i, a__len)] = 0x00; + __DEL(b); +} + +Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len) +{ + Modules_Module _o_result; + Modules_Module m = NIL; + CHAR bodyname[64]; + Modules_Command body; + __DUP(name, name__len, CHAR); + m = Modules_modules(); + while ((m != NIL && __STRCMP(m->name, name) != 0)) { + m = m->next; + } + if (m != NIL) { + Modules_res = 0; + Modules_resMsg[0] = 0x00; + } else { + Modules_res = 1; + __COPY(name, Modules_importing, ((LONGINT)(20))); + __MOVE(" module \"", Modules_resMsg, 10); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), name, name__len); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)"\" not found", (LONGINT)12); + } + _o_result = m; + __DEL(name); + return _o_result; +} + +Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len) +{ + Modules_Command _o_result; + Modules_Cmd c = NIL; + __DUP(name, name__len, CHAR); + c = mod->cmds; + while ((c != NIL && __STRCMP(c->name, name) != 0)) { + c = c->next; + } + if (c != NIL) { + Modules_res = 0; + Modules_resMsg[0] = 0x00; + _o_result = c->cmd; + __DEL(name); + return _o_result; + } else { + Modules_res = 2; + __MOVE(" command \"", Modules_resMsg, 11); + __COPY(name, Modules_importing, ((LONGINT)(20))); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), mod->name, ((LONGINT)(20))); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)".", (LONGINT)2); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), name, name__len); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)"\" not found", (LONGINT)12); + _o_result = NIL; + __DEL(name); + return _o_result; + } + __RETCHK; +} + +void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all) +{ + Modules_Module m = NIL, p = NIL; + __DUP(name, name__len, CHAR); + m = Modules_modules(); + if (all) { + Modules_res = 1; + __MOVE("unloading \"all\" not yet supported", Modules_resMsg, 34); + } else { + while ((m != NIL && __STRCMP(m->name, name) != 0)) { + p = m; + m = m->next; + } + if ((m != NIL && m->refcnt == 0)) { + if (m == Modules_modules()) { + Modules_setmodules(m->next); + } else { + p->next = m->next; + } + Modules_res = 0; + } else { + Modules_res = 1; + if (m == NIL) { + __MOVE("module not found", Modules_resMsg, 17); + } else { + __MOVE("clients of this module exist", Modules_resMsg, 29); + } + } + } + __DEL(name); +} + +__TDESC(Modules_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 48), {0, 28, -12}}; +__TDESC(Modules_CmdDesc, 1, 1) = {__TDFLDS("CmdDesc", 32), {0, -8}}; + +export void *Modules__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Console); + __MODULE_IMPORT(Heap); + __REGMOD("Modules", 0); + __INITYP(Modules_ModuleDesc, Modules_ModuleDesc, 0); + __INITYP(Modules_CmdDesc, Modules_CmdDesc, 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-48/Modules.h b/bootstrap/unix-48/Modules.h new file mode 100644 index 00000000..5968d1aa --- /dev/null +++ b/bootstrap/unix-48/Modules.h @@ -0,0 +1,54 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Modules__h +#define Modules__h + +#include "SYSTEM.h" + +typedef + struct Modules_CmdDesc *Modules_Cmd; + +typedef + void (*Modules_Command)(void); + +typedef + struct Modules_CmdDesc { + Modules_Cmd next; + CHAR name[24]; + Modules_Command cmd; + } Modules_CmdDesc; + +typedef + struct Modules_ModuleDesc *Modules_Module; + +typedef + CHAR Modules_ModuleName[20]; + +typedef + struct Modules_ModuleDesc { + Modules_Module next; + Modules_ModuleName name; + LONGINT refcnt; + Modules_Cmd cmds; + LONGINT types; + void (*enumPtrs)(void(*)(LONGINT)); + char _prvt0[8]; + } Modules_ModuleDesc; + + +import INTEGER Modules_res; +import CHAR Modules_resMsg[256]; +import Modules_ModuleName Modules_imported, Modules_importing; + +import LONGINT *Modules_ModuleDesc__typ; +import LONGINT *Modules_CmdDesc__typ; + +import void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all); +import Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len); +import Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len); +import void *Modules__init(void); + +#define Modules_modules() (Modules_Module)Heap_modules +#define Modules_setmodules(m) Heap_modules = m + +#endif diff --git a/bootstrap/unix-48/OPB.c b/bootstrap/unix-48/OPB.c new file mode 100644 index 00000000..0c22a7a7 --- /dev/null +++ b/bootstrap/unix-48/OPB.c @@ -0,0 +1,2677 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "OPM.h" +#include "OPS.h" +#include "OPT.h" + + +export void (*OPB_typSize)(OPT_Struct); +static INTEGER OPB_exp; +static LONGINT OPB_maxExp; + + +export void OPB_Assign (OPT_Node *x, OPT_Node y); +static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node y); +static LONGINT OPB_BoolToInt (BOOLEAN b); +export void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp); +static void OPB_CharToString (OPT_Node n); +static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode); +static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo); +export void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames); +static void OPB_CheckProc (OPT_Struct x, OPT_Object y); +static void OPB_CheckPtr (OPT_Node x, OPT_Node y); +static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x); +static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp); +static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y); +export void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y); +static void OPB_Convert (OPT_Node *x, OPT_Struct typ); +export void OPB_DeRef (OPT_Node *x); +static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar); +export OPT_Node OPB_EmptySet (void); +export void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc); +export void OPB_Field (OPT_Node *x, OPT_Object y); +export void OPB_In (OPT_Node *x, OPT_Node y); +export void OPB_Index (OPT_Node *x, OPT_Node y); +export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ); +static BOOLEAN OPB_IntToBool (LONGINT i); +export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y); +export void OPB_MOp (SHORTINT op, OPT_Node *x); +export OPT_Node OPB_NewBoolConst (BOOLEAN boolval); +export OPT_Node OPB_NewIntConst (LONGINT intval); +export OPT_Node OPB_NewLeaf (OPT_Object obj); +export OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ); +export OPT_Node OPB_NewString (OPS_String str, LONGINT len); +export OPT_Node OPB_Nil (void); +static BOOLEAN OPB_NotVar (OPT_Node x); +export void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y); +export void OPB_OptIf (OPT_Node *x); +export void OPB_Param (OPT_Node ap, OPT_Object fp); +export void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar); +export void OPB_Return (OPT_Node *x, OPT_Object proc); +export void OPB_SetElem (OPT_Node *x); +static void OPB_SetIntType (OPT_Node node); +export void OPB_SetRange (OPT_Node *x, OPT_Node y); +export void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno); +export void OPB_StPar0 (OPT_Node *par0, INTEGER fctno); +export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno); +export void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n); +export void OPB_StaticLink (SHORTINT dlev); +export void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard); +static void OPB_err (INTEGER n); +static LONGINT OPB_log (LONGINT x); + + +static void OPB_err (INTEGER n) +{ + OPM_err(n); +} + +OPT_Node OPB_NewLeaf (OPT_Object obj) +{ + OPT_Node _o_result; + OPT_Node node = NIL; + switch (obj->mode) { + case 1: + node = OPT_NewNode(0); + node->readonly = (obj->vis == 2 && obj->mnolev < 0); + break; + case 2: + node = OPT_NewNode(1); + break; + case 3: + node = OPT_NewNode(7); + node->conval = OPT_NewConst(); + __GUARDEQP(node->conval, OPT_ConstDesc) = *obj->conval; + break; + case 5: + node = OPT_NewNode(8); + break; + case 6: case 7: case 8: case 9: case 10: + node = OPT_NewNode(9); + break; + default: + OPB_err(127); + node = OPT_NewNode(0); + break; + } + node->obj = obj; + node->typ = obj->typ; + _o_result = node; + return _o_result; +} + +void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y) +{ + OPT_Node node = NIL; + node = OPT_NewNode(class); + node->typ = OPT_notyp; + node->left = *x; + node->right = y; + *x = node; +} + +void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y) +{ + if (*x == NIL) { + *x = y; + } else { + (*last)->link = y; + } + while (y->link != NIL) { + y = y->link; + } + *last = y; +} + +static LONGINT OPB_BoolToInt (BOOLEAN b) +{ + LONGINT _o_result; + if (b) { + _o_result = 1; + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +static BOOLEAN OPB_IntToBool (LONGINT i) +{ + BOOLEAN _o_result; + if (i == 0) { + _o_result = 0; + return _o_result; + } else { + _o_result = 1; + return _o_result; + } + __RETCHK; +} + +OPT_Node OPB_NewBoolConst (BOOLEAN boolval) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->typ = OPT_booltyp; + x->conval = OPT_NewConst(); + x->conval->intval = OPB_BoolToInt(boolval); + _o_result = x; + return _o_result; +} + +void OPB_OptIf (OPT_Node *x) +{ + OPT_Node if_ = NIL, pred = NIL; + if_ = (*x)->left; + while (if_->left->class == 7) { + if (OPB_IntToBool(if_->left->conval->intval)) { + *x = if_->right; + return; + } else if (if_->link == NIL) { + *x = (*x)->right; + return; + } else { + if_ = if_->link; + (*x)->left = if_; + } + } + pred = if_; + if_ = if_->link; + while (if_ != NIL) { + if (if_->left->class == 7) { + if (OPB_IntToBool(if_->left->conval->intval)) { + pred->link = NIL; + (*x)->right = if_->right; + return; + } else { + if_ = if_->link; + pred->link = if_; + } + } else { + pred = if_; + if_ = if_->link; + } + } +} + +OPT_Node OPB_Nil (void) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->typ = OPT_niltyp; + x->conval = OPT_NewConst(); + x->conval->intval = 0; + _o_result = x; + return _o_result; +} + +OPT_Node OPB_EmptySet (void) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->typ = OPT_settyp; + x->conval = OPT_NewConst(); + x->conval->setval = 0x0; + _o_result = x; + return _o_result; +} + +static void OPB_SetIntType (OPT_Node node) +{ + LONGINT v; + v = node->conval->intval; + if ((OPM_MinSInt <= (LONGINT)v && (LONGINT)v <= OPM_MaxSInt)) { + node->typ = OPT_sinttyp; + } else if ((OPM_MinInt <= (LONGINT)v && (LONGINT)v <= OPM_MaxInt)) { + node->typ = OPT_inttyp; + } else if ((OPM_MinLInt <= v && v <= OPM_MaxLInt)) { + node->typ = OPT_linttyp; + } else { + OPB_err(203); + node->typ = OPT_sinttyp; + node->conval->intval = 1; + } +} + +OPT_Node OPB_NewIntConst (LONGINT intval) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->conval = OPT_NewConst(); + x->conval->intval = intval; + OPB_SetIntType(x); + _o_result = x; + return _o_result; +} + +OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->conval = OPT_NewConst(); + x->conval->realval = realval; + x->typ = typ; + x->conval->intval = -1; + _o_result = x; + return _o_result; +} + +OPT_Node OPB_NewString (OPS_String str, LONGINT len) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->conval = OPT_NewConst(); + x->typ = OPT_stringtyp; + x->conval->intval = -1; + x->conval->intval2 = len; + x->conval->ext = OPT_NewExt(); + __COPY(str, *x->conval->ext, ((LONGINT)(256))); + _o_result = x; + return _o_result; +} + +static void OPB_CharToString (OPT_Node n) +{ + CHAR ch; + n->typ = OPT_stringtyp; + ch = (CHAR)n->conval->intval; + n->conval->ext = OPT_NewExt(); + if (ch == 0x00) { + n->conval->intval2 = 1; + } else { + n->conval->intval2 = 2; + (*n->conval->ext)[1] = 0x00; + } + (*n->conval->ext)[0] = ch; + n->conval->intval = -1; + n->obj = NIL; +} + +static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node y) +{ + OPT_Node node = NIL; + node = OPT_NewNode(class); + node->typ = typ; + node->left = *x; + node->right = y; + *x = node; +} + +static BOOLEAN OPB_NotVar (OPT_Node x) +{ + BOOLEAN _o_result; + _o_result = (x->class >= 7 && ((x->class != 11 || x->subcl != 29) || x->left->class >= 7)); + return _o_result; +} + +void OPB_DeRef (OPT_Node *x) +{ + OPT_Object strobj = NIL, bstrobj = NIL; + OPT_Struct typ = NIL, btyp = NIL; + typ = (*x)->typ; + if ((*x)->class >= 7) { + OPB_err(78); + } else if (typ->form == 13) { + if (typ == OPT_sysptrtyp) { + OPB_err(57); + } + btyp = typ->BaseTyp; + strobj = typ->strobj; + bstrobj = btyp->strobj; + if ((((((strobj != NIL && strobj->name[0] != 0x00)) && bstrobj != NIL)) && bstrobj->name[0] != 0x00)) { + btyp->pbused = 1; + } + OPB_BindNodes(3, btyp, &*x, NIL); + } else { + OPB_err(84); + } +} + +void OPB_Index (OPT_Node *x, OPT_Node y) +{ + INTEGER f; + OPT_Struct typ = NIL; + f = y->typ->form; + if ((*x)->class >= 7) { + OPB_err(79); + } else if (!__IN(f, 0x70) || __IN(y->class, 0x0300)) { + OPB_err(80); + y->typ = OPT_inttyp; + } + if ((*x)->typ->comp == 2) { + typ = (*x)->typ->BaseTyp; + if ((y->class == 7 && (y->conval->intval < 0 || y->conval->intval >= (*x)->typ->n))) { + OPB_err(81); + } + } else if ((*x)->typ->comp == 3) { + typ = (*x)->typ->BaseTyp; + if ((y->class == 7 && y->conval->intval < 0)) { + OPB_err(81); + } + } else { + OPB_err(82); + typ = OPT_undftyp; + } + OPB_BindNodes(4, typ, &*x, y); + (*x)->readonly = (*x)->left->readonly; +} + +void OPB_Field (OPT_Node *x, OPT_Object y) +{ + if ((*x)->class >= 7) { + OPB_err(77); + } + if ((y != NIL && __IN(y->mode, 0x2010))) { + OPB_BindNodes(2, y->typ, &*x, NIL); + (*x)->obj = y; + (*x)->readonly = (*x)->left->readonly || (y->vis == 2 && y->mnolev < 0); + } else { + OPB_err(83); + (*x)->typ = OPT_undftyp; + } +} + +static struct TypTest__57 { + OPT_Node *x; + OPT_Object *obj; + BOOLEAN *guard; + struct TypTest__57 *lnk; +} *TypTest__57_s; + +static void GTT__58 (OPT_Struct t0, OPT_Struct t1); + +static void GTT__58 (OPT_Struct t0, OPT_Struct t1) +{ + OPT_Node node = NIL; + OPT_Struct t = NIL; + t = t0; + while ((((t != NIL && t != t1)) && t != OPT_undftyp)) { + t = t->BaseTyp; + } + if (t != t1) { + while ((((t1 != NIL && t1 != t0)) && t1 != OPT_undftyp)) { + t1 = t1->BaseTyp; + } + if (t1 == t0 || t0->form == 0) { + if (*TypTest__57_s->guard) { + OPB_BindNodes(5, NIL, &*TypTest__57_s->x, NIL); + (*TypTest__57_s->x)->readonly = (*TypTest__57_s->x)->left->readonly; + } else { + node = OPT_NewNode(11); + node->subcl = 16; + node->left = *TypTest__57_s->x; + node->obj = *TypTest__57_s->obj; + *TypTest__57_s->x = node; + } + } else { + OPB_err(85); + } + } else if (t0 != t1) { + OPB_err(85); + } else if (!*TypTest__57_s->guard) { + if ((*TypTest__57_s->x)->class == 5) { + node = OPT_NewNode(11); + node->subcl = 16; + node->left = *TypTest__57_s->x; + node->obj = *TypTest__57_s->obj; + *TypTest__57_s->x = node; + } else { + *TypTest__57_s->x = OPB_NewBoolConst(1); + } + } +} + +void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard) +{ + struct TypTest__57 _s; + _s.x = x; + _s.obj = &obj; + _s.guard = &guard; + _s.lnk = TypTest__57_s; + TypTest__57_s = &_s; + if (OPB_NotVar(*x)) { + OPB_err(112); + } else if ((*x)->typ->form == 13) { + if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) { + OPB_err(85); + } else if (obj->typ->form == 13) { + GTT__58((*x)->typ->BaseTyp, obj->typ->BaseTyp); + } else { + OPB_err(86); + } + } else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) { + GTT__58((*x)->typ, obj->typ); + } else { + OPB_err(87); + } + if (guard) { + (*x)->typ = obj->typ; + } else { + (*x)->typ = OPT_booltyp; + } + TypTest__57_s = _s.lnk; +} + +void OPB_In (OPT_Node *x, OPT_Node y) +{ + INTEGER f; + LONGINT k; + f = (*x)->typ->form; + if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) { + OPB_err(126); + } else if ((__IN(f, 0x70) && y->typ->form == 9)) { + if ((*x)->class == 7) { + k = (*x)->conval->intval; + if (k < 0 || k > (LONGINT)OPM_MaxSet) { + OPB_err(202); + } else if (y->class == 7) { + (*x)->conval->intval = OPB_BoolToInt(__IN(k, y->conval->setval)); + (*x)->obj = NIL; + } else { + OPB_BindNodes(12, OPT_booltyp, &*x, y); + (*x)->subcl = 15; + } + } else { + OPB_BindNodes(12, OPT_booltyp, &*x, y); + (*x)->subcl = 15; + } + } else { + OPB_err(92); + } + (*x)->typ = OPT_booltyp; +} + +static LONGINT OPB_log (LONGINT x) +{ + LONGINT _o_result; + OPB_exp = 0; + if (x > 0) { + while (!__ODD(x)) { + x = __ASHR(x, 1); + OPB_exp += 1; + } + } + _o_result = x; + return _o_result; +} + +static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x) +{ + LONGREAL min, max, r; + if (f == 7) { + min = OPM_MinReal; + max = OPM_MaxReal; + } else { + min = OPM_MinLReal; + max = OPM_MaxLReal; + } + r = __ABS(x->realval); + if (r > max || r < min) { + OPB_err(nr); + x->realval = (LONGREAL)1; + } else if (f == 7) { + x->realval = x->realval; + } + x->intval = -1; +} + +static struct MOp__28 { + struct MOp__28 *lnk; +} *MOp__28_s; + +static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z); + +static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z) +{ + OPT_Node _o_result; + OPT_Node node = NIL; + node = OPT_NewNode(11); + node->subcl = op; + node->typ = typ; + node->left = z; + _o_result = node; + return _o_result; +} + +void OPB_MOp (SHORTINT op, OPT_Node *x) +{ + INTEGER f; + OPT_Struct typ = NIL; + OPT_Node z = NIL; + struct MOp__28 _s; + _s.lnk = MOp__28_s; + MOp__28_s = &_s; + z = *x; + if (z->class == 8 || z->class == 9) { + OPB_err(126); + } else { + typ = z->typ; + f = typ->form; + switch (op) { + case 33: + if (f == 2) { + if (z->class == 7) { + z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval)); + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(98); + } + break; + case 6: + if (!__IN(f, 0x01f0)) { + OPB_err(96); + } + break; + case 7: + if (__IN(f, 0x03f0)) { + if (z->class == 7) { + if (__IN(f, 0x70)) { + if (z->conval->intval == (-2147483647-1)) { + OPB_err(203); + } else { + z->conval->intval = -z->conval->intval; + OPB_SetIntType(z); + } + } else if (__IN(f, 0x0180)) { + z->conval->realval = -z->conval->realval; + } else { + z->conval->setval = ~z->conval->setval; + } + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(97); + } + break; + case 21: + if (__IN(f, 0x01f0)) { + if (z->class == 7) { + if (__IN(f, 0x70)) { + if (z->conval->intval == (-2147483647-1)) { + OPB_err(203); + } else { + z->conval->intval = __ABS(z->conval->intval); + OPB_SetIntType(z); + } + } else { + z->conval->realval = __ABS(z->conval->realval); + } + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(111); + } + break; + case 22: + if (f == 3) { + if (z->class == 7) { + z->conval->intval = (int)__CAP((CHAR)z->conval->intval); + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(111); + z->typ = OPT_chartyp; + } + break; + case 23: + if (__IN(f, 0x70)) { + if (z->class == 7) { + z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval)); + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(111); + } + z->typ = OPT_booltyp; + break; + case 24: + if ((((z->class == 7 && f == 3)) && z->conval->intval >= 32)) { + OPB_CharToString(z); + f = 10; + } + if (z->class < 7 || f == 10) { + z = NewOp__29(op, typ, z); + } else { + OPB_err(127); + } + z->typ = OPT_linttyp; + break; + case 25: + if ((__IN(f, 0x70) && z->class == 7)) { + if ((0 <= z->conval->intval && z->conval->intval <= -1)) { + z = NewOp__29(op, typ, z); + } else { + OPB_err(219); + } + } else { + OPB_err(69); + } + z->typ = OPT_booltyp; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.MOp, op = ", (LONGINT)33); + OPM_LogWNum(op, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } + *x = z; + MOp__28_s = _s.lnk; +} + +static void OPB_CheckPtr (OPT_Node x, OPT_Node y) +{ + INTEGER g; + OPT_Struct p = NIL, q = NIL, t = NIL; + g = y->typ->form; + if (g == 13) { + p = x->typ->BaseTyp; + q = y->typ->BaseTyp; + if ((p->comp == 4 && q->comp == 4)) { + if (p->extlev < q->extlev) { + t = p; + p = q; + q = t; + } + while ((((p != q && p != NIL)) && p != OPT_undftyp)) { + p = p->BaseTyp; + } + if (p == NIL) { + OPB_err(100); + } + } else { + OPB_err(100); + } + } else if (g != 11) { + OPB_err(100); + } +} + +void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames) +{ + OPT_Struct ft = NIL, at = NIL; + while (fp != NIL) { + if (ap != NIL) { + ft = fp->typ; + at = ap->typ; + while ((ft->comp == 3 && at->comp == 3)) { + ft = ft->BaseTyp; + at = at->BaseTyp; + } + if (ft != at) { + if ((ft->form == 14 && at->form == 14)) { + if (ft->BaseTyp == at->BaseTyp) { + OPB_CheckParameters(ft->link, at->link, 0); + } else { + OPB_err(117); + } + } else { + OPB_err(115); + } + } + if (fp->mode != ap->mode || (checkNames && __STRCMP(fp->name, ap->name) != 0)) { + OPB_err(115); + } + ap = ap->link; + } else { + OPB_err(116); + } + fp = fp->link; + } + if (ap != NIL) { + OPB_err(116); + } +} + +static void OPB_CheckProc (OPT_Struct x, OPT_Object y) +{ + if (__IN(y->mode, 0x04c0)) { + if (y->mode == 6) { + if (y->mnolev == 0) { + y->mode = 7; + } else { + OPB_err(73); + } + } + if (x->BaseTyp == y->typ) { + OPB_CheckParameters(x->link, y->link, 0); + } else { + OPB_err(117); + } + } else { + OPB_err(113); + } +} + +static struct ConstOp__13 { + OPT_Node *x; + INTEGER *f; + OPT_Const *xval, *yval; + struct ConstOp__13 *lnk; +} *ConstOp__13_s; + +static INTEGER ConstCmp__14 (void); + +static INTEGER ConstCmp__14 (void) +{ + INTEGER _o_result; + INTEGER res; + switch (*ConstOp__13_s->f) { + case 0: + res = 9; + break; + case 1: case 3: case 4: case 5: case 6: + if ((*ConstOp__13_s->xval)->intval < (*ConstOp__13_s->yval)->intval) { + res = 11; + } else if ((*ConstOp__13_s->xval)->intval > (*ConstOp__13_s->yval)->intval) { + res = 13; + } else { + res = 9; + } + break; + case 7: case 8: + if ((*ConstOp__13_s->xval)->realval < (*ConstOp__13_s->yval)->realval) { + res = 11; + } else if ((*ConstOp__13_s->xval)->realval > (*ConstOp__13_s->yval)->realval) { + res = 13; + } else { + res = 9; + } + break; + case 2: + if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) { + res = 10; + } else { + res = 9; + } + break; + case 9: + if ((*ConstOp__13_s->xval)->setval != (*ConstOp__13_s->yval)->setval) { + res = 10; + } else { + res = 9; + } + break; + case 10: + if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) < 0) { + res = 11; + } else if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) > 0) { + res = 13; + } else { + res = 9; + } + break; + case 11: case 13: case 14: + if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) { + res = 10; + } else { + res = 9; + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", (LONGINT)37); + OPM_LogWNum(*ConstOp__13_s->f, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + (*ConstOp__13_s->x)->typ = OPT_booltyp; + _o_result = res; + return _o_result; +} + +static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y) +{ + INTEGER f, g; + OPT_Const xval = NIL, yval = NIL; + LONGINT xv, yv; + BOOLEAN temp; + struct ConstOp__13 _s; + _s.x = &x; + _s.f = &f; + _s.xval = &xval; + _s.yval = &yval; + _s.lnk = ConstOp__13_s; + ConstOp__13_s = &_s; + f = x->typ->form; + g = y->typ->form; + xval = x->conval; + yval = y->conval; + if (f != g) { + switch (f) { + case 3: + if (g == 10) { + OPB_CharToString(x); + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 4: + if (__IN(g, 0x70)) { + x->typ = y->typ; + } else if (g == 7) { + x->typ = OPT_realtyp; + xval->realval = xval->intval; + } else if (g == 8) { + x->typ = OPT_lrltyp; + xval->realval = xval->intval; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 5: + if (g == 4) { + y->typ = OPT_inttyp; + } else if (__IN(g, 0x70)) { + x->typ = y->typ; + } else if (g == 7) { + x->typ = OPT_realtyp; + xval->realval = xval->intval; + } else if (g == 8) { + x->typ = OPT_lrltyp; + xval->realval = xval->intval; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 6: + if (__IN(g, 0x70)) { + y->typ = OPT_linttyp; + } else if (g == 7) { + x->typ = OPT_realtyp; + xval->realval = xval->intval; + } else if (g == 8) { + x->typ = OPT_lrltyp; + xval->realval = xval->intval; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 7: + if (__IN(g, 0x70)) { + y->typ = x->typ; + yval->realval = yval->intval; + } else if (g == 8) { + x->typ = OPT_lrltyp; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 8: + if (__IN(g, 0x70)) { + y->typ = x->typ; + yval->realval = yval->intval; + } else if (g == 7) { + y->typ = OPT_lrltyp; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 10: + if (g == 3) { + OPB_CharToString(y); + g = 10; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 11: + if (!__IN(g, 0x6000)) { + OPB_err(100); + } + break; + case 13: + OPB_CheckPtr(x, y); + break; + case 14: + if (g != 11) { + OPB_err(100); + } + break; + default: + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + break; + } + f = x->typ->form; + } + switch (op) { + case 1: + if (__IN(f, 0x70)) { + xv = xval->intval; + yv = yval->intval; + if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(2147483647, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-2147483647-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-2147483647-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-2147483647-1))) && yv != (-2147483647-1))) && -xv <= __DIV(2147483647, -yv))) { + xval->intval = xv * yv; + OPB_SetIntType(x); + } else { + OPB_err(204); + } + } else if (__IN(f, 0x0180)) { + temp = __ABS(yval->realval) <= (LONGREAL)1; + if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 / (LONGREAL)__ABS(yval->realval)) { + xval->realval = xval->realval * yval->realval; + OPB_CheckRealType(f, 204, xval); + } else { + OPB_err(204); + } + } else if (f == 9) { + xval->setval = (xval->setval & yval->setval); + } else if (f != 0) { + OPB_err(101); + } + break; + case 2: + if (__IN(f, 0x70)) { + if (yval->intval != 0) { + xval->realval = xval->intval / (REAL)yval->intval; + OPB_CheckRealType(7, 205, xval); + } else { + OPB_err(205); + xval->realval = (LONGREAL)1; + } + x->typ = OPT_realtyp; + } else if (__IN(f, 0x0180)) { + temp = __ABS(yval->realval) >= (LONGREAL)1; + if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 * __ABS(yval->realval)) { + xval->realval = xval->realval / yval->realval; + OPB_CheckRealType(f, 205, xval); + } else { + OPB_err(205); + } + } else if (f == 9) { + xval->setval = xval->setval ^ yval->setval; + } else if (f != 0) { + OPB_err(102); + } + break; + case 3: + if (__IN(f, 0x70)) { + if (yval->intval != 0) { + xval->intval = __DIV(xval->intval, yval->intval); + OPB_SetIntType(x); + } else { + OPB_err(205); + } + } else if (f != 0) { + OPB_err(103); + } + break; + case 4: + if (__IN(f, 0x70)) { + if (yval->intval != 0) { + xval->intval = __MOD(xval->intval, yval->intval); + OPB_SetIntType(x); + } else { + OPB_err(205); + } + } else if (f != 0) { + OPB_err(104); + } + break; + case 5: + if (f == 2) { + xval->intval = OPB_BoolToInt((OPB_IntToBool(xval->intval) && OPB_IntToBool(yval->intval))); + } else { + OPB_err(94); + } + break; + case 6: + if (__IN(f, 0x70)) { + temp = (yval->intval >= 0 && xval->intval <= 2147483647 - yval->intval); + if (temp || (yval->intval < 0 && xval->intval >= (-2147483647-1) - yval->intval)) { + xval->intval += yval->intval; + OPB_SetIntType(x); + } else { + OPB_err(206); + } + } else if (__IN(f, 0x0180)) { + temp = (yval->realval >= (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 - yval->realval); + if (temp || (yval->realval < (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 - yval->realval)) { + xval->realval = xval->realval + yval->realval; + OPB_CheckRealType(f, 206, xval); + } else { + OPB_err(206); + } + } else if (f == 9) { + xval->setval = xval->setval | yval->setval; + } else if (f != 0) { + OPB_err(105); + } + break; + case 7: + if (__IN(f, 0x70)) { + if ((yval->intval >= 0 && xval->intval >= (-2147483647-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 2147483647 + yval->intval)) { + xval->intval -= yval->intval; + OPB_SetIntType(x); + } else { + OPB_err(207); + } + } else if (__IN(f, 0x0180)) { + temp = (yval->realval >= (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 + yval->realval); + if (temp || (yval->realval < (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 + yval->realval)) { + xval->realval = xval->realval - yval->realval; + OPB_CheckRealType(f, 207, xval); + } else { + OPB_err(207); + } + } else if (f == 9) { + xval->setval = (xval->setval & ~yval->setval); + } else if (f != 0) { + OPB_err(106); + } + break; + case 8: + if (f == 2) { + xval->intval = OPB_BoolToInt(OPB_IntToBool(xval->intval) || OPB_IntToBool(yval->intval)); + } else { + OPB_err(95); + } + break; + case 9: + xval->intval = OPB_BoolToInt(ConstCmp__14() == 9); + break; + case 10: + xval->intval = OPB_BoolToInt(ConstCmp__14() != 9); + break; + case 11: + if (__IN(f, 0x2a04)) { + OPB_err(108); + } else { + xval->intval = OPB_BoolToInt(ConstCmp__14() == 11); + } + break; + case 12: + if (__IN(f, 0x2a04)) { + OPB_err(108); + } else { + xval->intval = OPB_BoolToInt(ConstCmp__14() != 13); + } + break; + case 13: + if (__IN(f, 0x2a04)) { + OPB_err(108); + } else { + xval->intval = OPB_BoolToInt(ConstCmp__14() == 13); + } + break; + case 14: + if (__IN(f, 0x2a04)) { + OPB_err(108); + } else { + xval->intval = OPB_BoolToInt(ConstCmp__14() != 11); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstOp, op = ", (LONGINT)37); + OPM_LogWNum(op, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + ConstOp__13_s = _s.lnk; +} + +static void OPB_Convert (OPT_Node *x, OPT_Struct typ) +{ + OPT_Node node = NIL; + INTEGER f, g; + LONGINT k; + LONGREAL r; + f = (*x)->typ->form; + g = typ->form; + if ((*x)->class == 7) { + if (__IN(f, 0x70)) { + if (__IN(g, 0x70)) { + if (f > g) { + OPB_SetIntType(*x); + if ((int)(*x)->typ->form > g) { + OPB_err(203); + (*x)->conval->intval = 1; + } + } + } else if (__IN(g, 0x0180)) { + (*x)->conval->realval = (*x)->conval->intval; + (*x)->conval->intval = -1; + } else { + k = (*x)->conval->intval; + if (0 > k || k > 255) { + OPB_err(220); + } + } + } else if (__IN(f, 0x0180)) { + if (__IN(g, 0x0180)) { + OPB_CheckRealType(g, 203, (*x)->conval); + } else { + r = (*x)->conval->realval; + if (r < -2.14748364800000e+009 || r > 2.14748364700000e+009) { + OPB_err(203); + r = (LONGREAL)1; + } + (*x)->conval->intval = __ENTIER(r); + OPB_SetIntType(*x); + } + } + (*x)->obj = NIL; + } else if (((((*x)->class == 11 && (*x)->subcl == 20)) && ((int)(*x)->left->typ->form < f || f > g))) { + if ((*x)->left->typ == typ) { + *x = (*x)->left; + } + } else { + node = OPT_NewNode(11); + node->subcl = 20; + node->left = *x; + *x = node; + } + (*x)->typ = typ; +} + +static struct Op__38 { + INTEGER *f, *g; + struct Op__38 *lnk; +} *Op__38_s; + +static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y); +static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y); + +static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y) +{ + OPT_Node node = NIL; + node = OPT_NewNode(12); + node->subcl = op; + node->typ = typ; + node->left = *x; + node->right = y; + *x = node; +} + +static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y) +{ + BOOLEAN _o_result; + BOOLEAN ok, xCharArr, yCharArr; + xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 10; + yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 10; + if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) { + OPB_CharToString(*y); + *Op__38_s->g = 10; + yCharArr = 1; + } + if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) { + OPB_CharToString(*x); + *Op__38_s->f = 10; + xCharArr = 1; + } + ok = (xCharArr && yCharArr); + if (ok) { + if ((*Op__38_s->f == 10 && (*x)->conval->intval2 == 1)) { + (*x)->typ = OPT_chartyp; + (*x)->conval->intval = 0; + OPB_Index(&*y, OPB_NewIntConst(((LONGINT)(0)))); + } else if ((*Op__38_s->g == 10 && (*y)->conval->intval2 == 1)) { + (*y)->typ = OPT_chartyp; + (*y)->conval->intval = 0; + OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0)))); + } + } + _o_result = ok; + return _o_result; +} + +void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y) +{ + INTEGER f, g; + OPT_Node t = NIL, z = NIL; + OPT_Struct typ = NIL; + BOOLEAN do_; + LONGINT val; + struct Op__38 _s; + _s.f = &f; + _s.g = &g; + _s.lnk = Op__38_s; + Op__38_s = &_s; + z = *x; + if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) { + OPB_err(126); + } else if ((z->class == 7 && y->class == 7)) { + OPB_ConstOp(op, z, y); + z->obj = NIL; + } else { + if (z->typ != y->typ) { + g = y->typ->form; + switch (z->typ->form) { + case 3: + if (z->class == 7) { + OPB_CharToString(z); + } else { + OPB_err(100); + } + break; + case 4: + if (__IN(g, 0x01f0)) { + OPB_Convert(&z, y->typ); + } else { + OPB_err(100); + } + break; + case 5: + if (g == 4) { + OPB_Convert(&y, z->typ); + } else if (__IN(g, 0x01f0)) { + OPB_Convert(&z, y->typ); + } else { + OPB_err(100); + } + break; + case 6: + if (__IN(g, 0x70)) { + OPB_Convert(&y, z->typ); + } else if (__IN(g, 0x0180)) { + OPB_Convert(&z, y->typ); + } else { + OPB_err(100); + } + break; + case 7: + if (__IN(g, 0x70)) { + OPB_Convert(&y, z->typ); + } else if (__IN(g, 0x0180)) { + OPB_Convert(&z, y->typ); + } else { + OPB_err(100); + } + break; + case 8: + if (__IN(g, 0x01f0)) { + OPB_Convert(&y, z->typ); + } else if (__IN(g, 0x0180)) { + OPB_Convert(&y, z->typ); + } else { + OPB_err(100); + } + break; + case 11: + if (!__IN(g, 0x6000)) { + OPB_err(100); + } + break; + case 13: + OPB_CheckPtr(z, y); + break; + case 14: + if (g != 11) { + OPB_err(100); + } + break; + case 10: + break; + case 15: + if (z->typ->comp == 4) { + OPB_err(100); + } + break; + default: + OPB_err(100); + break; + } + } + typ = z->typ; + f = typ->form; + g = y->typ->form; + switch (op) { + case 1: + do_ = 1; + if (__IN(f, 0x70)) { + if (z->class == 7) { + val = z->conval->intval; + if (val == 1) { + do_ = 0; + z = y; + } else if (val == 0) { + do_ = 0; + } else if (OPB_log(val) == 1) { + t = y; + y = z; + z = t; + op = 17; + y->typ = OPT_sinttyp; + y->conval->intval = OPB_exp; + y->obj = NIL; + } + } else if (y->class == 7) { + val = y->conval->intval; + if (val == 1) { + do_ = 0; + } else if (val == 0) { + do_ = 0; + z = y; + } else if (OPB_log(val) == 1) { + op = 17; + y->typ = OPT_sinttyp; + y->conval->intval = OPB_exp; + y->obj = NIL; + } + } + } else if (!__IN(f, 0x0381)) { + OPB_err(105); + typ = OPT_undftyp; + } + if (do_) { + NewOp__39(op, typ, &z, y); + } + break; + case 2: + if (__IN(f, 0x70)) { + if ((y->class == 7 && y->conval->intval == 0)) { + OPB_err(205); + } + OPB_Convert(&z, OPT_realtyp); + OPB_Convert(&y, OPT_realtyp); + typ = OPT_realtyp; + } else if (__IN(f, 0x0180)) { + if ((y->class == 7 && y->conval->realval == (LONGREAL)0)) { + OPB_err(205); + } + } else if ((f != 9 && f != 0)) { + OPB_err(102); + typ = OPT_undftyp; + } + NewOp__39(op, typ, &z, y); + break; + case 3: + do_ = 1; + if (__IN(f, 0x70)) { + if (y->class == 7) { + val = y->conval->intval; + if (val == 0) { + OPB_err(205); + } else if (val == 1) { + do_ = 0; + } else if (OPB_log(val) == 1) { + op = 17; + y->typ = OPT_sinttyp; + y->conval->intval = -OPB_exp; + y->obj = NIL; + } + } + } else if (f != 0) { + OPB_err(103); + typ = OPT_undftyp; + } + if (do_) { + NewOp__39(op, typ, &z, y); + } + break; + case 4: + if (__IN(f, 0x70)) { + if (y->class == 7) { + if (y->conval->intval == 0) { + OPB_err(205); + } else if (OPB_log(y->conval->intval) == 1) { + op = 18; + y->conval->intval = __ASH(-1, OPB_exp); + y->obj = NIL; + } + } + } else if (f != 0) { + OPB_err(104); + typ = OPT_undftyp; + } + NewOp__39(op, typ, &z, y); + break; + case 5: + if (f == 2) { + if (z->class == 7) { + if (OPB_IntToBool(z->conval->intval)) { + z = y; + } + } else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) { + } else { + NewOp__39(op, typ, &z, y); + } + } else if (f != 0) { + OPB_err(94); + z->typ = OPT_undftyp; + } + break; + case 6: + if (!__IN(f, 0x03f1)) { + OPB_err(105); + typ = OPT_undftyp; + } + do_ = 1; + if (__IN(f, 0x70)) { + if ((z->class == 7 && z->conval->intval == 0)) { + do_ = 0; + z = y; + } + if ((y->class == 7 && y->conval->intval == 0)) { + do_ = 0; + } + } + if (do_) { + NewOp__39(op, typ, &z, y); + } + break; + case 7: + if (!__IN(f, 0x03f1)) { + OPB_err(106); + typ = OPT_undftyp; + } + if ((!__IN(f, 0x70) || y->class != 7) || y->conval->intval != 0) { + NewOp__39(op, typ, &z, y); + } + break; + case 8: + if (f == 2) { + if (z->class == 7) { + if (!OPB_IntToBool(z->conval->intval)) { + z = y; + } + } else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) { + } else { + NewOp__39(op, typ, &z, y); + } + } else if (f != 0) { + OPB_err(95); + z->typ = OPT_undftyp; + } + break; + case 9: case 10: + if (__IN(f, 0x6bff) || strings__41(&z, &y)) { + typ = OPT_booltyp; + } else { + OPB_err(107); + typ = OPT_undftyp; + } + NewOp__39(op, typ, &z, y); + break; + case 11: case 12: case 13: case 14: + if (__IN(f, 0x01f9) || strings__41(&z, &y)) { + typ = OPT_booltyp; + } else { + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"ELSE in Op()", (LONGINT)13); + OPM_LogWLn(); + OPB_err(108); + typ = OPT_undftyp; + } + NewOp__39(op, typ, &z, y); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", (LONGINT)32); + OPM_LogWNum(op, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } + *x = z; + Op__38_s = _s.lnk; +} + +void OPB_SetRange (OPT_Node *x, OPT_Node y) +{ + LONGINT k, l; + if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) { + OPB_err(126); + } else if ((__IN((*x)->typ->form, 0x70) && __IN(y->typ->form, 0x70))) { + if ((*x)->class == 7) { + k = (*x)->conval->intval; + if (0 > k || k > (LONGINT)OPM_MaxSet) { + OPB_err(202); + } + } + if (y->class == 7) { + l = y->conval->intval; + if (0 > l || l > (LONGINT)OPM_MaxSet) { + OPB_err(202); + } + } + if (((*x)->class == 7 && y->class == 7)) { + if (k <= l) { + (*x)->conval->setval = __SETRNG(k, l); + } else { + OPB_err(201); + (*x)->conval->setval = __SETRNG(l, k); + } + (*x)->obj = NIL; + } else { + OPB_BindNodes(10, OPT_settyp, &*x, y); + } + } else { + OPB_err(93); + } + (*x)->typ = OPT_settyp; +} + +void OPB_SetElem (OPT_Node *x) +{ + LONGINT k; + if ((*x)->class == 8 || (*x)->class == 9) { + OPB_err(126); + } else if (!__IN((*x)->typ->form, 0x70)) { + OPB_err(93); + } else if ((*x)->class == 7) { + k = (*x)->conval->intval; + if ((0 <= k && k <= (LONGINT)OPM_MaxSet)) { + (*x)->conval->setval = __SETOF(k); + } else { + OPB_err(202); + } + (*x)->obj = NIL; + } else { + OPB_Convert(&*x, OPT_settyp); + } + (*x)->typ = OPT_settyp; +} + +static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode) +{ + INTEGER f, g; + OPT_Struct y = NIL, p = NIL, q = NIL; + if (OPM_Verbose) { + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"PROCEDURE CheckAssign", (LONGINT)22); + OPM_LogWLn(); + } + y = ynode->typ; + f = x->form; + g = y->form; + if (OPM_Verbose) { + OPM_LogWStr((CHAR*)"y.form = ", (LONGINT)10); + OPM_LogWNum(y->form, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"f = ", (LONGINT)5); + OPM_LogWNum(f, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"g = ", (LONGINT)5); + OPM_LogWNum(g, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"ynode.typ.syze = ", (LONGINT)18); + OPM_LogWNum(ynode->typ->size, ((LONGINT)(0))); + OPM_LogWLn(); + } + if (ynode->class == 8 || (ynode->class == 9 && f != 14)) { + OPB_err(126); + } + switch (f) { + case 0: case 10: + break; + case 1: + if (!__IN(g, 0x1a)) { + OPB_err(113); + } + break; + case 2: case 3: case 4: case 9: + if (g != f) { + OPB_err(113); + } + break; + case 5: + if (!__IN(g, 0x30)) { + OPB_err(113); + } + break; + case 6: + if (OPM_LIntSize == 4) { + if (!__IN(g, 0x70)) { + OPB_err(113); + } + } else { + if (!__IN(g, 0x70)) { + OPB_err(113); + } + } + break; + case 7: + if (!__IN(g, 0xf0)) { + OPB_err(113); + } + break; + case 8: + if (!__IN(g, 0x01f0)) { + OPB_err(113); + } + break; + case 13: + if ((x == y || g == 11) || (x == OPT_sysptrtyp && g == 13)) { + } else if (g == 13) { + p = x->BaseTyp; + q = y->BaseTyp; + if ((p->comp == 4 && q->comp == 4)) { + while ((((q != p && q != NIL)) && q != OPT_undftyp)) { + q = q->BaseTyp; + } + if (q == NIL) { + OPB_err(113); + } + } else { + OPB_err(113); + } + } else { + OPB_err(113); + } + break; + case 14: + if (ynode->class == 9) { + OPB_CheckProc(x, ynode->obj); + } else if (x == y || g == 11) { + } else { + OPB_err(113); + } + break; + case 12: case 11: + OPB_err(113); + break; + case 15: + x->pvused = 1; + if (x->comp == 2) { + if ((ynode->class == 7 && g == 3)) { + OPB_CharToString(ynode); + y = ynode->typ; + g = 10; + } + if (x == y) { + } else if (x->BaseTyp == OPT_chartyp) { + if (g == 10) { + if (ynode->conval->intval2 > x->n) { + OPB_err(114); + } + } else if ((__IN(y->comp, 0x0c) && y->BaseTyp == OPT_chartyp)) { + } else { + OPB_err(113); + } + } else { + OPB_err(113); + } + } else if ((x->comp == 3 && x->BaseTyp == OPT_chartyp)) { + if ((__IN(y->comp, 0x0c) && y->BaseTyp == OPT_chartyp)) { + } else { + OPB_err(113); + } + } else if (x->comp == 4) { + if (x == y) { + } else if (y->comp == 4) { + q = y->BaseTyp; + while ((((q != NIL && q != x)) && q != OPT_undftyp)) { + q = q->BaseTyp; + } + if (q == NIL) { + OPB_err(113); + } + } else { + OPB_err(113); + } + } else { + OPB_err(113); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.CheckAssign, f = ", (LONGINT)40); + OPM_LogWNum(f, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + if ((((((ynode->class == 7 && g < f)) && __IN(g, 0xf0))) && __IN(f, 0x01e0))) { + OPB_Convert(&ynode, x); + } +} + +static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo) +{ +} + +void OPB_StPar0 (OPT_Node *par0, INTEGER fctno) +{ + INTEGER f; + OPT_Struct typ = NIL; + OPT_Node x = NIL; + x = *par0; + f = x->typ->form; + switch (fctno) { + case 0: + if ((__IN(f, 0x70) && x->class == 7)) { + if ((0 <= x->conval->intval && x->conval->intval <= 255)) { + OPB_BindNodes(28, OPT_notyp, &x, x); + } else { + OPB_err(218); + } + } else { + OPB_err(69); + } + x->typ = OPT_notyp; + break; + case 1: + typ = OPT_notyp; + if (OPB_NotVar(x)) { + OPB_err(112); + } else if (f == 13) { + if (x->readonly) { + OPB_err(76); + } + f = x->typ->BaseTyp->comp; + if (__IN(f, 0x1c)) { + if (f == 3) { + typ = x->typ->BaseTyp; + } + OPB_BindNodes(19, OPT_notyp, &x, NIL); + x->subcl = 1; + } else { + OPB_err(111); + } + } else { + OPB_err(111); + } + x->typ = typ; + break; + case 2: + OPB_MOp(21, &x); + break; + case 3: + OPB_MOp(22, &x); + break; + case 4: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (f == 3) { + OPB_Convert(&x, OPT_inttyp); + } else { + OPB_err(111); + } + x->typ = OPT_inttyp; + break; + case 5: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x0180)) { + OPB_Convert(&x, OPT_linttyp); + } else { + OPB_err(111); + } + x->typ = OPT_linttyp; + break; + case 6: + OPB_MOp(23, &x); + break; + case 7: + if (x->class == 8) { + switch (f) { + case 2: + x = OPB_NewBoolConst(0); + break; + case 3: + x = OPB_NewIntConst(((LONGINT)(0))); + x->typ = OPT_chartyp; + break; + case 4: + x = OPB_NewIntConst(OPM_MinSInt); + break; + case 5: + x = OPB_NewIntConst(OPM_MinInt); + break; + case 6: + x = OPB_NewIntConst(OPM_MinLInt); + break; + case 9: + x = OPB_NewIntConst(((LONGINT)(0))); + x->typ = OPT_inttyp; + break; + case 7: + x = OPB_NewRealConst(OPM_MinReal, OPT_realtyp); + break; + case 8: + x = OPB_NewRealConst(OPM_MinLReal, OPT_lrltyp); + break; + default: + OPB_err(111); + break; + } + } else { + OPB_err(110); + } + break; + case 8: + if (x->class == 8) { + switch (f) { + case 2: + x = OPB_NewBoolConst(1); + break; + case 3: + x = OPB_NewIntConst(((LONGINT)(255))); + x->typ = OPT_chartyp; + break; + case 4: + x = OPB_NewIntConst(OPM_MaxSInt); + break; + case 5: + x = OPB_NewIntConst(OPM_MaxInt); + break; + case 6: + x = OPB_NewIntConst(OPM_MaxLInt); + break; + case 9: + x = OPB_NewIntConst(OPM_MaxSet); + x->typ = OPT_inttyp; + break; + case 7: + x = OPB_NewRealConst(OPM_MaxReal, OPT_realtyp); + break; + case 8: + x = OPB_NewRealConst(OPM_MaxLReal, OPT_lrltyp); + break; + default: + OPB_err(111); + break; + } + } else { + OPB_err(110); + } + break; + case 9: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x71)) { + OPB_Convert(&x, OPT_chartyp); + } else { + OPB_err(111); + x->typ = OPT_chartyp; + } + break; + case 10: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (f == 5) { + OPB_Convert(&x, OPT_sinttyp); + } else if (f == 6) { + OPB_Convert(&x, OPT_inttyp); + } else if (f == 8) { + OPB_Convert(&x, OPT_realtyp); + } else { + OPB_err(111); + } + break; + case 11: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (f == 4) { + OPB_Convert(&x, OPT_inttyp); + } else if (f == 5) { + OPB_Convert(&x, OPT_linttyp); + } else if (f == 7) { + OPB_Convert(&x, OPT_lrltyp); + } else if (f == 3) { + OPB_Convert(&x, OPT_linttyp); + } else { + OPB_err(111); + } + break; + case 13: case 14: + if (OPB_NotVar(x)) { + OPB_err(112); + } else if (!__IN(f, 0x70)) { + OPB_err(111); + } else if (x->readonly) { + OPB_err(76); + } + break; + case 15: case 16: + if (OPB_NotVar(x)) { + OPB_err(112); + } else if (x->typ != OPT_settyp) { + OPB_err(111); + x->typ = OPT_settyp; + } else if (x->readonly) { + OPB_err(76); + } + break; + case 17: + if (!__IN(x->typ->comp, 0x0c)) { + OPB_err(131); + } + break; + case 18: + if ((x->class == 7 && f == 3)) { + OPB_CharToString(x); + f = 10; + } + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (((!__IN(x->typ->comp, 0x0c) || x->typ->BaseTyp->form != 3) && f != 10)) { + OPB_err(111); + } + break; + case 19: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + if (f != 6) { + OPB_Convert(&x, OPT_linttyp); + } + } else { + OPB_err(111); + x->typ = OPT_linttyp; + } + break; + case 20: + OPB_CheckLeaf(x, 0); + OPB_MOp(24, &x); + break; + case 12: + if (x->class != 8) { + OPB_err(110); + x = OPB_NewIntConst(((LONGINT)(1))); + } else if (__IN(f, 0x63fe) || __IN(x->typ->comp, 0x14)) { + (*OPB_typSize)(x->typ); + x->typ->pvused = 1; + x = OPB_NewIntConst(x->typ->size); + } else { + OPB_err(111); + x = OPB_NewIntConst(((LONGINT)(1))); + } + break; + case 21: + OPB_MOp(25, &x); + break; + case 22: case 23: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (!__IN(f, 0x027a)) { + OPB_err(111); + } + break; + case 24: case 25: case 28: case 31: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if ((x->class == 7 && __IN(f, 0x30))) { + OPB_Convert(&x, OPT_linttyp); + } else if (!__IN(f, 0x2040)) { + OPB_err(111); + x->typ = OPT_linttyp; + } + break; + case 26: case 27: + if ((__IN(f, 0x70) && x->class == 7)) { + if (x->conval->intval < 0 || x->conval->intval > -1) { + OPB_err(220); + } + } else { + OPB_err(69); + } + break; + case 29: + if (x->class != 8) { + OPB_err(110); + } else if (__IN(f, 0x1401) || x->typ->comp == 3) { + OPB_err(111); + } + break; + case 30: + if (OPB_NotVar(x)) { + OPB_err(112); + } else if (f == 13) { + } else { + OPB_err(111); + } + break; + case 32: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + x = OPB_NewBoolConst(0); + } else if (f != 2) { + OPB_err(120); + x = OPB_NewBoolConst(0); + } else { + OPB_MOp(33, &x); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.StPar0, fctno = ", (LONGINT)39); + OPM_LogWNum(fctno, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + *par0 = x; +} + +static struct StPar1__52 { + struct StPar1__52 *lnk; +} *StPar1__52_s; + +static OPT_Node NewOp__53 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right); + +static OPT_Node NewOp__53 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right) +{ + OPT_Node _o_result; + OPT_Node node = NIL; + node = OPT_NewNode(class); + node->subcl = subcl; + node->left = left; + node->right = right; + _o_result = node; + return _o_result; +} + +void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno) +{ + INTEGER f, L; + OPT_Struct typ = NIL; + OPT_Node p = NIL, t = NIL; + struct StPar1__52 _s; + _s.lnk = StPar1__52_s; + StPar1__52_s = &_s; + p = *par0; + f = x->typ->form; + switch (fctno) { + case 13: case 14: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + p->typ = OPT_notyp; + } else { + if (x->typ != p->typ) { + if ((x->class == 7 && __IN(f, 0x70))) { + OPB_Convert(&x, p->typ); + } else { + OPB_err(111); + } + } + p = NewOp__53(19, fctno, p, x); + p->typ = OPT_notyp; + } + break; + case 15: case 16: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (LONGINT)OPM_MaxSet))) { + OPB_err(202); + } + p = NewOp__53(19, fctno, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + break; + case 17: + if (!__IN(f, 0x70) || x->class != 7) { + OPB_err(69); + } else if (f == 4) { + L = (int)x->conval->intval; + typ = p->typ; + while ((L > 0 && __IN(typ->comp, 0x0c))) { + typ = typ->BaseTyp; + L -= 1; + } + if (L != 0 || !__IN(typ->comp, 0x0c)) { + OPB_err(132); + } else { + x->obj = NIL; + if (typ->comp == 3) { + while (p->class == 4) { + p = p->left; + x->conval->intval += 1; + } + p = NewOp__53(12, 19, p, x); + p->typ = OPT_linttyp; + } else { + p = x; + p->conval->intval = typ->n; + OPB_SetIntType(p); + } + } + } else { + OPB_err(132); + } + break; + case 18: + if (OPB_NotVar(x)) { + OPB_err(112); + } else if ((__IN(x->typ->comp, 0x0c) && x->typ->BaseTyp->form == 3)) { + if (x->readonly) { + OPB_err(76); + } + t = x; + x = p; + p = t; + p = NewOp__53(19, 18, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + break; + case 19: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + if ((p->class == 7 && x->class == 7)) { + if (-OPB_maxExp > x->conval->intval || x->conval->intval > OPB_maxExp) { + OPB_err(208); + p->conval->intval = 1; + } else if (x->conval->intval >= 0) { + if (__ABS(p->conval->intval) <= __DIV(2147483647, __ASH(1, x->conval->intval))) { + p->conval->intval = p->conval->intval * __ASH(1, x->conval->intval); + } else { + OPB_err(208); + p->conval->intval = 1; + } + } else { + p->conval->intval = __ASH(p->conval->intval, x->conval->intval); + } + p->obj = NIL; + } else { + p = NewOp__53(12, 17, p, x); + p->typ = OPT_linttyp; + } + } else { + OPB_err(111); + } + break; + case 1: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (p->typ->comp == 3) { + if (__IN(f, 0x70)) { + if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) { + OPB_err(63); + } + } else { + OPB_err(111); + } + p->right = x; + p->typ = p->typ->BaseTyp; + } else { + OPB_err(64); + } + break; + case 22: case 23: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (!__IN(f, 0x70)) { + OPB_err(111); + } else { + if (fctno == 22) { + p = NewOp__53(12, 27, p, x); + } else { + p = NewOp__53(12, 28, p, x); + } + p->typ = p->left->typ; + } + break; + case 24: case 25: case 26: case 27: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x63ff)) { + if (fctno == 24 || fctno == 26) { + if (OPB_NotVar(x)) { + OPB_err(112); + } + t = x; + x = p; + p = t; + } + p = NewOp__53(19, fctno, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + break; + case 28: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + p = NewOp__53(12, 26, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_booltyp; + break; + case 29: + if (((x->class == 8 || x->class == 9) || __IN(f, 0x1401)) || x->typ->comp == 3) { + OPB_err(126); + } + t = OPT_NewNode(11); + t->subcl = 29; + t->left = x; + x = t; + x->typ = p->typ; + p = x; + break; + case 30: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + p = NewOp__53(19, 30, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + break; + case 31: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if ((x->class == 7 && __IN(f, 0x30))) { + OPB_Convert(&x, OPT_linttyp); + } else if (!__IN(f, 0x2040)) { + OPB_err(111); + x->typ = OPT_linttyp; + } + p->link = x; + break; + case 32: + if ((__IN(f, 0x70) && x->class == 7)) { + if ((0 <= x->conval->intval && x->conval->intval <= 255)) { + OPB_BindNodes(28, OPT_notyp, &x, x); + x->conval = OPT_NewConst(); + x->conval->intval = OPM_errpos; + OPB_Construct(15, &p, x); + p->conval = OPT_NewConst(); + p->conval->intval = OPM_errpos; + OPB_Construct(20, &p, NIL); + OPB_OptIf(&p); + if (p == NIL) { + } else if (p->class == 28) { + OPB_err(99); + } else { + p->subcl = 32; + } + } else { + OPB_err(218); + } + } else { + OPB_err(69); + } + break; + default: + OPB_err(64); + break; + } + *par0 = p; + StPar1__52_s = _s.lnk; +} + +void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n) +{ + OPT_Node node = NIL; + INTEGER f; + OPT_Node p = NIL; + p = *par0; + f = x->typ->form; + if (fctno == 1) { + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (p->typ->comp != 3) { + OPB_err(64); + } else if (__IN(f, 0x70)) { + if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) { + OPB_err(63); + } + node = p->right; + while (node->link != NIL) { + node = node->link; + } + node->link = x; + p->typ = p->typ->BaseTyp; + } else { + OPB_err(111); + } + } else if ((fctno == 31 && n == 2)) { + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + node = OPT_NewNode(19); + node->subcl = 31; + node->right = p; + node->left = p->link; + p->link = x; + p = node; + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + } else { + OPB_err(64); + } + *par0 = p; +} + +void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno) +{ + INTEGER dim; + OPT_Node x = NIL, p = NIL; + p = *par0; + if (fctno <= 19) { + if ((fctno == 1 && p->typ != OPT_notyp)) { + if (p->typ->comp == 3) { + OPB_err(65); + } + p->typ = OPT_notyp; + } else if (fctno <= 12) { + if (parno < 1) { + OPB_err(65); + } + } else { + if (((fctno == 13 || fctno == 14) && parno == 1)) { + OPB_BindNodes(19, OPT_notyp, &p, OPB_NewIntConst(((LONGINT)(1)))); + p->subcl = fctno; + p->right->typ = p->left->typ; + } else if ((fctno == 17 && parno == 1)) { + if (p->typ->comp == 3) { + dim = 0; + while (p->class == 4) { + p = p->left; + dim += 1; + } + OPB_BindNodes(12, OPT_linttyp, &p, OPB_NewIntConst(dim)); + p->subcl = 19; + } else { + p = OPB_NewIntConst(p->typ->n); + } + } else if (parno < 2) { + OPB_err(65); + } + } + } else if (fctno == 32) { + if (parno == 1) { + x = NIL; + OPB_BindNodes(28, OPT_notyp, &x, OPB_NewIntConst(((LONGINT)(0)))); + x->conval = OPT_NewConst(); + x->conval->intval = OPM_errpos; + OPB_Construct(15, &p, x); + p->conval = OPT_NewConst(); + p->conval->intval = OPM_errpos; + OPB_Construct(20, &p, NIL); + OPB_OptIf(&p); + if (p == NIL) { + } else if (p->class == 28) { + OPB_err(99); + } else { + p->subcl = 32; + } + } else if (parno < 1) { + OPB_err(65); + } + } else { + if ((parno < 1 || (fctno > 21 && parno < 2)) || (fctno == 31 && parno < 3)) { + OPB_err(65); + } + } + *par0 = p; +} + +static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar) +{ + INTEGER f; + f = atyp->comp; + ftyp = ftyp->BaseTyp; + atyp = atyp->BaseTyp; + if ((fvarpar && ftyp == OPT_bytetyp)) { + if (!__IN(f, 0x0c) || !__IN(atyp->form, 0x1e)) { + if (__IN(18, OPM_opt)) { + OPB_err(-301); + } + } + } else if (__IN(f, 0x0c)) { + if (ftyp->comp == 3) { + OPB_DynArrParCheck(ftyp, atyp, fvarpar); + } else if (ftyp != atyp) { + if ((((!fvarpar && ftyp->form == 13)) && atyp->form == 13)) { + ftyp = ftyp->BaseTyp; + atyp = atyp->BaseTyp; + if ((ftyp->comp == 4 && atyp->comp == 4)) { + while ((((ftyp != atyp && atyp != NIL)) && atyp != OPT_undftyp)) { + atyp = atyp->BaseTyp; + } + if (atyp == NIL) { + OPB_err(113); + } + } else { + OPB_err(66); + } + } else { + OPB_err(66); + } + } + } else { + OPB_err(67); + } +} + +static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp) +{ + if (fp->typ->form == 13) { + if ((*x)->class == 3) { + *x = (*x)->left; + } else { + OPB_err(71); + } + } +} + +void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar) +{ + if (((*x)->obj != NIL && __IN((*x)->obj->mode, 0x22c0))) { + *fpar = (*x)->obj->link; + if ((*x)->obj->mode == 13) { + OPB_CheckReceiver(&(*x)->left, *fpar); + *fpar = (*fpar)->link; + } + } else if (((((*x)->class != 8 && (*x)->typ != NIL)) && (*x)->typ->form == 14)) { + *fpar = (*x)->typ->link; + } else { + OPB_err(121); + *fpar = NIL; + (*x)->typ = OPT_undftyp; + } +} + +void OPB_Param (OPT_Node ap, OPT_Object fp) +{ + OPT_Struct q = NIL; + if (fp->typ->form != 0) { + if (fp->mode == 2) { + if (OPB_NotVar(ap)) { + OPB_err(122); + } else { + OPB_CheckLeaf(ap, 0); + } + if (ap->readonly) { + OPB_err(76); + } + if (fp->typ->comp == 3) { + OPB_DynArrParCheck(fp->typ, ap->typ, 1); + } else if ((fp->typ->comp == 4 && ap->typ->comp == 4)) { + q = ap->typ; + while ((((q != fp->typ && q != NIL)) && q != OPT_undftyp)) { + q = q->BaseTyp; + } + if (q == NIL) { + OPB_err(111); + } + } else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 13)) { + } else if ((ap->typ != fp->typ && !((fp->typ->form == 1 && __IN(ap->typ->form, 0x18))))) { + OPB_err(123); + } else if ((fp->typ->form == 13 && ap->class == 5)) { + OPB_err(123); + } + } else if (fp->typ->comp == 3) { + if ((ap->class == 7 && ap->typ->form == 3)) { + OPB_CharToString(ap); + } + if ((ap->typ->form == 10 && fp->typ->BaseTyp->form == 3)) { + } else if (ap->class >= 7) { + OPB_err(59); + } else { + OPB_DynArrParCheck(fp->typ, ap->typ, 0); + } + } else { + OPB_CheckAssign(fp->typ, ap); + } + } +} + +void OPB_StaticLink (SHORTINT dlev) +{ + OPT_Object scope = NIL; + scope = OPT_topScope; + while (dlev > 0) { + dlev -= 1; + scope->link->conval->setval |= __SETOF(3); + scope = scope->left; + } +} + +void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp) +{ + OPT_Struct typ = NIL; + OPT_Node p = NIL; + SHORTINT lev; + if ((*x)->class == 9) { + typ = (*x)->typ; + lev = (*x)->obj->mnolev; + if (lev > 0) { + OPB_StaticLink(OPT_topScope->mnolev - lev); + } + if ((*x)->obj->mode == 10) { + OPB_err(121); + } + } else if (((*x)->class == 2 && (*x)->obj->mode == 13)) { + typ = (*x)->typ; + (*x)->class = 9; + p = (*x)->left; + (*x)->left = NIL; + p->link = apar; + apar = p; + fp = (*x)->obj->link; + } else { + typ = (*x)->typ->BaseTyp; + } + OPB_BindNodes(13, typ, &*x, apar); + (*x)->obj = fp; +} + +void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc) +{ + OPT_Node x = NIL; + x = OPT_NewNode(18); + x->typ = OPT_notyp; + x->obj = proc; + x->left = *procdec; + x->right = stat; + *procdec = x; +} + +void OPB_Return (OPT_Node *x, OPT_Object proc) +{ + OPT_Node node = NIL; + if (proc == NIL) { + if (*x != NIL) { + OPB_err(124); + } + } else { + if (*x != NIL) { + OPB_CheckAssign(proc->typ, *x); + } else if (proc->typ != OPT_notyp) { + OPB_err(124); + } + } + node = OPT_NewNode(26); + node->typ = OPT_notyp; + node->obj = proc; + node->left = *x; + *x = node; +} + +void OPB_Assign (OPT_Node *x, OPT_Node y) +{ + OPT_Node z = NIL; + SHORTINT subcl; + if ((*x)->class >= 7) { + OPB_err(56); + } + OPB_CheckAssign((*x)->typ, y); + if ((*x)->readonly) { + OPB_err(76); + } + if ((*x)->typ->comp == 4) { + if ((*x)->class == 5) { + z = (*x)->left; + } else { + z = *x; + } + if ((z->class == 3 && z->left->class == 5)) { + z->left = z->left->left; + } + if (((*x)->typ->strobj != NIL && (z->class == 3 || z->class == 1))) { + OPB_BindNodes(6, (*x)->typ, &z, NIL); + *x = z; + } + } else if (((((((*x)->typ->comp == 2 && (*x)->typ->BaseTyp == OPT_chartyp)) && y->typ->form == 10)) && y->conval->intval2 == 1)) { + y->typ = OPT_chartyp; + y->conval->intval = 0; + OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0)))); + } + if ((((((__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp == OPT_chartyp)) && __IN(y->typ->comp, 0x0c))) && y->typ->BaseTyp == OPT_chartyp)) { + subcl = 18; + } else { + subcl = 0; + } + OPB_BindNodes(19, OPT_notyp, &*x, y); + (*x)->subcl = subcl; +} + +void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ) +{ + OPT_Node node = NIL; + node = OPT_NewNode(14); + node->typ = typ; + node->conval = OPT_NewConst(); + node->conval->intval = typ->txtpos; + if (*inittd == NIL) { + *inittd = node; + } else { + (*last)->link = node; + } + *last = node; +} + + +export void *OPB__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPS); + __MODULE_IMPORT(OPT); + __REGMOD("OPB", 0); +/* BEGIN */ + OPB_maxExp = OPB_log(1073741824); + OPB_maxExp = OPB_exp; + __ENDMOD; +} diff --git a/bootstrap/unix-48/OPB.h b/bootstrap/unix-48/OPB.h new file mode 100644 index 00000000..8cd47ee6 --- /dev/null +++ b/bootstrap/unix-48/OPB.h @@ -0,0 +1,49 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPB__h +#define OPB__h + +#include "SYSTEM.h" +#include "OPS.h" +#include "OPT.h" + + +import void (*OPB_typSize)(OPT_Struct); + + +import void OPB_Assign (OPT_Node *x, OPT_Node y); +import void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp); +import void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames); +import void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y); +import void OPB_DeRef (OPT_Node *x); +import OPT_Node OPB_EmptySet (void); +import void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc); +import void OPB_Field (OPT_Node *x, OPT_Object y); +import void OPB_In (OPT_Node *x, OPT_Node y); +import void OPB_Index (OPT_Node *x, OPT_Node y); +import void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ); +import void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y); +import void OPB_MOp (SHORTINT op, OPT_Node *x); +import OPT_Node OPB_NewBoolConst (BOOLEAN boolval); +import OPT_Node OPB_NewIntConst (LONGINT intval); +import OPT_Node OPB_NewLeaf (OPT_Object obj); +import OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ); +import OPT_Node OPB_NewString (OPS_String str, LONGINT len); +import OPT_Node OPB_Nil (void); +import void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y); +import void OPB_OptIf (OPT_Node *x); +import void OPB_Param (OPT_Node ap, OPT_Object fp); +import void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar); +import void OPB_Return (OPT_Node *x, OPT_Object proc); +import void OPB_SetElem (OPT_Node *x); +import void OPB_SetRange (OPT_Node *x, OPT_Node y); +import void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno); +import void OPB_StPar0 (OPT_Node *par0, INTEGER fctno); +import void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno); +import void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n); +import void OPB_StaticLink (SHORTINT dlev); +import void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard); +import void *OPB__init(void); + + +#endif diff --git a/bootstrap/unix-48/OPC.c b/bootstrap/unix-48/OPC.c new file mode 100644 index 00000000..32a1496f --- /dev/null +++ b/bootstrap/unix-48/OPC.c @@ -0,0 +1,2108 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "Configuration.h" +#include "OPM.h" +#include "OPT.h" + + +static INTEGER OPC_indentLevel; +static BOOLEAN OPC_ptrinit, OPC_mainprog, OPC_ansi; +static SHORTINT OPC_hashtab[105]; +static CHAR OPC_keytab[36][9]; +static BOOLEAN OPC_GlbPtrs; +static CHAR OPC_BodyNameExt[13]; + + +export void OPC_Align (LONGINT *adr, LONGINT base); +export void OPC_Andent (OPT_Struct typ); +static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames); +export LONGINT OPC_Base (OPT_Struct typ); +export OPT_Object OPC_BaseTProc (OPT_Object obj); +export void OPC_BegBlk (void); +export void OPC_BegStat (void); +static void OPC_CProcDefs (OPT_Object obj, INTEGER vis); +export void OPC_Case (LONGINT caseVal, INTEGER form); +export void OPC_Cmp (INTEGER rel); +export void OPC_CompleteIdent (OPT_Object obj); +export void OPC_Constant (OPT_Const con, INTEGER form); +static void OPC_DeclareBase (OPT_Object dcl); +static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef); +static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro); +static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty); +static void OPC_DefAnonRecs (OPT_Node n); +export void OPC_DefineInter (OPT_Object proc); +static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty); +static void OPC_DefineTProcTypes (OPT_Object obj); +static void OPC_DefineType (OPT_Struct str); +export void OPC_EndBlk (void); +export void OPC_EndBlk0 (void); +export void OPC_EndStat (void); +export void OPC_EnterBody (void); +export void OPC_EnterProc (OPT_Object proc); +export void OPC_ExitBody (void); +export void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet); +static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *n, LONGINT *curAlign); +static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign); +export void OPC_GenBdy (OPT_Node n); +static void OPC_GenDynTypes (OPT_Node n, INTEGER vis); +export void OPC_GenEnumPtrs (OPT_Object var); +export void OPC_GenHdr (OPT_Node n); +export void OPC_GenHdrIncludes (void); +static void OPC_GenHeaderMsg (void); +export void OPC_Halt (LONGINT n); +export void OPC_Ident (OPT_Object obj); +static void OPC_IdentList (OPT_Object obj, INTEGER vis); +static void OPC_Include (CHAR *name, LONGINT name__len); +static void OPC_IncludeImports (OPT_Object obj, INTEGER vis); +export void OPC_Increment (BOOLEAN decrement); +export void OPC_Indent (INTEGER count); +export void OPC_Init (void); +static void OPC_InitImports (OPT_Object obj); +static void OPC_InitKeywords (void); +export void OPC_InitTDesc (OPT_Struct typ); +static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj); +export void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim); +static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName); +static INTEGER OPC_Length (CHAR *s, LONGINT s__len); +export LONGINT OPC_NofPtrs (OPT_Struct typ); +static INTEGER OPC_PerfectHash (CHAR *s, LONGINT s__len); +static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len); +static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define); +static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis); +static void OPC_PutBase (OPT_Struct typ); +static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt); +static void OPC_RegCmds (OPT_Object obj); +export void OPC_SetInclude (BOOLEAN exclude); +static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause); +static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x); +export void OPC_TDescDecl (OPT_Struct typ); +export void OPC_TypeDefs (OPT_Object obj, INTEGER vis); +export void OPC_TypeOf (OPT_Object ap); +static BOOLEAN OPC_Undefined (OPT_Object obj); + + +void OPC_Init (void) +{ + OPC_indentLevel = 0; + OPC_ptrinit = __IN(5, OPM_opt); + OPC_mainprog = OPM_mainProg || OPM_mainLinkStat; + OPC_ansi = __IN(6, OPM_opt); + if (OPC_ansi) { + __MOVE("__init(void)", OPC_BodyNameExt, 13); + } else { + __MOVE("__init()", OPC_BodyNameExt, 9); + } +} + +void OPC_Indent (INTEGER count) +{ + OPC_indentLevel += count; +} + +void OPC_BegStat (void) +{ + INTEGER i; + i = OPC_indentLevel; + while (i > 0) { + OPM_Write(0x09); + i -= 1; + } +} + +void OPC_EndStat (void) +{ + OPM_Write(';'); + OPM_WriteLn(); +} + +void OPC_BegBlk (void) +{ + OPM_Write('{'); + OPM_WriteLn(); + OPC_indentLevel += 1; +} + +void OPC_EndBlk (void) +{ + OPC_indentLevel -= 1; + OPC_BegStat(); + OPM_Write('}'); + OPM_WriteLn(); +} + +void OPC_EndBlk0 (void) +{ + OPC_indentLevel -= 1; + OPC_BegStat(); + OPM_Write('}'); +} + +static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x) +{ + CHAR ch; + INTEGER i; + __DUP(s, s__len, CHAR); + ch = s[0]; + i = 0; + while (ch != 0x00) { + if (ch == '#') { + OPM_WriteInt(x); + } else { + OPM_Write(ch); + } + i += 1; + ch = s[__X(i, s__len)]; + } + __DEL(s); +} + +static INTEGER OPC_Length (CHAR *s, LONGINT s__len) +{ + INTEGER _o_result; + INTEGER i; + i = 0; + while (s[__X(i, s__len)] != 0x00) { + i += 1; + } + _o_result = i; + return _o_result; +} + +static INTEGER OPC_PerfectHash (CHAR *s, LONGINT s__len) +{ + INTEGER _o_result; + INTEGER i, h; + i = 0; + h = 0; + while ((s[__X(i, s__len)] != 0x00 && i < 5)) { + h = 3 * h + (int)s[__X(i, s__len)]; + i += 1; + } + _o_result = (int)__MOD(h, 105); + return _o_result; +} + +void OPC_Ident (OPT_Object obj) +{ + INTEGER mode, level, h; + mode = obj->mode; + level = obj->mnolev; + if ((__IN(mode, 0x62) && level > 0) || __IN(mode, 0x14)) { + OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256))); + h = OPC_PerfectHash((void*)obj->name, ((LONGINT)(256))); + if (OPC_hashtab[__X(h, ((LONGINT)(105)))] >= 0) { + if (__STRCMP(OPC_keytab[__X(OPC_hashtab[__X(h, ((LONGINT)(105)))], ((LONGINT)(36)))], obj->name) == 0) { + OPM_Write('_'); + } + } + } else { + if (mode != 5 || obj->linkadr != 2) { + if (mode == 13) { + OPC_Ident(obj->link->typ->strobj); + } else if (level < 0) { + OPM_WriteStringVar((void*)OPT_GlbMod[__X(-level, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + if (OPM_currFile == 0) { + OPT_GlbMod[__X(-level, ((LONGINT)(64)))]->vis = 1; + } + } else { + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + } + OPM_Write('_'); + } else if (obj == OPT_sysptrtyp->strobj || obj == OPT_bytetyp->strobj) { + OPM_WriteString((CHAR*)"SYSTEM_", (LONGINT)8); + } + OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256))); + } +} + +static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause) +{ + INTEGER pointers; + *openClause = 0; + if (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->comp != 4)) { + if (__IN(typ->comp, 0x0c)) { + OPC_Stars(typ->BaseTyp, &*openClause); + *openClause = typ->comp == 2; + } else if (typ->form == 14) { + OPM_Write('('); + OPM_Write('*'); + } else { + pointers = 0; + while (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->form == 13)) { + pointers += 1; + typ = typ->BaseTyp; + } + if (pointers > 0) { + if (typ->comp != 3) { + OPC_Stars(typ, &*openClause); + } + if (*openClause) { + OPM_Write('('); + *openClause = 0; + } + while (pointers > 0) { + OPM_Write('*'); + pointers -= 1; + } + } + } + } +} + +static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef) +{ + OPT_Struct typ = NIL; + BOOLEAN varPar, openClause; + INTEGER form, comp; + typ = dcl->typ; + varPar = ((dcl->mode == 2 && typ->comp != 2) || typ->comp == 3) || scopeDef; + OPC_Stars(typ, &openClause); + if (varPar) { + if (openClause) { + OPM_Write('('); + } + OPM_Write('*'); + } + if (dcl->name[0] != 0x00) { + OPC_Ident(dcl); + } + if ((varPar && openClause)) { + OPM_Write(')'); + } + openClause = 0; + for (;;) { + form = typ->form; + comp = typ->comp; + if (((typ->strobj != NIL && typ->strobj->name[0] != 0x00) || form == 12) || comp == 4) { + break; + } else if ((form == 13 && typ->BaseTyp->comp != 3)) { + openClause = 1; + } else if (form == 14 || __IN(comp, 0x0c)) { + if (openClause) { + OPM_Write(')'); + openClause = 0; + } + if (form == 14) { + if (OPC_ansi) { + OPM_Write(')'); + OPC_AnsiParamList(typ->link, 0); + } else { + OPM_WriteString((CHAR*)")()", (LONGINT)4); + } + break; + } else if (comp == 2) { + OPM_Write('['); + OPM_WriteInt(typ->n); + OPM_Write(']'); + } + } else { + break; + } + typ = typ->BaseTyp; + } +} + +void OPC_Andent (OPT_Struct typ) +{ + if (typ->strobj == NIL || typ->align >= 65536) { + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + OPC_Str1((CHAR*)"__#", (LONGINT)4, __ASHR(typ->align, 16)); + } else { + OPC_Ident(typ->strobj); + } +} + +static BOOLEAN OPC_Undefined (OPT_Object obj) +{ + BOOLEAN _o_result; + _o_result = (((obj->mnolev >= 0 && obj->linkadr != (LONGINT)(3 + OPM_currFile))) && obj->linkadr != 2) || obj->name[0] == 0x00; + return _o_result; +} + +static void OPC_DeclareBase (OPT_Object dcl) +{ + OPT_Struct typ = NIL, prev = NIL; + OPT_Object obj = NIL; + INTEGER nofdims; + LONGINT off, n, dummy; + typ = dcl->typ; + prev = typ; + while ((((((((typ->strobj == NIL || typ->comp == 3) || OPC_Undefined(typ->strobj)) && typ->comp != 4)) && typ->form != 12)) && !((typ->form == 13 && typ->BaseTyp->comp == 3)))) { + prev = typ; + typ = typ->BaseTyp; + } + obj = typ->strobj; + if (typ->form == 12) { + OPM_WriteString((CHAR*)"void", (LONGINT)5); + } else if ((obj != NIL && !OPC_Undefined(obj))) { + OPC_Ident(obj); + } else if (typ->comp == 4) { + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPC_Andent(typ); + if ((prev->form != 13 && (obj != NIL || dcl->name[0] == 0x00))) { + if ((typ->BaseTyp != NIL && typ->BaseTyp->strobj->vis != 0)) { + OPM_WriteString((CHAR*)" { /* ", (LONGINT)7); + OPC_Ident(typ->BaseTyp->strobj); + OPM_WriteString((CHAR*)" */", (LONGINT)4); + OPM_WriteLn(); + OPC_Indent(1); + } else { + OPM_Write(' '); + OPC_BegBlk(); + } + OPC_FieldList(typ, 1, &off, &n, &dummy); + OPC_EndBlk0(); + } + } else if ((typ->form == 13 && typ->BaseTyp->comp == 3)) { + typ = typ->BaseTyp->BaseTyp; + nofdims = 1; + while (typ->comp == 3) { + nofdims += 1; + typ = typ->BaseTyp; + } + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPC_BegBlk(); + OPC_BegStat(); + OPC_Str1((CHAR*)"LONGINT len[#]", (LONGINT)15, nofdims); + OPC_EndStat(); + OPC_BegStat(); + __NEW(obj, OPT_ObjDesc); + __NEW(obj->typ, OPT_StrDesc); + obj->typ->form = 15; + obj->typ->comp = 2; + obj->typ->n = 1; + obj->typ->BaseTyp = typ; + obj->mode = 4; + __MOVE("data", obj->name, 5); + obj->linkadr = 0; + OPC_DeclareBase(obj); + OPM_Write(' '); + OPC_DeclareObj(obj, 0); + OPC_EndStat(); + OPC_EndBlk0(); + } +} + +LONGINT OPC_NofPtrs (OPT_Struct typ) +{ + LONGINT _o_result; + OPT_Object fld = NIL; + OPT_Struct btyp = NIL; + LONGINT n; + if ((typ->form == 13 && typ->sysflag == 0)) { + _o_result = 1; + return _o_result; + } else if ((typ->comp == 4 && __MASK(typ->sysflag, -256) == 0)) { + btyp = typ->BaseTyp; + if (btyp != NIL) { + n = OPC_NofPtrs(btyp); + } else { + n = 0; + } + fld = typ->link; + while ((fld != NIL && fld->mode == 4)) { + if (__STRCMP(fld->name, "@ptr") != 0) { + n = n + OPC_NofPtrs(fld->typ); + } else { + n += 1; + } + fld = fld->link; + } + _o_result = n; + return _o_result; + } else if (typ->comp == 2) { + btyp = typ->BaseTyp; + n = typ->n; + while (btyp->comp == 2) { + n = btyp->n * n; + btyp = btyp->BaseTyp; + } + _o_result = OPC_NofPtrs(btyp) * n; + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt) +{ + OPT_Object fld = NIL; + OPT_Struct btyp = NIL; + LONGINT n, i; + if ((typ->form == 13 && typ->sysflag == 0)) { + OPM_WriteInt(adr); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + *cnt += 1; + if (__MASK(*cnt, -16) == 0) { + OPM_WriteLn(); + OPM_Write(0x09); + } + } else if ((typ->comp == 4 && __MASK(typ->sysflag, -256) == 0)) { + btyp = typ->BaseTyp; + if (btyp != NIL) { + OPC_PutPtrOffsets(btyp, adr, &*cnt); + } + fld = typ->link; + while ((fld != NIL && fld->mode == 4)) { + if (__STRCMP(fld->name, "@ptr") != 0) { + OPC_PutPtrOffsets(fld->typ, adr + fld->adr, &*cnt); + } else { + OPM_WriteInt(adr + fld->adr); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + *cnt += 1; + if (__MASK(*cnt, -16) == 0) { + OPM_WriteLn(); + OPM_Write(0x09); + } + } + fld = fld->link; + } + } else if (typ->comp == 2) { + btyp = typ->BaseTyp; + n = typ->n; + while (btyp->comp == 2) { + n = btyp->n * n; + btyp = btyp->BaseTyp; + } + if (OPC_NofPtrs(btyp) > 0) { + i = 0; + while (i < n) { + OPC_PutPtrOffsets(btyp, adr + i * btyp->size, &*cnt); + i += 1; + } + } + } +} + +static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj) +{ + if (obj != NIL) { + OPC_InitTProcs(typ, obj->left); + if (obj->mode == 13) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"__INITBP(", (LONGINT)10); + OPC_Ident(typ); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(obj); + OPC_Str1((CHAR*)", #)", (LONGINT)5, __ASHR(obj->adr, 16)); + OPC_EndStat(); + } + OPC_InitTProcs(typ, obj->right); + } +} + +static void OPC_PutBase (OPT_Struct typ) +{ + if (typ != NIL) { + OPC_PutBase(typ->BaseTyp); + OPC_Ident(typ->strobj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + } +} + +static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName) +{ + OPT_Struct typ = NIL; + INTEGER dim; + if (showParamName) { + OPC_Ident(par); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + } + dim = 1; + typ = par->typ->BaseTyp; + while (typ->comp == 3) { + if (ansiDefine) { + OPM_WriteString((CHAR*)", LONGINT ", (LONGINT)11); + } else { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + } + if (showParamName) { + OPC_Ident(par); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + OPM_WriteInt(dim); + } + typ = typ->BaseTyp; + dim += 1; + } +} + +static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro) +{ + OPM_Write('('); + while (par != NIL) { + if (macro) { + OPM_WriteStringVar((void*)par->name, ((LONGINT)(256))); + } else { + if ((par->mode == 1 && par->typ->form == 7)) { + OPM_Write('_'); + } + OPC_Ident(par); + } + if (par->typ->comp == 3) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_LenList(par, 0, 1); + } else if ((par->mode == 2 && par->typ->comp == 4)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteStringVar((void*)par->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } + par = par->link; + if (par != NIL) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + } + } + OPM_Write(')'); +} + +static void OPC_DefineTProcTypes (OPT_Object obj) +{ + OPT_Object par = NIL; + if (obj->typ != OPT_notyp) { + OPC_DefineType(obj->typ); + } + if (OPC_ansi) { + par = obj->link; + while (par != NIL) { + OPC_DefineType(par->typ); + par = par->link; + } + } +} + +static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty) +{ + if (obj != NIL) { + OPC_DeclareTProcs(obj->left, &*empty); + if (obj->mode == 13) { + if (obj->typ != OPT_notyp) { + OPC_DefineType(obj->typ); + } + if (OPM_currFile == 0) { + if (obj->vis == 1) { + OPC_DefineTProcTypes(obj); + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + *empty = 0; + OPC_ProcHeader(obj, 0); + } + } else { + *empty = 0; + OPC_DefineTProcTypes(obj); + if (obj->vis == 0) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + } + OPC_ProcHeader(obj, 0); + } + } + OPC_DeclareTProcs(obj->right, &*empty); + } +} + +OPT_Object OPC_BaseTProc (OPT_Object obj) +{ + OPT_Object _o_result; + OPT_Struct typ = NIL, base = NIL; + LONGINT mno; + typ = obj->link->typ; + if (typ->form == 13) { + typ = typ->BaseTyp; + } + base = typ->BaseTyp; + mno = __ASHR(obj->adr, 16); + while ((base != NIL && mno < base->n)) { + typ = base; + base = typ->BaseTyp; + } + OPT_FindField(obj->name, typ, &obj); + _o_result = obj; + return _o_result; +} + +static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty) +{ + if (obj != NIL) { + OPC_DefineTProcMacros(obj->left, &*empty); + if ((((obj->mode == 13 && obj == OPC_BaseTProc(obj))) && (OPM_currFile != 0 || obj->vis == 1))) { + OPM_WriteString((CHAR*)"#define __", (LONGINT)11); + OPC_Ident(obj); + OPC_DeclareParams(obj->link, 1); + OPM_WriteString((CHAR*)" __SEND(", (LONGINT)9); + if (obj->link->typ->form == 13) { + OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10); + OPC_Ident(obj->link); + OPM_Write(')'); + } else { + OPC_Ident(obj->link); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } + OPC_Str1((CHAR*)", #, ", (LONGINT)6, __ASHR(obj->adr, 16)); + if (obj->typ == OPT_notyp) { + OPM_WriteString((CHAR*)"void", (LONGINT)5); + } else { + OPC_Ident(obj->typ->strobj); + } + OPM_WriteString((CHAR*)"(*)", (LONGINT)4); + if (OPC_ansi) { + OPC_AnsiParamList(obj->link, 0); + } else { + OPM_WriteString((CHAR*)"()", (LONGINT)3); + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_DeclareParams(obj->link, 1); + OPM_Write(')'); + OPM_WriteLn(); + } + OPC_DefineTProcMacros(obj->right, &*empty); + } +} + +static void OPC_DefineType (OPT_Struct str) +{ + OPT_Object obj = NIL, field = NIL, par = NIL; + BOOLEAN empty; + if (OPM_currFile == 1 || str->ref < 255) { + obj = str->strobj; + if (obj == NIL || OPC_Undefined(obj)) { + if (obj != NIL) { + if (obj->linkadr == 1) { + if (str->form != 13) { + OPM_Mark(244, str->txtpos); + obj->linkadr = 2; + } + } else { + obj->linkadr = 1; + } + } + if (str->comp == 4) { + if (str->BaseTyp != NIL) { + OPC_DefineType(str->BaseTyp); + } + field = str->link; + while ((field != NIL && field->mode == 4)) { + if (field->vis != 0 || OPM_currFile == 1) { + OPC_DefineType(field->typ); + } + field = field->link; + } + } else if (str->form == 13) { + if (str->BaseTyp->comp != 4) { + OPC_DefineType(str->BaseTyp); + } + } else if (__IN(str->comp, 0x0c)) { + OPC_DefineType(str->BaseTyp); + } else if (str->form == 14) { + if (str->BaseTyp != OPT_notyp) { + OPC_DefineType(str->BaseTyp); + } + field = str->link; + while (field != NIL) { + OPC_DefineType(field->typ); + field = field->link; + } + } + } + if ((obj != NIL && OPC_Undefined(obj))) { + OPM_WriteString((CHAR*)"typedef", (LONGINT)8); + OPM_WriteLn(); + OPM_Write(0x09); + OPC_Indent(1); + obj->linkadr = 1; + OPC_DeclareBase(obj); + OPM_Write(' '); + obj->typ->strobj = NIL; + OPC_DeclareObj(obj, 0); + obj->typ->strobj = obj; + obj->linkadr = 3 + OPM_currFile; + OPC_EndStat(); + OPC_Indent(-1); + OPM_WriteLn(); + if (obj->typ->comp == 4) { + empty = 1; + OPC_DeclareTProcs(str->link, &empty); + OPC_DefineTProcMacros(str->link, &empty); + if (!empty) { + OPM_WriteLn(); + } + } + } + } +} + +static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len) +{ + BOOLEAN _o_result; + INTEGER i; + BOOLEAN r; + __DUP(y, y__len, CHAR); + i = 0; + while ((*x)[__X(i + 1, ((LONGINT)(256)))] == y[__X(i, y__len)]) { + i += 1; + } + r = y[__X(i, y__len)] == 0x00; + _o_result = r; + __DEL(y); + return _o_result; +} + +static void OPC_CProcDefs (OPT_Object obj, INTEGER vis) +{ + INTEGER i; + OPT_ConstExt ext = NIL; + INTEGER _for__9; + if (obj != NIL) { + OPC_CProcDefs(obj->left, vis); + if ((((obj->mode == 9 && (int)obj->vis >= vis)) && obj->adr == 1)) { + ext = obj->conval->ext; + i = 1; + if (((*ext)[1] != '#' && !(OPC_Prefixed(ext, (CHAR*)"extern ", (LONGINT)8) || OPC_Prefixed(ext, (CHAR*)"import ", (LONGINT)8)))) { + OPM_WriteString((CHAR*)"#define ", (LONGINT)9); + OPC_Ident(obj); + OPC_DeclareParams(obj->link, 1); + OPM_Write(0x09); + } + _for__9 = (int)(*obj->conval->ext)[0]; + i = i; + while (i <= _for__9) { + OPM_Write((*obj->conval->ext)[__X(i, ((LONGINT)(256)))]); + i += 1; + } + OPM_WriteLn(); + } + OPC_CProcDefs(obj->right, vis); + } +} + +void OPC_TypeDefs (OPT_Object obj, INTEGER vis) +{ + if (obj != NIL) { + OPC_TypeDefs(obj->left, vis); + if ((obj->mode == 5 && obj->typ->txtpos > 0)) { + OPC_DefineType(obj->typ); + } + OPC_TypeDefs(obj->right, vis); + } +} + +static void OPC_DefAnonRecs (OPT_Node n) +{ + OPT_Object o = NIL; + OPT_Struct typ = NIL; + while ((n != NIL && n->class == 14)) { + typ = n->typ; + if ((typ->strobj == NIL && (OPM_currFile == 1 || typ->ref < 255))) { + OPC_DefineType(typ); + __NEW(o, OPT_ObjDesc); + o->typ = typ; + o->name[0] = 0x00; + OPC_DeclareBase(o); + OPC_EndStat(); + OPM_WriteLn(); + } + n = n->link; + } +} + +void OPC_TDescDecl (OPT_Struct typ) +{ + LONGINT nofptrs; + OPT_Object o = NIL; + OPC_BegStat(); + OPM_WriteString((CHAR*)"__TDESC(", (LONGINT)9); + OPC_Andent(typ); + OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1); + OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ)); + OPM_Write('\"'); + if (typ->strobj != NIL) { + OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256))); + } + OPC_Str1((CHAR*)"\", #), {", (LONGINT)9, typ->size); + nofptrs = 0; + OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs); + OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (LONGINT)OPM_LIntSize)); + OPC_EndStat(); +} + +void OPC_InitTDesc (OPT_Struct typ) +{ + OPC_BegStat(); + OPM_WriteString((CHAR*)"__INITYP(", (LONGINT)10); + OPC_Andent(typ); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (typ->BaseTyp != NIL) { + OPC_Andent(typ->BaseTyp); + } else { + OPC_Andent(typ); + } + OPC_Str1((CHAR*)", #)", (LONGINT)5, typ->extlev); + OPC_EndStat(); + if (typ->strobj != NIL) { + OPC_InitTProcs(typ->strobj, typ->link); + } +} + +void OPC_Align (LONGINT *adr, LONGINT base) +{ + switch (base) { + case 2: + *adr += __MASK(*adr, -2); + break; + case 4: + *adr += __MASK(-*adr, -4); + break; + case 8: + *adr += __MASK(-*adr, -8); + break; + case 16: + *adr += __MASK(-*adr, -16); + break; + default: + break; + } +} + +LONGINT OPC_Base (OPT_Struct typ) +{ + LONGINT _o_result; + switch (typ->form) { + case 1: + _o_result = 1; + return _o_result; + break; + case 3: + _o_result = OPM_CharAlign; + return _o_result; + break; + case 2: + _o_result = OPM_BoolAlign; + return _o_result; + break; + case 4: + _o_result = OPM_SIntAlign; + return _o_result; + break; + case 5: + _o_result = OPM_IntAlign; + return _o_result; + break; + case 6: + _o_result = OPM_LIntAlign; + return _o_result; + break; + case 7: + _o_result = OPM_RealAlign; + return _o_result; + break; + case 8: + _o_result = OPM_LRealAlign; + return _o_result; + break; + case 9: + _o_result = OPM_SetAlign; + return _o_result; + break; + case 13: + _o_result = OPM_PointerAlign; + return _o_result; + break; + case 14: + _o_result = OPM_ProcAlign; + return _o_result; + break; + case 15: + if (typ->comp == 4) { + _o_result = __MASK(typ->align, -65536); + return _o_result; + } else { + _o_result = OPC_Base(typ->BaseTyp); + return _o_result; + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPC.Base, typ^form = ", (LONGINT)40); + OPM_LogWNum(typ->form, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + __RETCHK; +} + +static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign) +{ + LONGINT adr; + adr = off; + OPC_Align(&adr, align); + if ((*curAlign < align && gap - (adr - off) >= align)) { + gap -= (adr - off) + align; + OPC_BegStat(); + if (align == (LONGINT)OPM_IntSize) { + OPM_WriteString((CHAR*)"INTEGER", (LONGINT)8); + } else if (align == (LONGINT)OPM_LIntSize) { + OPM_WriteString((CHAR*)"LONGINT", (LONGINT)8); + } else if (align == (LONGINT)OPM_LRealSize) { + OPM_WriteString((CHAR*)"LONGREAL", (LONGINT)9); + } + OPC_Str1((CHAR*)" _prvt#", (LONGINT)8, *n); + *n += 1; + OPC_EndStat(); + *curAlign = align; + } + if (gap > 0) { + OPC_BegStat(); + OPC_Str1((CHAR*)"char _prvt#", (LONGINT)12, *n); + *n += 1; + OPC_Str1((CHAR*)"[#]", (LONGINT)4, gap); + OPC_EndStat(); + } +} + +static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *n, LONGINT *curAlign) +{ + OPT_Object fld = NIL; + OPT_Struct base = NIL; + LONGINT gap, adr, align, fldAlign; + fld = typ->link; + align = __MASK(typ->align, -65536); + if (typ->BaseTyp != NIL) { + OPC_FieldList(typ->BaseTyp, 0, &*off, &*n, &*curAlign); + } else { + *off = 0; + *n = 0; + *curAlign = 1; + } + while ((fld != NIL && fld->mode == 4)) { + if ((OPM_currFile == 0 && fld->vis == 0) || (((OPM_currFile == 1 && fld->vis == 0)) && typ->mno != 0)) { + fld = fld->link; + while ((((fld != NIL && fld->mode == 4)) && fld->vis == 0)) { + fld = fld->link; + } + } else { + adr = *off; + fldAlign = OPC_Base(fld->typ); + OPC_Align(&adr, fldAlign); + gap = fld->adr - adr; + if (fldAlign > *curAlign) { + *curAlign = fldAlign; + } + if (gap > 0) { + OPC_FillGap(gap, *off, align, &*n, &*curAlign); + } + OPC_BegStat(); + OPC_DeclareBase(fld); + OPM_Write(' '); + OPC_DeclareObj(fld, 0); + *off = fld->adr + fld->typ->size; + base = fld->typ; + fld = fld->link; + while ((((((((fld != NIL && fld->mode == 4)) && fld->typ == base)) && fld->adr == *off)) && ((OPM_currFile == 1 || fld->vis != 0) || fld->typ->strobj == NIL))) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_DeclareObj(fld, 0); + *off = fld->adr + fld->typ->size; + fld = fld->link; + } + OPC_EndStat(); + } + } + if (last) { + adr = typ->size - (LONGINT)__ASHR(typ->sysflag, 8); + if (adr == 0) { + gap = 1; + } else { + gap = adr - *off; + } + if (gap > 0) { + OPC_FillGap(gap, *off, align, &*n, &*curAlign); + } + } +} + +static void OPC_IdentList (OPT_Object obj, INTEGER vis) +{ + OPT_Struct base = NIL; + BOOLEAN first; + INTEGER lastvis; + base = NIL; + first = 1; + while ((obj != NIL && obj->mode != 13)) { + if ((__IN(vis, 0x05) || (vis == 1 && obj->vis != 0)) || (vis == 3 && !obj->leaf)) { + if (obj->typ != base || (int)obj->vis != lastvis) { + if (!first) { + OPC_EndStat(); + } + first = 0; + base = obj->typ; + lastvis = obj->vis; + OPC_BegStat(); + if ((vis == 1 && obj->vis != 0)) { + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + } else if ((obj->mnolev == 0 && vis == 0)) { + if (obj->vis == 0) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + } + } + if ((((vis == 2 && obj->mode == 1)) && base->form == 7)) { + OPM_WriteString((CHAR*)"double", (LONGINT)7); + } else { + OPC_DeclareBase(obj); + } + } else { + OPM_Write(','); + } + OPM_Write(' '); + if ((((vis == 2 && obj->mode == 1)) && base->form == 7)) { + OPM_Write('_'); + } + OPC_DeclareObj(obj, vis == 3); + if (obj->typ->comp == 3) { + OPC_EndStat(); + OPC_BegStat(); + base = OPT_linttyp; + OPM_WriteString((CHAR*)"LONGINT ", (LONGINT)9); + OPC_LenList(obj, 0, 1); + } else if ((obj->mode == 2 && obj->typ->comp == 4)) { + OPC_EndStat(); + OPC_BegStat(); + OPM_WriteString((CHAR*)"LONGINT *", (LONGINT)10); + OPC_Ident(obj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + base = NIL; + } else if ((((((OPC_ptrinit && vis == 0)) && obj->mnolev > 0)) && obj->typ->form == 13)) { + OPM_WriteString((CHAR*)" = NIL", (LONGINT)7); + } + } + obj = obj->link; + } + if (!first) { + OPC_EndStat(); + } +} + +static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames) +{ + CHAR name[32]; + OPM_Write('('); + if (obj == NIL || obj->mode == 13) { + OPM_WriteString((CHAR*)"void", (LONGINT)5); + } else { + for (;;) { + OPC_DeclareBase(obj); + if (showParamNames) { + OPM_Write(' '); + OPC_DeclareObj(obj, 0); + } else { + __COPY(obj->name, name, ((LONGINT)(32))); + obj->name[0] = 0x00; + OPC_DeclareObj(obj, 0); + __COPY(name, obj->name, ((LONGINT)(256))); + } + if (obj->typ->comp == 3) { + OPM_WriteString((CHAR*)", LONGINT ", (LONGINT)11); + OPC_LenList(obj, 1, showParamNames); + } else if ((obj->mode == 2 && obj->typ->comp == 4)) { + OPM_WriteString((CHAR*)", LONGINT *", (LONGINT)12); + if (showParamNames) { + OPC_Ident(obj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } + } + if (obj->link == NIL || obj->link->mode == 13) { + break; + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + obj = obj->link; + } + } + OPM_Write(')'); +} + +static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define) +{ + if (proc->typ == OPT_notyp) { + OPM_WriteString((CHAR*)"void", (LONGINT)5); + } else { + OPC_Ident(proc->typ->strobj); + } + OPM_Write(' '); + OPC_Ident(proc); + OPM_Write(' '); + if (OPC_ansi) { + OPC_AnsiParamList(proc->link, 1); + if (!define) { + OPM_Write(';'); + } + OPM_WriteLn(); + } else if (define) { + OPC_DeclareParams(proc->link, 0); + OPM_WriteLn(); + OPC_Indent(1); + OPC_IdentList(proc->link, 2); + OPC_Indent(-1); + } else { + OPM_WriteString((CHAR*)"();", (LONGINT)4); + OPM_WriteLn(); + } +} + +static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis) +{ + if (obj != NIL) { + OPC_ProcPredefs(obj->left, vis); + if ((((__IN(obj->mode, 0xc0) && obj->vis >= vis)) && (obj->history != 4 || obj->mode == 6))) { + if (vis == 1) { + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + } else if (obj->vis == 0) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + } + OPC_ProcHeader(obj, 0); + } + OPC_ProcPredefs(obj->right, vis); + } +} + +static void OPC_Include (CHAR *name, LONGINT name__len) +{ + __DUP(name, name__len, CHAR); + OPM_WriteString((CHAR*)"#include ", (LONGINT)10); + OPM_Write('\"'); + OPM_WriteStringVar((void*)name, name__len); + OPM_WriteString((CHAR*)".h", (LONGINT)3); + OPM_Write('\"'); + OPM_WriteLn(); + __DEL(name); +} + +static void OPC_IncludeImports (OPT_Object obj, INTEGER vis) +{ + if (obj != NIL) { + OPC_IncludeImports(obj->left, vis); + if ((((obj->mode == 11 && obj->mnolev != 0)) && (int)OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->vis >= vis)) { + OPC_Include(OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + } + OPC_IncludeImports(obj->right, vis); + } +} + +static void OPC_GenDynTypes (OPT_Node n, INTEGER vis) +{ + OPT_Struct typ = NIL; + while ((n != NIL && n->class == 14)) { + typ = n->typ; + if (vis == 0 || typ->ref < 255) { + OPC_BegStat(); + if (vis == 1) { + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + } else if ((typ->strobj != NIL && typ->strobj->mnolev > 0)) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + } + OPM_WriteString((CHAR*)"LONGINT *", (LONGINT)10); + OPC_Andent(typ); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPC_EndStat(); + } + n = n->link; + } +} + +void OPC_GenHdr (OPT_Node n) +{ + OPM_currFile = 0; + OPC_DefAnonRecs(n); + OPC_TypeDefs(OPT_topScope->right, 1); + OPM_WriteLn(); + OPC_IdentList(OPT_topScope->scope, 1); + OPM_WriteLn(); + OPC_GenDynTypes(n, 1); + OPM_WriteLn(); + OPC_ProcPredefs(OPT_topScope->right, 1); + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + OPM_WriteString((CHAR*)"void *", (LONGINT)7); + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + OPM_WriteString(OPC_BodyNameExt, ((LONGINT)(13))); + OPC_EndStat(); + OPM_WriteLn(); + OPC_CProcDefs(OPT_topScope->right, 1); + OPM_WriteLn(); + OPM_WriteString((CHAR*)"#endif", (LONGINT)7); + OPM_WriteLn(); +} + +static void OPC_GenHeaderMsg (void) +{ + INTEGER i; + OPM_WriteString((CHAR*)"/*", (LONGINT)3); + OPM_WriteString((CHAR*)" voc ", (LONGINT)6); + OPM_Write(' '); + OPM_WriteString((CHAR*)"1.2 [2016/06/15] for gcc LP64 on cygwin", (LONGINT)40); + OPM_Write(' '); + i = 0; + while (i <= 31) { + if (__IN(i, OPM_glbopt)) { + switch (i) { + case 0: + OPM_Write('x'); + break; + case 2: + OPM_Write('r'); + break; + case 3: + OPM_Write('t'); + break; + case 4: + OPM_Write('s'); + break; + case 5: + OPM_Write('p'); + break; + case 6: + OPM_Write('k'); + break; + case 7: + OPM_Write('a'); + break; + case 9: + OPM_Write('e'); + break; + case 10: + OPM_Write('m'); + break; + case 13: + OPM_Write('S'); + break; + case 14: + OPM_Write('c'); + break; + case 15: + OPM_Write('M'); + break; + case 16: + OPM_Write('f'); + break; + case 17: + OPM_Write('F'); + break; + case 18: + OPM_Write('v'); + break; + default: + OPM_LogWStr((CHAR*)"( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg", (LONGINT)126); + OPM_LogWLn(); + break; + } + } + i += 1; + } + OPM_WriteString((CHAR*)" */", (LONGINT)4); + OPM_WriteLn(); +} + +void OPC_GenHdrIncludes (void) +{ + OPM_currFile = 2; + OPC_GenHeaderMsg(); + OPM_WriteLn(); + OPM_WriteString((CHAR*)"#ifndef ", (LONGINT)9); + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + OPM_WriteString((CHAR*)"__h", (LONGINT)4); + OPM_WriteLn(); + OPM_WriteString((CHAR*)"#define ", (LONGINT)9); + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + OPM_WriteString((CHAR*)"__h", (LONGINT)4); + OPM_WriteLn(); + OPM_WriteLn(); + if (OPM_LIntSize == 8) { + OPM_WriteString((CHAR*)"#define LARGE", (LONGINT)14); + OPM_WriteLn(); + } + OPC_Include((CHAR*)"SYSTEM", (LONGINT)7); + OPC_IncludeImports(OPT_topScope->right, 1); + OPM_WriteLn(); +} + +void OPC_GenBdy (OPT_Node n) +{ + OPM_currFile = 1; + OPC_GenHeaderMsg(); + if (OPM_LIntSize == 8) { + OPM_WriteString((CHAR*)"#define LARGE", (LONGINT)14); + OPM_WriteLn(); + } + OPC_Include((CHAR*)"SYSTEM", (LONGINT)7); + OPC_IncludeImports(OPT_topScope->right, 0); + OPM_WriteLn(); + OPC_DefAnonRecs(n); + OPC_TypeDefs(OPT_topScope->right, 0); + OPM_WriteLn(); + OPC_IdentList(OPT_topScope->scope, 0); + OPM_WriteLn(); + OPC_GenDynTypes(n, 0); + OPM_WriteLn(); + OPC_ProcPredefs(OPT_topScope->right, 0); + OPM_WriteLn(); + OPC_CProcDefs(OPT_topScope->right, 0); + OPM_WriteLn(); +} + +static void OPC_RegCmds (OPT_Object obj) +{ + if (obj != NIL) { + OPC_RegCmds(obj->left); + if ((obj->mode == 7 && obj->history != 4)) { + if ((((obj->vis != 0 && obj->link == NIL)) && obj->typ == OPT_notyp)) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"__REGCMD(\"", (LONGINT)11); + OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"\", ", (LONGINT)4); + OPC_Ident(obj); + OPM_Write(')'); + OPC_EndStat(); + } + } + OPC_RegCmds(obj->right); + } +} + +static void OPC_InitImports (OPT_Object obj) +{ + if (obj != NIL) { + OPC_InitImports(obj->left); + if ((obj->mode == 11 && obj->mnolev != 0)) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"__MODULE_IMPORT(", (LONGINT)17); + OPM_WriteStringVar((void*)OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + OPM_Write(')'); + OPC_EndStat(); + } + OPC_InitImports(obj->right); + } +} + +void OPC_GenEnumPtrs (OPT_Object var) +{ + OPT_Struct typ = NIL; + LONGINT n; + OPC_GlbPtrs = 0; + while (var != NIL) { + typ = var->typ; + if (OPC_NofPtrs(typ) > 0) { + if (!OPC_GlbPtrs) { + OPC_GlbPtrs = 1; + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + if (OPC_ansi) { + OPM_WriteString((CHAR*)"void EnumPtrs(void (*P)(void*))", (LONGINT)32); + } else { + OPM_WriteString((CHAR*)"void EnumPtrs(P)", (LONGINT)17); + OPM_WriteLn(); + OPM_Write(0x09); + OPM_WriteString((CHAR*)"void (*P)();", (LONGINT)13); + } + OPM_WriteLn(); + OPC_BegBlk(); + } + OPC_BegStat(); + if (typ->form == 13) { + OPM_WriteString((CHAR*)"P(", (LONGINT)3); + OPC_Ident(var); + OPM_Write(')'); + } else if (typ->comp == 4) { + OPM_WriteString((CHAR*)"__ENUMR(&", (LONGINT)10); + OPC_Ident(var); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(typ); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPC_Str1((CHAR*)", #", (LONGINT)4, typ->size); + OPM_WriteString((CHAR*)", 1, P)", (LONGINT)8); + } else if (typ->comp == 2) { + n = typ->n; + typ = typ->BaseTyp; + while (typ->comp == 2) { + n = n * typ->n; + typ = typ->BaseTyp; + } + if (typ->form == 13) { + OPM_WriteString((CHAR*)"__ENUMP(", (LONGINT)9); + OPC_Ident(var); + OPC_Str1((CHAR*)", #, P)", (LONGINT)8, n); + } else if (typ->comp == 4) { + OPM_WriteString((CHAR*)"__ENUMR(", (LONGINT)9); + OPC_Ident(var); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(typ); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPC_Str1((CHAR*)", #", (LONGINT)4, typ->size); + OPC_Str1((CHAR*)", #, P)", (LONGINT)8, n); + } + } + OPC_EndStat(); + } + var = var->link; + } + if (OPC_GlbPtrs) { + OPC_EndBlk(); + OPM_WriteLn(); + } +} + +void OPC_EnterBody (void) +{ + OPM_WriteLn(); + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + if (OPC_mainprog) { + if (OPC_ansi) { + OPM_WriteString((CHAR*)"int main(int argc, char **argv)", (LONGINT)32); + OPM_WriteLn(); + } else { + OPM_WriteString((CHAR*)"main(argc, argv)", (LONGINT)17); + OPM_WriteLn(); + OPM_Write(0x09); + OPM_WriteString((CHAR*)"int argc; char **argv;", (LONGINT)23); + OPM_WriteLn(); + } + } else { + OPM_WriteString((CHAR*)"void *", (LONGINT)7); + OPM_WriteString(OPM_modName, ((LONGINT)(32))); + OPM_WriteString(OPC_BodyNameExt, ((LONGINT)(13))); + OPM_WriteLn(); + } + OPC_BegBlk(); + OPC_BegStat(); + if (OPC_mainprog) { + OPM_WriteString((CHAR*)"__INIT(argc, argv)", (LONGINT)19); + } else { + OPM_WriteString((CHAR*)"__DEFMOD", (LONGINT)9); + } + OPC_EndStat(); + if ((OPC_mainprog && 0)) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"/*don`t do it!*/ printf(\"DEMO VERSION: DO NOT USE THIS PROGRAM FOR ANY COMMERCIAL PURPOSE\\n\")", (LONGINT)94); + OPC_EndStat(); + } + OPC_InitImports(OPT_topScope->right); + OPC_BegStat(); + if (OPC_mainprog) { + OPM_WriteString((CHAR*)"__REGMAIN(\"", (LONGINT)12); + } else { + OPM_WriteString((CHAR*)"__REGMOD(\"", (LONGINT)11); + } + OPM_WriteString(OPM_modName, ((LONGINT)(32))); + if (OPC_GlbPtrs) { + OPM_WriteString((CHAR*)"\", EnumPtrs)", (LONGINT)13); + } else { + OPM_WriteString((CHAR*)"\", 0)", (LONGINT)6); + } + OPC_EndStat(); + if (__STRCMP(OPM_modName, "SYSTEM") != 0) { + OPC_RegCmds(OPT_topScope); + } +} + +void OPC_ExitBody (void) +{ + OPC_BegStat(); + if (OPC_mainprog) { + OPM_WriteString((CHAR*)"__FINI;", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ENDMOD;", (LONGINT)10); + } + OPM_WriteLn(); + OPC_EndBlk(); +} + +void OPC_DefineInter (OPT_Object proc) +{ + OPT_Object scope = NIL; + scope = proc->scope; + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_Write(' '); + OPC_BegBlk(); + OPC_IdentList(proc->link, 3); + OPC_IdentList(scope->scope, 3); + OPC_BegStat(); + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_Write(' '); + OPM_Write('*'); + OPM_WriteString((CHAR*)"lnk", (LONGINT)4); + OPC_EndStat(); + OPC_EndBlk0(); + OPM_Write(' '); + OPM_Write('*'); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPC_EndStat(); + OPM_WriteLn(); + OPC_ProcPredefs(scope->right, 0); + OPM_WriteLn(); +} + +void OPC_EnterProc (OPT_Object proc) +{ + OPT_Object var = NIL, scope = NIL; + OPT_Struct typ = NIL; + INTEGER dim; + if (proc->vis != 1) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } + OPC_ProcHeader(proc, 1); + OPC_BegBlk(); + if (proc->typ != OPT_notyp) { + OPC_BegStat(); + OPC_Ident(proc->typ->strobj); + OPM_WriteString((CHAR*)" _o_result;", (LONGINT)12); + OPM_WriteLn(); + } + scope = proc->scope; + OPC_IdentList(scope->scope, 0); + if (!scope->leaf) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_Write(' '); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPC_EndStat(); + } + var = proc->link; + while (var != NIL) { + if ((var->typ->comp == 2 && var->mode == 1)) { + OPC_BegStat(); + if (var->typ->strobj == NIL) { + OPM_Mark(200, var->typ->txtpos); + } else { + OPC_Ident(var->typ->strobj); + } + OPM_Write(' '); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__copy", (LONGINT)7); + OPC_EndStat(); + } + var = var->link; + } + if (!OPC_ansi) { + var = proc->link; + while (var != NIL) { + if ((var->typ->form == 7 && var->mode == 1)) { + OPC_BegStat(); + OPC_Ident(var->typ->strobj); + OPM_Write(' '); + OPC_Ident(var); + OPM_WriteString((CHAR*)" = _", (LONGINT)5); + OPC_Ident(var); + OPC_EndStat(); + } + var = var->link; + } + } + var = proc->link; + while (var != NIL) { + if ((((__IN(var->typ->comp, 0x0c) && var->mode == 1)) && var->typ->sysflag == 0)) { + OPC_BegStat(); + if (var->typ->comp == 2) { + OPM_WriteString((CHAR*)"__DUPARR(", (LONGINT)10); + OPC_Ident(var); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (var->typ->strobj == NIL) { + OPM_Mark(200, var->typ->txtpos); + } else { + OPC_Ident(var->typ->strobj); + } + } else { + OPM_WriteString((CHAR*)"__DUP(", (LONGINT)7); + OPC_Ident(var); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + typ = var->typ->BaseTyp; + dim = 1; + while (typ->comp == 3) { + OPM_WriteString((CHAR*)" * ", (LONGINT)4); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + OPM_WriteInt(dim); + typ = typ->BaseTyp; + dim += 1; + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (typ->strobj == NIL) { + OPM_Mark(200, typ->txtpos); + } else { + OPC_Ident(typ->strobj); + } + } + OPM_Write(')'); + OPC_EndStat(); + } + var = var->link; + } + if (!scope->leaf) { + var = proc->link; + while (var != NIL) { + if (!var->leaf) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPC_Ident(var); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + if (__IN(var->typ->comp, 0x0c)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } else if (var->mode != 2) { + OPM_Write('&'); + } + OPC_Ident(var); + if (var->typ->comp == 3) { + typ = var->typ; + dim = 0; + do { + OPM_WriteString((CHAR*)"; ", (LONGINT)3); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + if (dim != 0) { + OPM_WriteInt(dim); + } + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + if (dim != 0) { + OPM_WriteInt(dim); + } + typ = typ->BaseTyp; + } while (!(typ->comp != 3)); + } else if ((var->mode == 2 && var->typ->comp == 4)) { + OPM_WriteString((CHAR*)"; ", (LONGINT)3); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } + OPC_EndStat(); + } + var = var->link; + } + var = scope->scope; + while (var != NIL) { + if (!var->leaf) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPC_Ident(var); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + if (var->typ->comp != 2) { + OPM_Write('&'); + } else { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } + OPC_Ident(var); + OPC_EndStat(); + } + var = var->link; + } + OPC_BegStat(); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPM_WriteString((CHAR*)"lnk", (LONGINT)4); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPC_EndStat(); + OPC_BegStat(); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPM_Write('&'); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPC_EndStat(); + } +} + +void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet) +{ + OPT_Object var = NIL; + BOOLEAN indent; + indent = eoBlock; + if ((implicitRet && proc->typ != OPT_notyp)) { + OPM_Write(0x09); + OPM_WriteString((CHAR*)"__RETCHK;", (LONGINT)10); + OPM_WriteLn(); + } else if (!eoBlock || implicitRet) { + if (!proc->scope->leaf) { + if (indent) { + OPC_BegStat(); + } else { + indent = 1; + } + OPM_WriteStringVar((void*)proc->scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPM_WriteString((CHAR*)"lnk", (LONGINT)4); + OPC_EndStat(); + } + var = proc->link; + while (var != NIL) { + if ((((var->typ->comp == 3 && var->mode == 1)) && var->typ->sysflag == 0)) { + if (indent) { + OPC_BegStat(); + } else { + indent = 1; + } + OPM_WriteString((CHAR*)"__DEL(", (LONGINT)7); + OPC_Ident(var); + OPM_Write(')'); + OPC_EndStat(); + } + var = var->link; + } + } + if (eoBlock) { + OPC_EndBlk(); + OPM_WriteLn(); + } else if (indent) { + OPC_BegStat(); + } +} + +void OPC_CompleteIdent (OPT_Object obj) +{ + INTEGER comp, level; + level = obj->mnolev; + if (obj->adr == 1) { + if (obj->typ->comp == 4) { + OPC_Ident(obj); + OPM_WriteString((CHAR*)"__", (LONGINT)3); + } else { + OPM_WriteString((CHAR*)"((", (LONGINT)3); + OPC_Ident(obj->typ->strobj); + OPM_Write(')'); + OPC_Ident(obj); + OPM_Write(')'); + } + } else if ((level != OPM_level && level > 0)) { + comp = obj->typ->comp; + if ((obj->mode != 2 && comp != 3)) { + OPM_Write('*'); + } + OPM_WriteStringVar((void*)obj->scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_WriteString((CHAR*)"->", (LONGINT)3); + OPC_Ident(obj); + } else { + OPC_Ident(obj); + } +} + +void OPC_TypeOf (OPT_Object ap) +{ + INTEGER i; + __ASSERT(ap->typ->comp == 4, 0); + if (ap->mode == 2) { + if ((int)ap->mnolev != OPM_level) { + OPM_WriteStringVar((void*)ap->scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s->", (LONGINT)5); + OPC_Ident(ap); + } else { + OPC_Ident(ap); + } + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } else if (ap->typ->strobj != NIL) { + OPC_Ident(ap->typ->strobj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } else { + OPC_Andent(ap->typ); + } +} + +void OPC_Cmp (INTEGER rel) +{ + switch (rel) { + case 9: + OPM_WriteString((CHAR*)" == ", (LONGINT)5); + break; + case 10: + OPM_WriteString((CHAR*)" != ", (LONGINT)5); + break; + case 11: + OPM_WriteString((CHAR*)" < ", (LONGINT)4); + break; + case 12: + OPM_WriteString((CHAR*)" <= ", (LONGINT)5); + break; + case 13: + OPM_WriteString((CHAR*)" > ", (LONGINT)4); + break; + case 14: + OPM_WriteString((CHAR*)" >= ", (LONGINT)5); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPC.Cmp, rel = ", (LONGINT)34); + OPM_LogWNum(rel, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } +} + +void OPC_Case (LONGINT caseVal, INTEGER form) +{ + CHAR ch; + OPM_WriteString((CHAR*)"case ", (LONGINT)6); + switch (form) { + case 3: + ch = (CHAR)caseVal; + if ((ch >= ' ' && ch <= '~')) { + OPM_Write('\''); + if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') { + OPM_Write('\\'); + OPM_Write(ch); + } else { + OPM_Write(ch); + } + OPM_Write('\''); + } else { + OPM_WriteString((CHAR*)"0x", (LONGINT)3); + OPM_WriteHex(caseVal); + } + break; + case 4: case 5: case 6: + OPM_WriteInt(caseVal); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPC.Case, form = ", (LONGINT)36); + OPM_LogWNum(form, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + OPM_WriteString((CHAR*)": ", (LONGINT)3); +} + +void OPC_SetInclude (BOOLEAN exclude) +{ + if (exclude) { + OPM_WriteString((CHAR*)" &= ~", (LONGINT)6); + } else { + OPM_WriteString((CHAR*)" |= ", (LONGINT)5); + } +} + +void OPC_Increment (BOOLEAN decrement) +{ + if (decrement) { + OPM_WriteString((CHAR*)" -= ", (LONGINT)5); + } else { + OPM_WriteString((CHAR*)" += ", (LONGINT)5); + } +} + +void OPC_Halt (LONGINT n) +{ + OPC_Str1((CHAR*)"__HALT(#)", (LONGINT)10, n); +} + +void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim) +{ + if (array->comp == 3) { + OPC_CompleteIdent(obj); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + if (dim != 0) { + OPM_WriteInt(dim); + } + } else { + while (dim > 0) { + array = array->BaseTyp; + dim -= 1; + } + OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12); + OPM_WriteInt(array->n); + OPM_WriteString((CHAR*)"))", (LONGINT)3); + } +} + +void OPC_Constant (OPT_Const con, INTEGER form) +{ + INTEGER i, len; + CHAR ch; + SET s; + LONGINT hex; + BOOLEAN skipLeading; + switch (form) { + case 1: + OPM_WriteInt(con->intval); + break; + case 2: + OPM_WriteInt(con->intval); + break; + case 3: + ch = (CHAR)con->intval; + if ((ch >= ' ' && ch <= '~')) { + OPM_Write('\''); + if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') { + OPM_Write('\\'); + } + OPM_Write(ch); + OPM_Write('\''); + } else { + OPM_WriteString((CHAR*)"0x", (LONGINT)3); + OPM_WriteHex(con->intval); + } + break; + case 4: case 5: case 6: + OPM_WriteInt(con->intval); + break; + case 7: + OPM_WriteReal(con->realval, 'f'); + break; + case 8: + OPM_WriteReal(con->realval, 0x00); + break; + case 9: + OPM_WriteString((CHAR*)"0x", (LONGINT)3); + skipLeading = 1; + s = con->setval; + i = 32; + do { + hex = 0; + do { + i -= 1; + hex = __ASHL(hex, 1); + if (__IN(i, s)) { + hex += 1; + } + } while (!(__MASK(i, -8) == 0)); + if (hex != 0 || !skipLeading) { + OPM_WriteHex(hex); + skipLeading = 0; + } + } while (!(i == 0)); + if (skipLeading) { + OPM_Write('0'); + } + break; + case 10: + OPM_Write('\"'); + len = (int)con->intval2 - 1; + i = 0; + while (i < len) { + ch = (*con->ext)[__X(i, ((LONGINT)(256)))]; + if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') { + OPM_Write('\\'); + } + OPM_Write(ch); + i += 1; + } + OPM_Write('\"'); + break; + case 11: + OPM_WriteString((CHAR*)"NIL", (LONGINT)4); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPC.Constant, form = ", (LONGINT)40); + OPM_LogWNum(form, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } +} + +static struct InitKeywords__47 { + SHORTINT *n; + struct InitKeywords__47 *lnk; +} *InitKeywords__47_s; + +static void Enter__48 (CHAR *s, LONGINT s__len); + +static void Enter__48 (CHAR *s, LONGINT s__len) +{ + INTEGER h; + __DUP(s, s__len, CHAR); + h = OPC_PerfectHash((void*)s, s__len); + OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__47_s->n; + __COPY(s, OPC_keytab[__X(*InitKeywords__47_s->n, ((LONGINT)(36)))], ((LONGINT)(9))); + *InitKeywords__47_s->n += 1; + __DEL(s); +} + +static void OPC_InitKeywords (void) +{ + SHORTINT n, i; + struct InitKeywords__47 _s; + _s.n = &n; + _s.lnk = InitKeywords__47_s; + InitKeywords__47_s = &_s; + n = 0; + i = 0; + while (i <= 104) { + OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1; + i += 1; + } + Enter__48((CHAR*)"asm", (LONGINT)4); + Enter__48((CHAR*)"auto", (LONGINT)5); + Enter__48((CHAR*)"break", (LONGINT)6); + Enter__48((CHAR*)"case", (LONGINT)5); + Enter__48((CHAR*)"char", (LONGINT)5); + Enter__48((CHAR*)"const", (LONGINT)6); + Enter__48((CHAR*)"continue", (LONGINT)9); + Enter__48((CHAR*)"default", (LONGINT)8); + Enter__48((CHAR*)"do", (LONGINT)3); + Enter__48((CHAR*)"double", (LONGINT)7); + Enter__48((CHAR*)"else", (LONGINT)5); + Enter__48((CHAR*)"enum", (LONGINT)5); + Enter__48((CHAR*)"extern", (LONGINT)7); + Enter__48((CHAR*)"export", (LONGINT)7); + Enter__48((CHAR*)"float", (LONGINT)6); + Enter__48((CHAR*)"for", (LONGINT)4); + Enter__48((CHAR*)"fortran", (LONGINT)8); + Enter__48((CHAR*)"goto", (LONGINT)5); + Enter__48((CHAR*)"if", (LONGINT)3); + Enter__48((CHAR*)"import", (LONGINT)7); + Enter__48((CHAR*)"int", (LONGINT)4); + Enter__48((CHAR*)"long", (LONGINT)5); + Enter__48((CHAR*)"register", (LONGINT)9); + Enter__48((CHAR*)"return", (LONGINT)7); + Enter__48((CHAR*)"short", (LONGINT)6); + Enter__48((CHAR*)"signed", (LONGINT)7); + Enter__48((CHAR*)"sizeof", (LONGINT)7); + Enter__48((CHAR*)"static", (LONGINT)7); + Enter__48((CHAR*)"struct", (LONGINT)7); + Enter__48((CHAR*)"switch", (LONGINT)7); + Enter__48((CHAR*)"typedef", (LONGINT)8); + Enter__48((CHAR*)"union", (LONGINT)6); + Enter__48((CHAR*)"unsigned", (LONGINT)9); + Enter__48((CHAR*)"void", (LONGINT)5); + Enter__48((CHAR*)"volatile", (LONGINT)9); + Enter__48((CHAR*)"while", (LONGINT)6); + InitKeywords__47_s = _s.lnk; +} + + +export void *OPC__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPT); + __REGMOD("OPC", 0); + __REGCMD("BegBlk", OPC_BegBlk); + __REGCMD("BegStat", OPC_BegStat); + __REGCMD("EndBlk", OPC_EndBlk); + __REGCMD("EndBlk0", OPC_EndBlk0); + __REGCMD("EndStat", OPC_EndStat); + __REGCMD("EnterBody", OPC_EnterBody); + __REGCMD("ExitBody", OPC_ExitBody); + __REGCMD("GenHdrIncludes", OPC_GenHdrIncludes); + __REGCMD("Init", OPC_Init); +/* BEGIN */ + OPC_InitKeywords(); + __ENDMOD; +} diff --git a/bootstrap/unix-48/OPC.h b/bootstrap/unix-48/OPC.h new file mode 100644 index 00000000..713ea3b2 --- /dev/null +++ b/bootstrap/unix-48/OPC.h @@ -0,0 +1,49 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPC__h +#define OPC__h + +#include "SYSTEM.h" +#include "OPT.h" + + + + +import void OPC_Align (LONGINT *adr, LONGINT base); +import void OPC_Andent (OPT_Struct typ); +import LONGINT OPC_Base (OPT_Struct typ); +import OPT_Object OPC_BaseTProc (OPT_Object obj); +import void OPC_BegBlk (void); +import void OPC_BegStat (void); +import void OPC_Case (LONGINT caseVal, INTEGER form); +import void OPC_Cmp (INTEGER rel); +import void OPC_CompleteIdent (OPT_Object obj); +import void OPC_Constant (OPT_Const con, INTEGER form); +import void OPC_DefineInter (OPT_Object proc); +import void OPC_EndBlk (void); +import void OPC_EndBlk0 (void); +import void OPC_EndStat (void); +import void OPC_EnterBody (void); +import void OPC_EnterProc (OPT_Object proc); +import void OPC_ExitBody (void); +import void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet); +import void OPC_GenBdy (OPT_Node n); +import void OPC_GenEnumPtrs (OPT_Object var); +import void OPC_GenHdr (OPT_Node n); +import void OPC_GenHdrIncludes (void); +import void OPC_Halt (LONGINT n); +import void OPC_Ident (OPT_Object obj); +import void OPC_Increment (BOOLEAN decrement); +import void OPC_Indent (INTEGER count); +import void OPC_Init (void); +import void OPC_InitTDesc (OPT_Struct typ); +import void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim); +import LONGINT OPC_NofPtrs (OPT_Struct typ); +import void OPC_SetInclude (BOOLEAN exclude); +import void OPC_TDescDecl (OPT_Struct typ); +import void OPC_TypeDefs (OPT_Object obj, INTEGER vis); +import void OPC_TypeOf (OPT_Object ap); +import void *OPC__init(void); + + +#endif diff --git a/bootstrap/unix-48/OPM.c b/bootstrap/unix-48/OPM.c new file mode 100644 index 00000000..3d68d2be --- /dev/null +++ b/bootstrap/unix-48/OPM.c @@ -0,0 +1,1091 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "Configuration.h" +#include "Console.h" +#include "Files.h" +#include "Platform.h" +#include "Strings.h" +#include "Texts.h" +#include "errors.h" +#include "vt100.h" + +typedef + CHAR OPM_FileName[32]; + + +static CHAR OPM_SourceFileName[256]; +export INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_CharAlign, OPM_BoolAlign, OPM_SIntAlign, OPM_IntAlign, OPM_LIntAlign, OPM_SetAlign, OPM_RealAlign, OPM_LRealAlign, OPM_PointerAlign, OPM_ProcAlign, OPM_RecAlign, OPM_MaxSet; +export LONGINT OPM_MinSInt, OPM_MinInt, OPM_MinLInt, OPM_MaxSInt, OPM_MaxInt, OPM_MaxLInt, OPM_MaxIndex; +export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; +export BOOLEAN OPM_noerr; +export LONGINT OPM_curpos, OPM_errpos, OPM_breakpc; +export INTEGER OPM_currFile, OPM_level, OPM_pc, OPM_entno; +export CHAR OPM_modName[32]; +export CHAR OPM_objname[64]; +export SET OPM_opt, OPM_glbopt; +static LONGINT OPM_ErrorLineStartPos, OPM_ErrorLineLimitPos, OPM_ErrorLineNumber, OPM_lasterrpos; +static Texts_Reader OPM_inR; +static Texts_Text OPM_Log; +static Texts_Writer OPM_W; +static Files_Rider OPM_oldSF, OPM_newSF; +static Files_Rider OPM_R[3]; +static Files_File OPM_oldSFile, OPM_newSFile, OPM_HFile, OPM_BFile, OPM_HIFile; +static INTEGER OPM_S; +export BOOLEAN OPM_dontAsm, OPM_dontLink, OPM_mainProg, OPM_mainLinkStat, OPM_notColorOutput, OPM_forceNewSym, OPM_Verbose; +static CHAR OPM_OBERON[1024]; +static CHAR OPM_MODULES[1024]; + + +static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F); +export void OPM_CloseFiles (void); +export void OPM_CloseOldSym (void); +export void OPM_DeleteNewSym (void); +export void OPM_FPrint (LONGINT *fp, LONGINT val); +export void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr); +export void OPM_FPrintReal (LONGINT *fp, REAL real); +export void OPM_FPrintSet (LONGINT *fp, SET set); +static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT pos); +export void OPM_Get (CHAR *ch); +static void OPM_GetProperties (void); +static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align); +export void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len); +export void OPM_InitOptions (void); +static void OPM_LogErrMsg (INTEGER n); +export void OPM_LogW (CHAR ch); +export void OPM_LogWLn (void); +export void OPM_LogWNum (LONGINT i, LONGINT len); +export void OPM_LogWStr (CHAR *s, LONGINT s__len); +static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len); +export void OPM_Mark (INTEGER n, LONGINT pos); +static INTEGER OPM_Min (INTEGER a, INTEGER b); +export void OPM_NewSym (CHAR *modName, LONGINT modName__len); +export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done); +export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len); +export BOOLEAN OPM_OpenPar (void); +export void OPM_RegisterNewSym (void); +static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt); +static void OPM_ShowLine (LONGINT pos); +export void OPM_SymRCh (CHAR *ch); +export LONGINT OPM_SymRInt (void); +export void OPM_SymRLReal (LONGREAL *lr); +export void OPM_SymRReal (REAL *r); +export void OPM_SymRSet (SET *s); +export void OPM_SymWCh (CHAR ch); +export void OPM_SymWInt (LONGINT i); +export void OPM_SymWLReal (LONGREAL lr); +export void OPM_SymWReal (REAL r); +export void OPM_SymWSet (SET s); +static void OPM_VerboseListSizes (void); +export void OPM_Write (CHAR ch); +export void OPM_WriteHex (LONGINT i); +export void OPM_WriteInt (LONGINT i); +export void OPM_WriteLn (void); +export void OPM_WriteReal (LONGREAL r, CHAR suffx); +export void OPM_WriteString (CHAR *s, LONGINT s__len); +export void OPM_WriteStringVar (CHAR *s, LONGINT s__len); +export BOOLEAN OPM_eofSF (void); +export void OPM_err (INTEGER n); +static LONGINT OPM_minus (LONGINT i); +static LONGINT OPM_power0 (LONGINT i, LONGINT j); + + +void OPM_LogW (CHAR ch) +{ + Console_Char(ch); +} + +void OPM_LogWStr (CHAR *s, LONGINT s__len) +{ + __DUP(s, s__len, CHAR); + Console_String(s, s__len); + __DEL(s); +} + +void OPM_LogWNum (LONGINT i, LONGINT len) +{ + Console_Int(i, len); +} + +void OPM_LogWLn (void) +{ + Console_Ln(); +} + +static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt) +{ + INTEGER i; + i = 1; + while (s[__X(i, s__len)] != 0x00) { + switch (s[__X(i, s__len)]) { + case 'e': + *opt = *opt ^ 0x0200; + break; + case 's': + *opt = *opt ^ 0x10; + break; + case 'm': + *opt = *opt ^ 0x0400; + break; + case 'x': + *opt = *opt ^ 0x01; + break; + case 'r': + *opt = *opt ^ 0x04; + break; + case 't': + *opt = *opt ^ 0x08; + break; + case 'a': + *opt = *opt ^ 0x80; + break; + case 'k': + *opt = *opt ^ 0x40; + break; + case 'p': + *opt = *opt ^ 0x20; + break; + case 'S': + *opt = *opt ^ 0x2000; + break; + case 'c': + *opt = *opt ^ 0x4000; + break; + case 'M': + *opt = *opt ^ 0x8000; + break; + case 'f': + *opt = *opt ^ 0x010000; + break; + case 'F': + *opt = *opt ^ 0x020000; + break; + case 'V': + *opt = *opt ^ 0x040000; + break; + case 'B': + if (s[__X(i + 1, s__len)] != 0x00) { + i += 1; + OPM_IntSize = (int)s[__X(i, s__len)] - 48; + } + if (s[__X(i + 1, s__len)] != 0x00) { + i += 1; + OPM_PointerSize = (int)s[__X(i, s__len)] - 48; + } + if (s[__X(i + 1, s__len)] != 0x00) { + i += 1; + OPM_Alignment = (int)s[__X(i, s__len)] - 48; + } + __ASSERT(OPM_IntSize == 2 || OPM_IntSize == 4, 0); + __ASSERT(OPM_PointerSize == 4 || OPM_PointerSize == 8, 0); + __ASSERT(OPM_Alignment == 4 || OPM_Alignment == 8, 0); + break; + default: + OPM_LogWStr((CHAR*)" warning: option ", (LONGINT)19); + OPM_LogW('-'); + OPM_LogW(s[__X(i, s__len)]); + OPM_LogWStr((CHAR*)" ignored", (LONGINT)9); + OPM_LogWLn(); + break; + } + i += 1; + } +} + +BOOLEAN OPM_OpenPar (void) +{ + BOOLEAN _o_result; + CHAR s[256]; + if (Platform_ArgCount == 1) { + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Vishap Oberon-2 compiler v", (LONGINT)27); + OPM_LogWStr((CHAR*)"1.2 [2016/06/15] for gcc LP64 on cygwin", (LONGINT)40); + OPM_LogW('.'); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Based on Ofront by Software Templ OEG, continued by Norayr Chilingarian and others.", (LONGINT)84); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Usage:", (LONGINT)7); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + OPM_LogWStr((CHAR*)"voc", (LONGINT)4); + OPM_LogWStr((CHAR*)" options {files {options}}.", (LONGINT)28); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Where options = [\"-\" {option} ].", (LONGINT)33); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" m - generate code for main module", (LONGINT)36); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" M - generate code for main module and link object statically", (LONGINT)63); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" s - generate new symbol file", (LONGINT)31); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" e - allow extending the module interface", (LONGINT)43); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" r - check value ranges", (LONGINT)25); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" a - don\'t check ASSERTs at runtime, use this option in tested production code", (LONGINT)80); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" t - don\'t check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" S - don\'t call external assembler/compiler, only generate C code", (LONGINT)67); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" c - don\'t call linker", (LONGINT)24); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" f - don\'t use color output", (LONGINT)29); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" V - verbose output", (LONGINT)21); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Initial options specify defaults for all files.", (LONGINT)48); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Options following a filename are specific to that file.", (LONGINT)56); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Repeating an option toggles its value.", (LONGINT)39); + OPM_LogWLn(); + _o_result = 0; + return _o_result; + } else { + OPM_S = 1; + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + OPM_glbopt = 0xe9; + while (s[0] == '-') { + OPM_ScanOptions((void*)s, ((LONGINT)(256)), &OPM_glbopt); + OPM_S += 1; + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + } + _o_result = 1; + return _o_result; + } + __RETCHK; +} + +void OPM_InitOptions (void) +{ + CHAR s[256]; + OPM_opt = OPM_glbopt; + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + while (s[0] == '-') { + OPM_ScanOptions((void*)s, ((LONGINT)(256)), &OPM_opt); + OPM_S += 1; + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + } + OPM_dontAsm = __IN(13, OPM_opt); + OPM_dontLink = __IN(14, OPM_opt); + OPM_mainProg = __IN(10, OPM_opt); + OPM_mainLinkStat = __IN(15, OPM_opt); + OPM_notColorOutput = __IN(16, OPM_opt); + OPM_forceNewSym = __IN(17, OPM_opt); + OPM_Verbose = __IN(18, OPM_opt); + if (OPM_mainLinkStat) { + OPM_glbopt |= __SETOF(10); + } + OPM_GetProperties(); +} + +void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len) +{ + Texts_Text T = NIL; + LONGINT beg, end, time; + CHAR s[256]; + *done = 0; + OPM_curpos = 0; + if (OPM_S >= Platform_ArgCount) { + return; + } + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + __NEW(T, Texts_TextDesc); + Texts_Open(T, s, ((LONGINT)(256))); + OPM_LogWStr(s, ((LONGINT)(256))); + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + __COPY(s, mname, mname__len); + __COPY(s, OPM_SourceFileName, ((LONGINT)(256))); + if (T->len == 0) { + OPM_LogWStr(s, ((LONGINT)(256))); + OPM_LogWStr((CHAR*)" not found.", (LONGINT)12); + OPM_LogWLn(); + } else { + Texts_OpenReader(&OPM_inR, Texts_Reader__typ, T, ((LONGINT)(0))); + *done = 1; + } + OPM_S += 1; + OPM_level = 0; + OPM_noerr = 1; + OPM_errpos = OPM_curpos; + OPM_lasterrpos = OPM_curpos - 10; + OPM_ErrorLineStartPos = 0; + OPM_ErrorLineLimitPos = 0; + OPM_ErrorLineNumber = 0; +} + +void OPM_Get (CHAR *ch) +{ + Texts_Read(&OPM_inR, Texts_Reader__typ, &*ch); + if (*ch == 0x0d) { + OPM_curpos = Texts_Pos(&OPM_inR, Texts_Reader__typ); + } else { + OPM_curpos += 1; + } + if ((*ch < 0x09 && !OPM_inR.eot)) { + *ch = ' '; + } +} + +static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len) +{ + INTEGER i, j; + CHAR ch; + __DUP(ext, ext__len, CHAR); + i = 0; + for (;;) { + ch = name[__X(i, name__len)]; + if (ch == 0x00) { + break; + } + FName[__X(i, FName__len)] = ch; + i += 1; + } + j = 0; + do { + ch = ext[__X(j, ext__len)]; + FName[__X(i, FName__len)] = ch; + i += 1; + j += 1; + } while (!(ch == 0x00)); + __DEL(ext); +} + +static void OPM_LogErrMsg (INTEGER n) +{ + Texts_Scanner S; + Texts_Text T = NIL; + CHAR ch; + INTEGER i; + CHAR buf[1024]; + if (n >= 0) { + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"31m", (LONGINT)4); + } + OPM_LogWStr((CHAR*)" err ", (LONGINT)7); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + } else { + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"35m", (LONGINT)4); + } + OPM_LogWStr((CHAR*)" warning ", (LONGINT)11); + n = -n; + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + } + OPM_LogWNum(n, ((LONGINT)(1))); + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + OPM_LogWStr(errors_errors[__X(n, ((LONGINT)(350)))], ((LONGINT)(128))); +} + +static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT pos) +{ + CHAR ch, cheol; + if (pos < OPM_ErrorLineStartPos) { + OPM_ErrorLineStartPos = 0; + OPM_ErrorLineLimitPos = 0; + OPM_ErrorLineNumber = 0; + } + if (pos < OPM_ErrorLineLimitPos) { + Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos); + return; + } + Files_Set(&*r, r__typ, f, OPM_ErrorLineLimitPos); + Files_Read(&*r, r__typ, (void*)&ch); + while ((OPM_ErrorLineLimitPos < pos && !(*r).eof)) { + OPM_ErrorLineStartPos = OPM_ErrorLineLimitPos; + OPM_ErrorLineNumber += 1; + while ((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) { + Files_Read(&*r, r__typ, (void*)&ch); + OPM_ErrorLineLimitPos += 1; + } + cheol = ch; + Files_Read(&*r, r__typ, (void*)&ch); + OPM_ErrorLineLimitPos += 1; + if ((cheol == 0x0d && ch == 0x0a)) { + OPM_ErrorLineLimitPos += 1; + Files_Read(&*r, r__typ, (void*)&ch); + } + } + Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos); +} + +static void OPM_ShowLine (LONGINT pos) +{ + Files_File f = NIL; + Files_Rider r; + CHAR line[1023]; + INTEGER i; + CHAR ch; + f = Files_Old(OPM_SourceFileName, ((LONGINT)(256))); + OPM_FindLine(f, &r, Files_Rider__typ, pos); + i = 0; + Files_Read(&r, Files_Rider__typ, (void*)&ch); + while ((((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) && i < 1022)) { + line[__X(i, ((LONGINT)(1023)))] = ch; + i += 1; + Files_Read(&r, Files_Rider__typ, (void*)&ch); + } + line[__X(i, ((LONGINT)(1023)))] = 0x00; + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWNum(OPM_ErrorLineNumber, ((LONGINT)(4))); + OPM_LogWStr((CHAR*)": ", (LONGINT)3); + OPM_LogWStr(line, ((LONGINT)(1023))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" ", (LONGINT)7); + if (pos >= OPM_ErrorLineLimitPos) { + pos = OPM_ErrorLineLimitPos - 1; + } + i = (int)(pos - OPM_ErrorLineStartPos); + while (i > 0) { + OPM_LogW(' '); + i -= 1; + } + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"32m", (LONGINT)4); + } + OPM_LogW('^'); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + Files_Close(f); +} + +void OPM_Mark (INTEGER n, LONGINT pos) +{ + if (pos == -1) { + pos = 0; + } + if (n >= 0) { + OPM_noerr = 0; + if (pos < OPM_lasterrpos || OPM_lasterrpos + 9 < pos) { + OPM_lasterrpos = pos; + OPM_ShowLine(pos); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + if (n < 249) { + OPM_LogWStr((CHAR*)" pos", (LONGINT)6); + OPM_LogWNum(pos, ((LONGINT)(6))); + OPM_LogErrMsg(n); + } else if (n == 255) { + OPM_LogWStr((CHAR*)"pos", (LONGINT)4); + OPM_LogWNum(pos, ((LONGINT)(6))); + OPM_LogWStr((CHAR*)" pc ", (LONGINT)6); + OPM_LogWNum(OPM_breakpc, ((LONGINT)(1))); + } else if (n == 254) { + OPM_LogWStr((CHAR*)"pc not found", (LONGINT)13); + } else { + OPM_LogWStr(OPM_objname, ((LONGINT)(64))); + if (n == 253) { + OPM_LogWStr((CHAR*)" is new, compile with option e", (LONGINT)31); + } else if (n == 252) { + OPM_LogWStr((CHAR*)" is redefined, compile with option s", (LONGINT)37); + } else if (n == 251) { + OPM_LogWStr((CHAR*)" is redefined (private part only), compile with option s", (LONGINT)57); + } else if (n == 250) { + OPM_LogWStr((CHAR*)" is no longer visible, compile with option s", (LONGINT)45); + } else if (n == 249) { + OPM_LogWStr((CHAR*)" is not consistently imported, recompile imports", (LONGINT)49); + } + } + } + } else { + if (pos >= 0) { + OPM_ShowLine(pos); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" pos", (LONGINT)6); + OPM_LogWNum(pos, ((LONGINT)(6))); + } + OPM_LogErrMsg(n); + if (pos < 0) { + OPM_LogWLn(); + } + } +} + +void OPM_err (INTEGER n) +{ + OPM_Mark(n, OPM_errpos); +} + +void OPM_FPrint (LONGINT *fp, LONGINT val) +{ + *fp = __ROTL((LONGINT)((SET)*fp ^ (SET)val), 1, LONGINT); +} + +void OPM_FPrintSet (LONGINT *fp, SET set) +{ + OPM_FPrint(&*fp, (LONGINT)set); +} + +void OPM_FPrintReal (LONGINT *fp, REAL real) +{ + OPM_FPrint(&*fp, __VAL(LONGINT, real)); +} + +void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr) +{ + LONGINT l, h; + __GET((LONGINT)(uintptr_t)&lr, l, LONGINT); + __GET((LONGINT)(uintptr_t)&lr + 4, h, LONGINT); + OPM_FPrint(&*fp, l); + OPM_FPrint(&*fp, h); +} + +static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align) +{ + __DUP(name, name__len, CHAR); + if (((*S).class == 1 && __STRCMP((*S).s, name) == 0)) { + Texts_Scan(&*S, S__typ); + if ((*S).class == 3) { + *size = (int)(*S).i; + Texts_Scan(&*S, S__typ); + } else { + OPM_Mark(-157, ((LONGINT)(-1))); + } + if ((*S).class == 3) { + *align = (int)(*S).i; + Texts_Scan(&*S, S__typ); + } else { + OPM_Mark(-157, ((LONGINT)(-1))); + } + } else { + OPM_Mark(-157, ((LONGINT)(-1))); + } + __DEL(name); +} + +static LONGINT OPM_minus (LONGINT i) +{ + LONGINT _o_result; + _o_result = -i; + return _o_result; +} + +static LONGINT OPM_power0 (LONGINT i, LONGINT j) +{ + LONGINT _o_result; + LONGINT k, p; + k = 1; + p = i; + do { + p = p * i; + k += 1; + } while (!(k == j)); + _o_result = p; + return _o_result; +} + +static void OPM_VerboseListSizes (void) +{ + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Type Size Alignement", (LONGINT)29); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"CHAR ", (LONGINT)14); + OPM_LogWNum(OPM_CharSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_CharAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"BOOLEAN ", (LONGINT)14); + OPM_LogWNum(OPM_BoolSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_BoolAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"SHORTINT ", (LONGINT)14); + OPM_LogWNum(OPM_SIntSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_SIntAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"INTEGER ", (LONGINT)14); + OPM_LogWNum(OPM_IntSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_IntAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"LONGINT ", (LONGINT)14); + OPM_LogWNum(OPM_LIntSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_LIntAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"SET ", (LONGINT)14); + OPM_LogWNum(OPM_SetSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_SetAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"REAL ", (LONGINT)14); + OPM_LogWNum(OPM_RealSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_RealAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"LONGREAL ", (LONGINT)14); + OPM_LogWNum(OPM_LRealSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_LRealAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"PTR ", (LONGINT)14); + OPM_LogWNum(OPM_PointerSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_PointerAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"PROC ", (LONGINT)14); + OPM_LogWNum(OPM_ProcSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_ProcAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"RECORD ", (LONGINT)14); + OPM_LogWNum(OPM_RecSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_RecAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Min shortint ", (LONGINT)14); + OPM_LogWNum(OPM_MinSInt, ((LONGINT)(4))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Max shortint ", (LONGINT)14); + OPM_LogWNum(OPM_MaxSInt, ((LONGINT)(4))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Min integer ", (LONGINT)14); + OPM_LogWNum(OPM_MinInt, ((LONGINT)(4))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Max integer ", (LONGINT)14); + OPM_LogWNum(OPM_MaxInt, ((LONGINT)(4))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Min longint ", (LONGINT)14); + OPM_LogWNum(OPM_MinLInt, ((LONGINT)(4))); + OPM_LogWLn(); +} + +static INTEGER OPM_Min (INTEGER a, INTEGER b) +{ + INTEGER _o_result; + if (a < b) { + _o_result = a; + return _o_result; + } else { + _o_result = b; + return _o_result; + } + __RETCHK; +} + +static void OPM_GetProperties (void) +{ + LONGINT base; + OPM_ProcSize = OPM_PointerSize; + OPM_LIntSize = __ASHL(OPM_IntSize, 1); + OPM_SetSize = OPM_LIntSize; + OPM_CharAlign = OPM_Min(OPM_Alignment, OPM_CharSize); + OPM_BoolAlign = OPM_Min(OPM_Alignment, OPM_BoolSize); + OPM_SIntAlign = OPM_Min(OPM_Alignment, OPM_SIntSize); + OPM_RecAlign = OPM_Min(OPM_Alignment, OPM_RecSize); + OPM_RealAlign = OPM_Min(OPM_Alignment, OPM_RealSize); + OPM_LRealAlign = OPM_Min(OPM_Alignment, OPM_LRealSize); + OPM_PointerAlign = OPM_Min(OPM_Alignment, OPM_PointerSize); + OPM_ProcAlign = OPM_Min(OPM_Alignment, OPM_ProcSize); + OPM_IntAlign = OPM_Min(OPM_Alignment, OPM_IntSize); + OPM_LIntAlign = OPM_Min(OPM_Alignment, OPM_LIntSize); + OPM_SetAlign = OPM_Min(OPM_Alignment, OPM_SetSize); + base = -2; + OPM_MinSInt = __ASH(base, __ASHL(OPM_SIntSize, 3) - 2); + OPM_MaxSInt = OPM_minus(OPM_MinSInt + 1); + OPM_MinInt = __ASH(base, __ASHL(OPM_IntSize, 3) - 2); + OPM_MaxInt = OPM_minus(OPM_MinInt + 1); + OPM_MinLInt = __ASH(base, __ASHL(OPM_LIntSize, 3) - 2); + OPM_MaxLInt = OPM_minus(OPM_MinLInt + 1); + if (OPM_RealSize == 4) { + OPM_MaxReal = 3.40282346000000e+038; + } else if (OPM_RealSize == 8) { + OPM_MaxReal = 1.79769296342094e+308; + } + if (OPM_LRealSize == 4) { + OPM_MaxLReal = 3.40282346000000e+038; + } else if (OPM_LRealSize == 8) { + OPM_MaxLReal = 1.79769296342094e+308; + } + OPM_MinReal = -OPM_MaxReal; + OPM_MinLReal = -OPM_MaxLReal; + OPM_MaxSet = __ASHL(OPM_SetSize, 3) - 1; + OPM_MaxIndex = OPM_MaxLInt; + if (OPM_Verbose) { + OPM_VerboseListSizes(); + } +} + +void OPM_SymRCh (CHAR *ch) +{ + Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&*ch); +} + +LONGINT OPM_SymRInt (void) +{ + LONGINT _o_result; + LONGINT k; + Files_ReadNum(&OPM_oldSF, Files_Rider__typ, &k); + _o_result = k; + return _o_result; +} + +void OPM_SymRSet (SET *s) +{ + Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (LONGINT*)&*s); +} + +void OPM_SymRReal (REAL *r) +{ + Files_ReadReal(&OPM_oldSF, Files_Rider__typ, &*r); +} + +void OPM_SymRLReal (LONGREAL *lr) +{ + Files_ReadLReal(&OPM_oldSF, Files_Rider__typ, &*lr); +} + +void OPM_CloseOldSym (void) +{ +} + +void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done) +{ + CHAR ch; + OPM_FileName fileName; + OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5); + OPM_oldSFile = Files_Old(fileName, ((LONGINT)(32))); + *done = OPM_oldSFile != NIL; + if (*done) { + Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, ((LONGINT)(0))); + Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ch); + if (ch != 0xf7) { + OPM_err(-306); + OPM_CloseOldSym(); + *done = 0; + } + } +} + +BOOLEAN OPM_eofSF (void) +{ + BOOLEAN _o_result; + _o_result = OPM_oldSF.eof; + return _o_result; +} + +void OPM_SymWCh (CHAR ch) +{ + Files_Write(&OPM_newSF, Files_Rider__typ, ch); +} + +void OPM_SymWInt (LONGINT i) +{ + Files_WriteNum(&OPM_newSF, Files_Rider__typ, i); +} + +void OPM_SymWSet (SET s) +{ + Files_WriteNum(&OPM_newSF, Files_Rider__typ, (LONGINT)s); +} + +void OPM_SymWReal (REAL r) +{ + Files_WriteReal(&OPM_newSF, Files_Rider__typ, r); +} + +void OPM_SymWLReal (LONGREAL lr) +{ + Files_WriteLReal(&OPM_newSF, Files_Rider__typ, lr); +} + +void OPM_RegisterNewSym (void) +{ + if (__STRCMP(OPM_modName, "SYSTEM") != 0 || __IN(10, OPM_opt)) { + Files_Register(OPM_newSFile); + } +} + +void OPM_DeleteNewSym (void) +{ +} + +void OPM_NewSym (CHAR *modName, LONGINT modName__len) +{ + OPM_FileName fileName; + OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5); + OPM_newSFile = Files_New(fileName, ((LONGINT)(32))); + if (OPM_newSFile != NIL) { + Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, ((LONGINT)(0))); + Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7); + } else { + OPM_err(153); + } +} + +void OPM_Write (CHAR ch) +{ + Files_Write(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, ch); +} + +void OPM_WriteString (CHAR *s, LONGINT s__len) +{ + INTEGER i; + i = 0; + while (s[__X(i, s__len)] != 0x00) { + i += 1; + } + Files_WriteBytes(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, (void*)s, s__len * ((LONGINT)(1)), i); +} + +void OPM_WriteStringVar (CHAR *s, LONGINT s__len) +{ + INTEGER i; + i = 0; + while (s[__X(i, s__len)] != 0x00) { + i += 1; + } + Files_WriteBytes(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, (void*)s, s__len * ((LONGINT)(1)), i); +} + +void OPM_WriteHex (LONGINT i) +{ + CHAR s[3]; + INTEGER digit; + digit = __ASHR((int)i, 4); + if (digit < 10) { + s[0] = (CHAR)(48 + digit); + } else { + s[0] = (CHAR)(87 + digit); + } + digit = __MASK((int)i, -16); + if (digit < 10) { + s[1] = (CHAR)(48 + digit); + } else { + s[1] = (CHAR)(87 + digit); + } + s[2] = 0x00; + OPM_WriteString(s, ((LONGINT)(3))); +} + +void OPM_WriteInt (LONGINT i) +{ + CHAR s[20]; + LONGINT i1, k; + if (i == OPM_MinInt || i == OPM_MinLInt) { + OPM_Write('('); + OPM_WriteInt(i + 1); + OPM_WriteString((CHAR*)"-1)", (LONGINT)4); + } else { + i1 = __ABS(i); + s[0] = (CHAR)(__MOD(i1, 10) + 48); + i1 = __DIV(i1, 10); + k = 1; + while (i1 > 0) { + s[__X(k, ((LONGINT)(20)))] = (CHAR)(__MOD(i1, 10) + 48); + i1 = __DIV(i1, 10); + k += 1; + } + if (i < 0) { + s[__X(k, ((LONGINT)(20)))] = '-'; + k += 1; + } + while (k > 0) { + k -= 1; + OPM_Write(s[__X(k, ((LONGINT)(20)))]); + } + } +} + +void OPM_WriteReal (LONGREAL r, CHAR suffx) +{ + Texts_Writer W; + Texts_Text T = NIL; + Texts_Reader R; + CHAR s[32]; + CHAR ch; + INTEGER i; + if ((((r < OPM_MaxLInt && r > OPM_MinLInt)) && r == (__ENTIER(r)))) { + if (suffx == 'f') { + OPM_WriteString((CHAR*)"(REAL)", (LONGINT)7); + } else { + OPM_WriteString((CHAR*)"(LONGREAL)", (LONGINT)11); + } + OPM_WriteInt(__ENTIER(r)); + } else { + Texts_OpenWriter(&W, Texts_Writer__typ); + if (suffx == 'f') { + Texts_WriteLongReal(&W, Texts_Writer__typ, r, 16); + } else { + Texts_WriteLongReal(&W, Texts_Writer__typ, r, 23); + } + __NEW(T, Texts_TextDesc); + Texts_Open(T, (CHAR*)"", (LONGINT)1); + Texts_Append(T, W.buf); + Texts_OpenReader(&R, Texts_Reader__typ, T, ((LONGINT)(0))); + i = 0; + Texts_Read(&R, Texts_Reader__typ, &ch); + while (ch != 0x00) { + s[__X(i, ((LONGINT)(32)))] = ch; + i += 1; + Texts_Read(&R, Texts_Reader__typ, &ch); + } + s[__X(i, ((LONGINT)(32)))] = 0x00; + i = 0; + ch = s[0]; + while ((ch != 'D' && ch != 0x00)) { + i += 1; + ch = s[__X(i, ((LONGINT)(32)))]; + } + if (ch == 'D') { + s[__X(i, ((LONGINT)(32)))] = 'e'; + } + OPM_WriteString(s, ((LONGINT)(32))); + } +} + +void OPM_WriteLn (void) +{ + Files_Write(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, 0x0a); +} + +static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F) +{ + Files_Rider R1; + CHAR buffer[4096]; + if (F != NIL) { + Files_Set(&R1, Files_Rider__typ, F, ((LONGINT)(0))); + Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, ((LONGINT)(4096)), ((LONGINT)(4096))); + while (4096 - R1.res > 0) { + Files_WriteBytes(&*R, R__typ, (void*)buffer, ((LONGINT)(4096)), 4096 - R1.res); + Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, ((LONGINT)(4096)), ((LONGINT)(4096))); + } + } +} + +void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len) +{ + CHAR FName[32]; + __COPY(moduleName, OPM_modName, ((LONGINT)(32))); + OPM_HFile = Files_New((CHAR*)"", (LONGINT)1); + if (OPM_HFile != NIL) { + Files_Set(&OPM_R[0], Files_Rider__typ, OPM_HFile, ((LONGINT)(0))); + } else { + OPM_err(153); + } + OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, ((LONGINT)(32)), (CHAR*)".c", (LONGINT)3); + OPM_BFile = Files_New(FName, ((LONGINT)(32))); + if (OPM_BFile != NIL) { + Files_Set(&OPM_R[1], Files_Rider__typ, OPM_BFile, ((LONGINT)(0))); + } else { + OPM_err(153); + } + OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, ((LONGINT)(32)), (CHAR*)".h", (LONGINT)3); + OPM_HIFile = Files_New(FName, ((LONGINT)(32))); + if (OPM_HIFile != NIL) { + Files_Set(&OPM_R[2], Files_Rider__typ, OPM_HIFile, ((LONGINT)(0))); + } else { + OPM_err(153); + } +} + +void OPM_CloseFiles (void) +{ + CHAR FName[32]; + INTEGER res; + if (OPM_noerr) { + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + OPM_LogWNum(Files_Pos(&OPM_R[1], Files_Rider__typ), ((LONGINT)(0))); + OPM_LogWStr((CHAR*)" chars.", (LONGINT)8); + } + if (OPM_noerr) { + if (__STRCMP(OPM_modName, "SYSTEM") == 0) { + if (!__IN(10, OPM_opt)) { + Files_Register(OPM_BFile); + } + } else if (!__IN(10, OPM_opt)) { + OPM_Append(&OPM_R[2], Files_Rider__typ, OPM_HFile); + Files_Register(OPM_HIFile); + Files_Register(OPM_BFile); + } else { + OPM_MakeFileName((void*)OPM_modName, ((LONGINT)(32)), (void*)FName, ((LONGINT)(32)), (CHAR*)".h", (LONGINT)3); + Files_Delete(FName, ((LONGINT)(32)), &res); + OPM_MakeFileName((void*)OPM_modName, ((LONGINT)(32)), (void*)FName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5); + Files_Delete(FName, ((LONGINT)(32)), &res); + Files_Register(OPM_BFile); + } + } + OPM_HFile = NIL; + OPM_BFile = NIL; + OPM_HIFile = NIL; + OPM_newSFile = NIL; + OPM_oldSFile = NIL; + Files_Set(&OPM_R[0], Files_Rider__typ, NIL, ((LONGINT)(0))); + Files_Set(&OPM_R[1], Files_Rider__typ, NIL, ((LONGINT)(0))); + Files_Set(&OPM_R[2], Files_Rider__typ, NIL, ((LONGINT)(0))); + Files_Set(&OPM_newSF, Files_Rider__typ, NIL, ((LONGINT)(0))); + Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, ((LONGINT)(0))); +} + +static void EnumPtrs(void (*P)(void*)) +{ + __ENUMR(&OPM_inR, Texts_Reader__typ, 48, 1, P); + P(OPM_Log); + __ENUMR(&OPM_W, Texts_Writer__typ, 36, 1, P); + __ENUMR(&OPM_oldSF, Files_Rider__typ, 20, 1, P); + __ENUMR(&OPM_newSF, Files_Rider__typ, 20, 1, P); + __ENUMR(OPM_R, Files_Rider__typ, 20, 3, P); + P(OPM_oldSFile); + P(OPM_newSFile); + P(OPM_HFile); + P(OPM_BFile); + P(OPM_HIFile); +} + + +export void *OPM__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Console); + __MODULE_IMPORT(Files); + __MODULE_IMPORT(Platform); + __MODULE_IMPORT(Strings); + __MODULE_IMPORT(Texts); + __MODULE_IMPORT(errors); + __MODULE_IMPORT(vt100); + __REGMOD("OPM", EnumPtrs); + __REGCMD("CloseFiles", OPM_CloseFiles); + __REGCMD("CloseOldSym", OPM_CloseOldSym); + __REGCMD("DeleteNewSym", OPM_DeleteNewSym); + __REGCMD("InitOptions", OPM_InitOptions); + __REGCMD("LogWLn", OPM_LogWLn); + __REGCMD("RegisterNewSym", OPM_RegisterNewSym); + __REGCMD("WriteLn", OPM_WriteLn); +/* BEGIN */ + Texts_OpenWriter(&OPM_W, Texts_Writer__typ); + OPM_MODULES[0] = 0x00; + Platform_GetEnv((CHAR*)"MODULES", (LONGINT)8, (void*)OPM_MODULES, ((LONGINT)(1024))); + __MOVE(".", OPM_OBERON, 2); + Platform_GetEnv((CHAR*)"OBERON", (LONGINT)7, (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append((CHAR*)";.;", (LONGINT)4, (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append(OPM_MODULES, ((LONGINT)(1024)), (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append((CHAR*)";", (LONGINT)2, (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append((CHAR*)"/sym;", (LONGINT)6, (void*)OPM_OBERON, ((LONGINT)(1024))); + Files_SetSearchPath(OPM_OBERON, ((LONGINT)(1024))); + OPM_CharSize = 1; + OPM_BoolSize = 1; + OPM_SIntSize = 1; + OPM_RecSize = 1; + OPM_ByteSize = 1; + OPM_RealSize = 4; + OPM_LRealSize = 8; + OPM_PointerSize = 8; + OPM_Alignment = 8; + OPM_IntSize = 4; + __ENDMOD; +} diff --git a/bootstrap/unix-48/OPM.h b/bootstrap/unix-48/OPM.h new file mode 100644 index 00000000..68bf3af0 --- /dev/null +++ b/bootstrap/unix-48/OPM.h @@ -0,0 +1,63 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPM__h +#define OPM__h + +#include "SYSTEM.h" + + +import INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_CharAlign, OPM_BoolAlign, OPM_SIntAlign, OPM_IntAlign, OPM_LIntAlign, OPM_SetAlign, OPM_RealAlign, OPM_LRealAlign, OPM_PointerAlign, OPM_ProcAlign, OPM_RecAlign, OPM_MaxSet; +import LONGINT OPM_MinSInt, OPM_MinInt, OPM_MinLInt, OPM_MaxSInt, OPM_MaxInt, OPM_MaxLInt, OPM_MaxIndex; +import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; +import BOOLEAN OPM_noerr; +import LONGINT OPM_curpos, OPM_errpos, OPM_breakpc; +import INTEGER OPM_currFile, OPM_level, OPM_pc, OPM_entno; +import CHAR OPM_modName[32]; +import CHAR OPM_objname[64]; +import SET OPM_opt, OPM_glbopt; +import BOOLEAN OPM_dontAsm, OPM_dontLink, OPM_mainProg, OPM_mainLinkStat, OPM_notColorOutput, OPM_forceNewSym, OPM_Verbose; + + +import void OPM_CloseFiles (void); +import void OPM_CloseOldSym (void); +import void OPM_DeleteNewSym (void); +import void OPM_FPrint (LONGINT *fp, LONGINT val); +import void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr); +import void OPM_FPrintReal (LONGINT *fp, REAL real); +import void OPM_FPrintSet (LONGINT *fp, SET set); +import void OPM_Get (CHAR *ch); +import void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len); +import void OPM_InitOptions (void); +import void OPM_LogW (CHAR ch); +import void OPM_LogWLn (void); +import void OPM_LogWNum (LONGINT i, LONGINT len); +import void OPM_LogWStr (CHAR *s, LONGINT s__len); +import void OPM_Mark (INTEGER n, LONGINT pos); +import void OPM_NewSym (CHAR *modName, LONGINT modName__len); +import void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done); +import void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len); +import BOOLEAN OPM_OpenPar (void); +import void OPM_RegisterNewSym (void); +import void OPM_SymRCh (CHAR *ch); +import LONGINT OPM_SymRInt (void); +import void OPM_SymRLReal (LONGREAL *lr); +import void OPM_SymRReal (REAL *r); +import void OPM_SymRSet (SET *s); +import void OPM_SymWCh (CHAR ch); +import void OPM_SymWInt (LONGINT i); +import void OPM_SymWLReal (LONGREAL lr); +import void OPM_SymWReal (REAL r); +import void OPM_SymWSet (SET s); +import void OPM_Write (CHAR ch); +import void OPM_WriteHex (LONGINT i); +import void OPM_WriteInt (LONGINT i); +import void OPM_WriteLn (void); +import void OPM_WriteReal (LONGREAL r, CHAR suffx); +import void OPM_WriteString (CHAR *s, LONGINT s__len); +import void OPM_WriteStringVar (CHAR *s, LONGINT s__len); +import BOOLEAN OPM_eofSF (void); +import void OPM_err (INTEGER n); +import void *OPM__init(void); + + +#endif diff --git a/bootstrap/unix-48/OPP.c b/bootstrap/unix-48/OPP.c new file mode 100644 index 00000000..f0530bb4 --- /dev/null +++ b/bootstrap/unix-48/OPP.c @@ -0,0 +1,1873 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "OPB.h" +#include "OPM.h" +#include "OPS.h" +#include "OPT.h" + +struct OPP__1 { + LONGINT low, high; +}; + +typedef + struct OPP__1 OPP_CaseTable[128]; + + +static SHORTINT OPP_sym, OPP_level; +static INTEGER OPP_LoopLevel; +static OPT_Node OPP_TDinit, OPP_lastTDinit; +static INTEGER OPP_nofFwdPtr; +static OPT_Struct OPP_FwdPtr[64]; + +export LONGINT *OPP__1__typ; + +static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar); +static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned); +static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq); +static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab); +static void OPP_CheckMark (SHORTINT *vis); +static void OPP_CheckSym (INTEGER s); +static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_); +static void OPP_ConstExpression (OPT_Node *x); +static void OPP_Element (OPT_Node *x); +static void OPP_Expression (OPT_Node *x); +static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b); +static void OPP_Factor (OPT_Node *x); +static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp); +export void OPP_Module (OPT_Node *prog, SET opt); +static void OPP_PointerType (OPT_Struct *typ); +static void OPP_ProcedureDeclaration (OPT_Node *x); +static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec); +static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned); +static void OPP_Sets (OPT_Node *x); +static void OPP_SimpleExpression (OPT_Node *x); +static void OPP_StandProcCall (OPT_Node *x); +static void OPP_StatSeq (OPT_Node *stat); +static void OPP_Term (OPT_Node *x); +static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned); +static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned); +static void OPP_err (INTEGER n); +static void OPP_qualident (OPT_Object *id); +static void OPP_selector (OPT_Node *x); + + +static void OPP_err (INTEGER n) +{ + OPM_err(n); +} + +static void OPP_CheckSym (INTEGER s) +{ + if ((int)OPP_sym == s) { + OPS_Get(&OPP_sym); + } else { + OPM_err(s); + } +} + +static void OPP_qualident (OPT_Object *id) +{ + OPT_Object obj = NIL; + SHORTINT lev; + OPT_Find(&obj); + OPS_Get(&OPP_sym); + if ((((OPP_sym == 18 && obj != NIL)) && obj->mode == 11)) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPT_FindImport(obj, &obj); + OPS_Get(&OPP_sym); + } else { + OPP_err(38); + obj = NIL; + } + } + if (obj == NIL) { + OPP_err(0); + obj = OPT_NewObj(); + obj->mode = 1; + obj->typ = OPT_undftyp; + obj->adr = 0; + } else { + lev = obj->mnolev; + if ((__IN(obj->mode, 0x06) && lev != OPP_level)) { + obj->leaf = 0; + if (lev > 0) { + OPB_StaticLink(OPP_level - lev); + } + } + } + *id = obj; +} + +static void OPP_ConstExpression (OPT_Node *x) +{ + OPP_Expression(&*x); + if ((*x)->class != 7) { + OPP_err(50); + *x = OPB_NewIntConst(((LONGINT)(1))); + } +} + +static void OPP_CheckMark (SHORTINT *vis) +{ + OPS_Get(&OPP_sym); + if (OPP_sym == 1 || OPP_sym == 7) { + if (OPP_level > 0) { + OPP_err(47); + } + if (OPP_sym == 1) { + *vis = 1; + } else { + *vis = 2; + } + OPS_Get(&OPP_sym); + } else { + *vis = 0; + } +} + +static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_) +{ + OPT_Node x = NIL; + LONGINT sf; + if (OPP_sym == 31) { + OPS_Get(&OPP_sym); + if (!OPT_SYSimported) { + OPP_err(135); + } + OPP_ConstExpression(&x); + if (__IN(x->typ->form, 0x70)) { + sf = x->conval->intval; + if (sf < 0 || sf > 1) { + OPP_err(220); + sf = 0; + } + } else { + OPP_err(51); + sf = 0; + } + *sysflag = (int)sf; + OPP_CheckSym(23); + } else { + *sysflag = default_; + } +} + +static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned) +{ + OPT_Object fld = NIL, first = NIL, last = NIL, base = NIL; + OPT_Struct ftyp = NIL; + INTEGER sysflag; + *typ = OPT_NewStr(15, 4); + (*typ)->BaseTyp = NIL; + OPP_CheckSysFlag(&sysflag, -1); + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPP_qualident(&base); + if ((base->mode == 5 && base->typ->comp == 4)) { + if (base->typ == *banned) { + OPP_err(58); + } else { + base->typ->pvused = 1; + (*typ)->BaseTyp = base->typ; + (*typ)->extlev = base->typ->extlev + 1; + (*typ)->sysflag = base->typ->sysflag; + } + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + OPP_CheckSym(22); + } + if (sysflag >= 0) { + (*typ)->sysflag = sysflag; + } + OPT_OpenScope(0, NIL); + first = NIL; + last = NIL; + for (;;) { + if (OPP_sym == 38) { + for (;;) { + if (OPP_sym == 38) { + if ((*typ)->BaseTyp != NIL) { + OPT_FindField(OPS_name, (*typ)->BaseTyp, &fld); + if (fld != NIL) { + OPP_err(1); + } + } + OPT_Insert(OPS_name, &fld); + OPP_CheckMark(&fld->vis); + fld->mode = 4; + fld->link = NIL; + fld->typ = OPT_undftyp; + if (first == NIL) { + first = fld; + } + if (last == NIL) { + (*typ)->link = fld; + } else { + last->link = fld; + } + last = fld; + } else { + OPP_err(38); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(19); + } else { + break; + } + } + OPP_CheckSym(20); + OPP_Type(&ftyp, &*banned); + ftyp->pvused = 1; + if (ftyp->comp == 3) { + ftyp = OPT_undftyp; + OPP_err(88); + } + while (first != NIL) { + first->typ = ftyp; + first = first->link; + } + } + if (OPP_sym == 39) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(39); + } else { + break; + } + } + OPT_CloseScope(); +} + +static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned) +{ + OPT_Node x = NIL; + LONGINT n; + INTEGER sysflag; + OPP_CheckSysFlag(&sysflag, 0); + if (OPP_sym == 25) { + *typ = OPT_NewStr(15, 3); + (*typ)->mno = 0; + (*typ)->sysflag = sysflag; + OPS_Get(&OPP_sym); + OPP_Type(&(*typ)->BaseTyp, &*banned); + (*typ)->BaseTyp->pvused = 1; + if ((*typ)->BaseTyp->comp == 3) { + (*typ)->n = (*typ)->BaseTyp->n + 1; + } else { + (*typ)->n = 0; + } + } else { + *typ = OPT_NewStr(15, 2); + (*typ)->sysflag = sysflag; + OPP_ConstExpression(&x); + if (__IN(x->typ->form, 0x70)) { + n = x->conval->intval; + if (n <= 0 || n > OPM_MaxIndex) { + OPP_err(63); + n = 1; + } + } else { + OPP_err(51); + n = 1; + } + (*typ)->n = n; + if (OPP_sym == 25) { + OPS_Get(&OPP_sym); + OPP_Type(&(*typ)->BaseTyp, &*banned); + (*typ)->BaseTyp->pvused = 1; + } else if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + if (OPP_sym != 25) { + OPP_ArrayType(&(*typ)->BaseTyp, &*banned); + } + } else { + OPP_err(35); + } + if ((*typ)->BaseTyp->comp == 3) { + (*typ)->BaseTyp = OPT_undftyp; + OPP_err(88); + } + } +} + +static void OPP_PointerType (OPT_Struct *typ) +{ + OPT_Object id = NIL; + *typ = OPT_NewStr(13, 1); + OPP_CheckSysFlag(&(*typ)->sysflag, 0); + OPP_CheckSym(28); + if (OPP_sym == 38) { + OPT_Find(&id); + if (id == NIL) { + if (OPP_nofFwdPtr < 64) { + OPP_FwdPtr[__X(OPP_nofFwdPtr, ((LONGINT)(64)))] = *typ; + OPP_nofFwdPtr += 1; + } else { + OPP_err(224); + } + (*typ)->link = OPT_NewObj(); + __COPY(OPS_name, (*typ)->link->name, ((LONGINT)(256))); + (*typ)->BaseTyp = OPT_undftyp; + OPS_Get(&OPP_sym); + } else { + OPP_qualident(&id); + if (id->mode == 5) { + if (__IN(id->typ->comp, 0x1c)) { + (*typ)->BaseTyp = id->typ; + } else { + (*typ)->BaseTyp = OPT_undftyp; + OPP_err(57); + } + } else { + (*typ)->BaseTyp = OPT_undftyp; + OPP_err(52); + } + } + } else { + OPP_Type(&(*typ)->BaseTyp, &OPT_notyp); + if (!__IN((*typ)->BaseTyp->comp, 0x1c)) { + (*typ)->BaseTyp = OPT_undftyp; + OPP_err(57); + } + } +} + +static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp) +{ + SHORTINT mode; + OPT_Object par = NIL, first = NIL, last = NIL, res = NIL; + OPT_Struct typ = NIL; + first = NIL; + last = *firstPar; + if (OPP_sym == 38 || OPP_sym == 60) { + for (;;) { + if (OPP_sym == 60) { + OPS_Get(&OPP_sym); + mode = 2; + } else { + mode = 1; + } + for (;;) { + if (OPP_sym == 38) { + OPT_Insert(OPS_name, &par); + OPS_Get(&OPP_sym); + par->mode = mode; + par->link = NIL; + if (first == NIL) { + first = par; + } + if (*firstPar == NIL) { + *firstPar = par; + } else { + last->link = par; + } + last = par; + } else { + OPP_err(38); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(19); + } else if (OPP_sym == 60) { + OPP_err(19); + OPS_Get(&OPP_sym); + } else { + break; + } + } + OPP_CheckSym(20); + OPP_Type(&typ, &OPT_notyp); + if (mode == 1) { + typ->pvused = 1; + } + while (first != NIL) { + first->typ = typ; + first = first->link; + } + if (OPP_sym == 39) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(39); + } else { + break; + } + } + } + OPP_CheckSym(22); + if (OPP_sym == 20) { + OPS_Get(&OPP_sym); + *resTyp = OPT_undftyp; + if (OPP_sym == 38) { + OPP_qualident(&res); + if (res->mode == 5) { + if (res->typ->form < 15) { + *resTyp = res->typ; + } else { + OPP_err(54); + } + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + } else { + *resTyp = OPT_notyp; + } +} + +static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned) +{ + OPT_Object id = NIL; + *typ = OPT_undftyp; + if (OPP_sym < 30) { + OPP_err(12); + do { + OPS_Get(&OPP_sym); + } while (!(OPP_sym >= 30)); + } + if (OPP_sym == 38) { + OPP_qualident(&id); + if (id->mode == 5) { + if (id->typ != *banned) { + *typ = id->typ; + } else { + OPP_err(58); + } + } else { + OPP_err(52); + } + } else if (OPP_sym == 54) { + OPS_Get(&OPP_sym); + OPP_ArrayType(&*typ, &*banned); + } else if (OPP_sym == 55) { + OPS_Get(&OPP_sym); + OPP_RecordType(&*typ, &*banned); + OPB_Inittd(&OPP_TDinit, &OPP_lastTDinit, *typ); + OPP_CheckSym(41); + } else if (OPP_sym == 56) { + OPS_Get(&OPP_sym); + OPP_PointerType(&*typ); + } else if (OPP_sym == 61) { + OPS_Get(&OPP_sym); + *typ = OPT_NewStr(14, 1); + OPP_CheckSysFlag(&(*typ)->sysflag, 0); + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPT_OpenScope(OPP_level, NIL); + OPP_FormalParameters(&(*typ)->link, &(*typ)->BaseTyp); + OPT_CloseScope(); + } else { + (*typ)->BaseTyp = OPT_notyp; + (*typ)->link = NIL; + } + } else { + OPP_err(12); + } + for (;;) { + if (((OPP_sym >= 39 && OPP_sym <= 42) || OPP_sym == 22) || OPP_sym == 64) { + break; + } + OPP_err(15); + if (OPP_sym == 38) { + break; + } + OPS_Get(&OPP_sym); + } +} + +static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned) +{ + OPP_TypeDecl(&*typ, &*banned); + if (((((*typ)->form == 13 && (*typ)->BaseTyp == OPT_undftyp)) && (*typ)->strobj == NIL)) { + OPP_err(0); + } +} + +static void OPP_selector (OPT_Node *x) +{ + OPT_Object obj = NIL, proc = NIL; + OPT_Node y = NIL; + OPT_Struct typ = NIL; + OPS_Name name; + for (;;) { + if (OPP_sym == 31) { + OPS_Get(&OPP_sym); + for (;;) { + if (((*x)->typ != NIL && (*x)->typ->form == 13)) { + OPB_DeRef(&*x); + } + OPP_Expression(&y); + OPB_Index(&*x, y); + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else { + break; + } + } + OPP_CheckSym(23); + } else if (OPP_sym == 18) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + __COPY(OPS_name, name, ((LONGINT)(256))); + OPS_Get(&OPP_sym); + if ((*x)->typ != NIL) { + if ((*x)->typ->form == 13) { + OPB_DeRef(&*x); + } + if ((*x)->typ->comp == 4) { + OPT_FindField(name, (*x)->typ, &obj); + OPB_Field(&*x, obj); + if ((obj != NIL && obj->mode == 13)) { + if (OPP_sym == 17) { + OPS_Get(&OPP_sym); + y = (*x)->left; + if (y->class == 3) { + y = y->left; + } + if (y->obj != NIL) { + proc = OPT_topScope; + while ((proc->link != NIL && proc->link->mode != 13)) { + proc = proc->left; + } + if (proc->link == NIL || proc->link->link != y->obj) { + OPP_err(75); + } + typ = y->obj->typ; + if (typ->form == 13) { + typ = typ->BaseTyp; + } + OPT_FindField((*x)->obj->name, typ->BaseTyp, &proc); + if (proc != NIL) { + (*x)->subcl = 1; + } else { + OPP_err(74); + } + } else { + OPP_err(75); + } + } + if ((obj->typ != OPT_notyp && OPP_sym != 30)) { + OPP_err(30); + } + } + } else { + OPP_err(53); + } + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + } else if (OPP_sym == 17) { + OPS_Get(&OPP_sym); + OPB_DeRef(&*x); + } else if ((((((OPP_sym == 30 && (*x)->class < 7)) && (*x)->typ->form != 14)) && ((*x)->obj == NIL || (*x)->obj->mode != 13))) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPP_qualident(&obj); + if (obj->mode == 5) { + OPB_TypTest(&*x, obj, 1); + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + OPP_CheckSym(22); + } else { + break; + } + } +} + +static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar) +{ + OPT_Node apar = NIL, last = NIL; + *aparlist = NIL; + last = NIL; + if (OPP_sym != 22) { + for (;;) { + OPP_Expression(&apar); + if (fpar != NIL) { + OPB_Param(apar, fpar); + OPB_Link(&*aparlist, &last, apar); + fpar = fpar->link; + } else { + OPP_err(64); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if ((30 <= OPP_sym && OPP_sym <= 38)) { + OPP_err(19); + } else { + break; + } + } + } + if (fpar != NIL) { + OPP_err(65); + } +} + +static void OPP_StandProcCall (OPT_Node *x) +{ + OPT_Node y = NIL; + SHORTINT m; + INTEGER n; + m = (int)(*x)->obj->adr; + n = 0; + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + if (OPP_sym != 22) { + for (;;) { + if (n == 0) { + OPP_Expression(&*x); + OPB_StPar0(&*x, m); + n = 1; + } else if (n == 1) { + OPP_Expression(&y); + OPB_StPar1(&*x, y, m); + n = 2; + } else { + OPP_Expression(&y); + OPB_StParN(&*x, y, m, n); + n += 1; + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if ((30 <= OPP_sym && OPP_sym <= 38)) { + OPP_err(19); + } else { + break; + } + } + OPP_CheckSym(22); + } else { + OPS_Get(&OPP_sym); + } + OPB_StFct(&*x, m, n); + } else { + OPP_err(30); + } + if ((OPP_level > 0 && (m == 1 || m == 30))) { + OPT_topScope->link->leaf = 0; + } +} + +static void OPP_Element (OPT_Node *x) +{ + OPT_Node y = NIL; + OPP_Expression(&*x); + if (OPP_sym == 21) { + OPS_Get(&OPP_sym); + OPP_Expression(&y); + OPB_SetRange(&*x, y); + } else { + OPB_SetElem(&*x); + } +} + +static void OPP_Sets (OPT_Node *x) +{ + OPT_Node y = NIL; + if (OPP_sym != 24) { + OPP_Element(&*x); + for (;;) { + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if ((30 <= OPP_sym && OPP_sym <= 38)) { + OPP_err(19); + } else { + break; + } + OPP_Element(&y); + OPB_Op(6, &*x, y); + } + } else { + *x = OPB_EmptySet(); + } + OPP_CheckSym(24); +} + +static void OPP_Factor (OPT_Node *x) +{ + OPT_Object fpar = NIL, id = NIL; + OPT_Node apar = NIL; + if (OPP_sym < 30) { + OPP_err(13); + do { + OPS_Get(&OPP_sym); + } while (!(OPP_sym >= 30)); + } + if (OPP_sym == 38) { + OPP_qualident(&id); + *x = OPB_NewLeaf(id); + OPP_selector(&*x); + if (((*x)->class == 9 && (*x)->obj->mode == 8)) { + OPP_StandProcCall(&*x); + } else if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPB_PrepCall(&*x, &fpar); + OPP_ActualParameters(&apar, fpar); + OPB_Call(&*x, apar, fpar); + OPP_CheckSym(22); + if (OPP_level > 0) { + OPT_topScope->link->leaf = 0; + } + } + } else if (OPP_sym == 35) { + switch (OPS_numtyp) { + case 1: + *x = OPB_NewIntConst(OPS_intval); + (*x)->typ = OPT_chartyp; + break; + case 2: + *x = OPB_NewIntConst(OPS_intval); + break; + case 3: + *x = OPB_NewRealConst(OPS_realval, OPT_realtyp); + break; + case 4: + *x = OPB_NewRealConst(OPS_lrlval, OPT_lrltyp); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPP.Factor, OPS.numtyp = ", (LONGINT)44); + OPM_LogWNum(OPS_numtyp, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + OPS_Get(&OPP_sym); + } else if (OPP_sym == 37) { + *x = OPB_NewString(OPS_str, OPS_intval); + OPS_Get(&OPP_sym); + } else if (OPP_sym == 36) { + *x = OPB_Nil(); + OPS_Get(&OPP_sym); + } else if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPP_Expression(&*x); + OPP_CheckSym(22); + } else if (OPP_sym == 31) { + OPS_Get(&OPP_sym); + OPP_err(30); + OPP_Expression(&*x); + OPP_CheckSym(22); + } else if (OPP_sym == 32) { + OPS_Get(&OPP_sym); + OPP_Sets(&*x); + } else if (OPP_sym == 33) { + OPS_Get(&OPP_sym); + OPP_Factor(&*x); + OPB_MOp(33, &*x); + } else { + OPP_err(13); + OPS_Get(&OPP_sym); + *x = NIL; + } + if (*x == NIL) { + *x = OPB_NewIntConst(((LONGINT)(1))); + (*x)->typ = OPT_undftyp; + } +} + +static void OPP_Term (OPT_Node *x) +{ + OPT_Node y = NIL; + SHORTINT mulop; + OPP_Factor(&*x); + while ((1 <= OPP_sym && OPP_sym <= 5)) { + mulop = OPP_sym; + OPS_Get(&OPP_sym); + OPP_Factor(&y); + OPB_Op(mulop, &*x, y); + } +} + +static void OPP_SimpleExpression (OPT_Node *x) +{ + OPT_Node y = NIL; + SHORTINT addop; + if (OPP_sym == 7) { + OPS_Get(&OPP_sym); + OPP_Term(&*x); + OPB_MOp(7, &*x); + } else if (OPP_sym == 6) { + OPS_Get(&OPP_sym); + OPP_Term(&*x); + OPB_MOp(6, &*x); + } else { + OPP_Term(&*x); + } + while ((6 <= OPP_sym && OPP_sym <= 8)) { + addop = OPP_sym; + OPS_Get(&OPP_sym); + OPP_Term(&y); + OPB_Op(addop, &*x, y); + } +} + +static void OPP_Expression (OPT_Node *x) +{ + OPT_Node y = NIL; + OPT_Object obj = NIL; + SHORTINT relation; + OPP_SimpleExpression(&*x); + if ((9 <= OPP_sym && OPP_sym <= 14)) { + relation = OPP_sym; + OPS_Get(&OPP_sym); + OPP_SimpleExpression(&y); + OPB_Op(relation, &*x, y); + } else if (OPP_sym == 15) { + OPS_Get(&OPP_sym); + OPP_SimpleExpression(&y); + OPB_In(&*x, y); + } else if (OPP_sym == 16) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPP_qualident(&obj); + if (obj->mode == 5) { + OPB_TypTest(&*x, obj, 0); + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + } +} + +static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec) +{ + OPT_Object obj = NIL; + *typ = OPT_undftyp; + *rec = NIL; + if (OPP_sym == 60) { + OPS_Get(&OPP_sym); + *mode = 2; + } else { + *mode = 1; + } + __COPY(OPS_name, name, ((LONGINT)(256))); + OPP_CheckSym(38); + OPP_CheckSym(20); + if (OPP_sym == 38) { + OPT_Find(&obj); + OPS_Get(&OPP_sym); + if (obj == NIL) { + OPP_err(0); + } else if (obj->mode != 5) { + OPP_err(72); + } else { + *typ = obj->typ; + *rec = *typ; + if ((*rec)->form == 13) { + *rec = (*rec)->BaseTyp; + } + if (!((((*mode == 1 && (*typ)->form == 13)) && (*rec)->comp == 4) || (*mode == 2 && (*typ)->comp == 4))) { + OPP_err(70); + *rec = NIL; + } + if ((*rec != NIL && (*rec)->mno != OPP_level)) { + OPP_err(72); + *rec = NIL; + } + } + } else { + OPP_err(38); + } + OPP_CheckSym(22); + if (*rec == NIL) { + *rec = OPT_NewStr(15, 4); + (*rec)->BaseTyp = NIL; + } +} + +static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b) +{ + BOOLEAN _o_result; + if ((b->form == 13 && x->form == 13)) { + b = b->BaseTyp; + x = x->BaseTyp; + } + if ((b->comp == 4 && x->comp == 4)) { + do { + x = x->BaseTyp; + } while (!(x == NIL || x == b)); + } + _o_result = x == b; + return _o_result; +} + +static struct ProcedureDeclaration__16 { + OPT_Node *x; + OPT_Object *proc, *fwd; + OPS_Name *name; + SHORTINT *mode, *vis; + BOOLEAN *forward; + struct ProcedureDeclaration__16 *lnk; +} *ProcedureDeclaration__16_s; + +static void Body__17 (void); +static void GetCode__19 (void); +static void GetParams__21 (void); +static void TProcDecl__23 (void); + +static void GetCode__19 (void) +{ + OPT_ConstExt ext = NIL; + INTEGER n; + LONGINT c; + ext = OPT_NewExt(); + (*ProcedureDeclaration__16_s->proc)->conval->ext = ext; + n = 0; + if (OPP_sym == 37) { + while (OPS_str[__X(n, ((LONGINT)(256)))] != 0x00) { + (*ext)[__X(n + 1, ((LONGINT)(256)))] = OPS_str[__X(n, ((LONGINT)(256)))]; + n += 1; + } + (*ext)[0] = (CHAR)n; + OPS_Get(&OPP_sym); + } else { + for (;;) { + if (OPP_sym == 35) { + c = OPS_intval; + n += 1; + if ((c < 0 || c > 255) || n == 256) { + OPP_err(64); + c = 1; + n = 1; + } + OPS_Get(&OPP_sym); + (*ext)[__X(n, ((LONGINT)(256)))] = (CHAR)c; + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 35) { + OPP_err(19); + } else { + (*ext)[0] = (CHAR)n; + break; + } + } + } + (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1); +} + +static void GetParams__21 (void) +{ + (*ProcedureDeclaration__16_s->proc)->vis = *ProcedureDeclaration__16_s->vis; + (*ProcedureDeclaration__16_s->proc)->mode = *ProcedureDeclaration__16_s->mode; + (*ProcedureDeclaration__16_s->proc)->typ = OPT_notyp; + (*ProcedureDeclaration__16_s->proc)->conval = OPT_NewConst(); + (*ProcedureDeclaration__16_s->proc)->conval->setval = 0x0; + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPP_FormalParameters(&(*ProcedureDeclaration__16_s->proc)->link, &(*ProcedureDeclaration__16_s->proc)->typ); + } + if (*ProcedureDeclaration__16_s->fwd != NIL) { + OPB_CheckParameters((*ProcedureDeclaration__16_s->proc)->link, (*ProcedureDeclaration__16_s->fwd)->link, 1); + if ((*ProcedureDeclaration__16_s->proc)->typ != (*ProcedureDeclaration__16_s->fwd)->typ) { + OPP_err(117); + } + *ProcedureDeclaration__16_s->proc = *ProcedureDeclaration__16_s->fwd; + OPT_topScope = (*ProcedureDeclaration__16_s->proc)->scope; + if (*ProcedureDeclaration__16_s->mode == 10) { + (*ProcedureDeclaration__16_s->proc)->mode = 10; + } + } +} + +static void Body__17 (void) +{ + OPT_Node procdec = NIL, statseq = NIL; + LONGINT c; + c = OPM_errpos; + (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1); + OPP_CheckSym(39); + OPP_Block(&procdec, &statseq); + OPB_Enter(&procdec, statseq, *ProcedureDeclaration__16_s->proc); + *ProcedureDeclaration__16_s->x = procdec; + (*ProcedureDeclaration__16_s->x)->conval = OPT_NewConst(); + (*ProcedureDeclaration__16_s->x)->conval->intval = c; + if (OPP_sym == 38) { + if (__STRCMP(OPS_name, (*ProcedureDeclaration__16_s->proc)->name) != 0) { + OPP_err(4); + } + OPS_Get(&OPP_sym); + } else { + OPP_err(38); + } +} + +static void TProcDecl__23 (void) +{ + OPT_Object baseProc = NIL; + OPT_Struct objTyp = NIL, recTyp = NIL; + SHORTINT objMode; + OPS_Name objName; + OPS_Get(&OPP_sym); + *ProcedureDeclaration__16_s->mode = 13; + if (OPP_level > 0) { + OPP_err(73); + } + OPP_Receiver(&objMode, objName, &objTyp, &recTyp); + if (OPP_sym == 38) { + __COPY(OPS_name, *ProcedureDeclaration__16_s->name, ((LONGINT)(256))); + OPP_CheckMark(&*ProcedureDeclaration__16_s->vis); + OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp, &*ProcedureDeclaration__16_s->fwd); + OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp->BaseTyp, &baseProc); + if ((baseProc != NIL && baseProc->mode != 13)) { + baseProc = NIL; + } + if (*ProcedureDeclaration__16_s->fwd == baseProc) { + *ProcedureDeclaration__16_s->fwd = NIL; + } + if ((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mnolev != OPP_level)) { + *ProcedureDeclaration__16_s->fwd = NIL; + } + if ((((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mode == 13)) && !__IN(1, (*ProcedureDeclaration__16_s->fwd)->conval->setval))) { + *ProcedureDeclaration__16_s->proc = OPT_NewObj(); + (*ProcedureDeclaration__16_s->proc)->leaf = 1; + if ((*ProcedureDeclaration__16_s->fwd)->vis != *ProcedureDeclaration__16_s->vis) { + OPP_err(118); + } + } else { + if (*ProcedureDeclaration__16_s->fwd != NIL) { + OPP_err(1); + *ProcedureDeclaration__16_s->fwd = NIL; + } + OPT_OpenScope(0, NIL); + OPT_topScope->right = recTyp->link; + OPT_Insert(*ProcedureDeclaration__16_s->name, &*ProcedureDeclaration__16_s->proc); + recTyp->link = OPT_topScope->right; + OPT_CloseScope(); + } + OPP_level += 1; + OPT_OpenScope(OPP_level, *ProcedureDeclaration__16_s->proc); + OPT_Insert(objName, &(*ProcedureDeclaration__16_s->proc)->link); + (*ProcedureDeclaration__16_s->proc)->link->mode = objMode; + (*ProcedureDeclaration__16_s->proc)->link->typ = objTyp; + GetParams__21(); + if (baseProc != NIL) { + if (objMode != baseProc->link->mode || !OPP_Extends(objTyp, baseProc->link->typ)) { + OPP_err(115); + } + OPB_CheckParameters((*ProcedureDeclaration__16_s->proc)->link->link, baseProc->link->link, 0); + if ((*ProcedureDeclaration__16_s->proc)->typ != baseProc->typ) { + OPP_err(117); + } + if ((((((baseProc->vis == 1 && (*ProcedureDeclaration__16_s->proc)->vis == 0)) && recTyp->strobj != NIL)) && recTyp->strobj->vis == 1)) { + OPP_err(109); + } + (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(2); + } + if (!*ProcedureDeclaration__16_s->forward) { + Body__17(); + } + OPP_level -= 1; + OPT_CloseScope(); + } else { + OPP_err(38); + } +} + +static void OPP_ProcedureDeclaration (OPT_Node *x) +{ + OPT_Object proc = NIL, fwd = NIL; + OPS_Name name; + SHORTINT mode, vis; + BOOLEAN forward; + struct ProcedureDeclaration__16 _s; + _s.x = x; + _s.proc = &proc; + _s.fwd = &fwd; + _s.name = (void*)name; + _s.mode = &mode; + _s.vis = &vis; + _s.forward = &forward; + _s.lnk = ProcedureDeclaration__16_s; + ProcedureDeclaration__16_s = &_s; + proc = NIL; + forward = 0; + *x = NIL; + mode = 6; + if ((OPP_sym != 38 && OPP_sym != 30)) { + if (OPP_sym == 1) { + } else if (OPP_sym == 17) { + forward = 1; + } else if (OPP_sym == 6) { + mode = 10; + } else if (OPP_sym == 7) { + mode = 9; + } else { + OPP_err(38); + } + if ((__IN(mode, 0x0600) && !OPT_SYSimported)) { + OPP_err(135); + } + OPS_Get(&OPP_sym); + } + if (OPP_sym == 30) { + TProcDecl__23(); + } else if (OPP_sym == 38) { + OPT_Find(&fwd); + __COPY(OPS_name, name, ((LONGINT)(256))); + OPP_CheckMark(&vis); + if ((vis != 0 && mode == 6)) { + mode = 7; + } + if ((fwd != NIL && (fwd->mnolev != OPP_level || fwd->mode == 8))) { + fwd = NIL; + } + if ((((fwd != NIL && __IN(fwd->mode, 0xc0))) && !__IN(1, fwd->conval->setval))) { + proc = OPT_NewObj(); + proc->leaf = 1; + if (fwd->vis != vis) { + OPP_err(118); + } + } else { + if (fwd != NIL) { + OPP_err(1); + fwd = NIL; + } + OPT_Insert(name, &proc); + } + if ((mode != 6 && OPP_level > 0)) { + OPP_err(73); + } + OPP_level += 1; + OPT_OpenScope(OPP_level, proc); + proc->link = NIL; + GetParams__21(); + if (mode == 9) { + GetCode__19(); + } else if (!forward) { + Body__17(); + } + OPP_level -= 1; + OPT_CloseScope(); + } else { + OPP_err(38); + } + ProcedureDeclaration__16_s = _s.lnk; +} + +static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab) +{ + OPT_Node x = NIL, y = NIL, lastlab = NIL; + INTEGER i, f; + LONGINT xval, yval; + *lab = NIL; + lastlab = NIL; + for (;;) { + OPP_ConstExpression(&x); + f = x->typ->form; + if (__IN(f, 0x78)) { + xval = x->conval->intval; + } else { + OPP_err(61); + xval = 1; + } + if (__IN(f, 0x70)) { + if (LabelForm < f) { + OPP_err(60); + } + } else if (LabelForm != f) { + OPP_err(60); + } + if (OPP_sym == 21) { + OPS_Get(&OPP_sym); + OPP_ConstExpression(&y); + yval = y->conval->intval; + if (((int)y->typ->form != f && !((__IN(f, 0x70) && __IN(y->typ->form, 0x70))))) { + OPP_err(60); + } + if (yval < xval) { + OPP_err(63); + yval = xval; + } + } else { + yval = xval; + } + x->conval->intval2 = yval; + i = *n; + if (i < 128) { + for (;;) { + if (i == 0) { + break; + } + if (tab[__X(i - 1, ((LONGINT)(128)))].low <= yval) { + if (tab[__X(i - 1, ((LONGINT)(128)))].high >= xval) { + OPP_err(62); + } + break; + } + tab[__X(i, ((LONGINT)(128)))] = tab[__X(i - 1, ((LONGINT)(128)))]; + i -= 1; + } + tab[__X(i, ((LONGINT)(128)))].low = xval; + tab[__X(i, ((LONGINT)(128)))].high = yval; + *n += 1; + } else { + OPP_err(213); + } + OPB_Link(&*lab, &lastlab, x); + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 35 || OPP_sym == 38) { + OPP_err(19); + } else { + break; + } + } +} + +static struct StatSeq__30 { + LONGINT *pos; + struct StatSeq__30 *lnk; +} *StatSeq__30_s; + +static void CasePart__31 (OPT_Node *x); +static void CheckBool__33 (OPT_Node *x); +static void SetPos__35 (OPT_Node x); + +static void CasePart__31 (OPT_Node *x) +{ + INTEGER n; + LONGINT low, high; + BOOLEAN e; + OPP_CaseTable tab; + OPT_Node cases = NIL, lab = NIL, y = NIL, lastcase = NIL; + OPP_Expression(&*x); + *StatSeq__30_s->pos = OPM_errpos; + if ((*x)->class == 8 || (*x)->class == 9) { + OPP_err(126); + } else if (!__IN((*x)->typ->form, 0x78)) { + OPP_err(125); + } + OPP_CheckSym(25); + cases = NIL; + lastcase = NIL; + n = 0; + for (;;) { + if (OPP_sym < 40) { + OPP_CaseLabelList(&lab, (*x)->typ->form, &n, tab); + OPP_CheckSym(20); + OPP_StatSeq(&y); + OPB_Construct(17, &lab, y); + OPB_Link(&cases, &lastcase, lab); + } + if (OPP_sym == 40) { + OPS_Get(&OPP_sym); + } else { + break; + } + } + if (n > 0) { + low = tab[0].low; + high = tab[__X(n - 1, ((LONGINT)(128)))].high; + if (high - low > 512) { + OPP_err(209); + } + } else { + low = 1; + high = 0; + } + e = OPP_sym == 42; + if (e) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&y); + } else { + y = NIL; + OPM_Mark(-307, OPM_curpos); + } + OPB_Construct(16, &cases, y); + OPB_Construct(21, &*x, cases); + cases->conval = OPT_NewConst(); + cases->conval->intval = low; + cases->conval->intval2 = high; + if (e) { + cases->conval->setval = 0x02; + } else { + cases->conval->setval = 0x0; + } +} + +static void SetPos__35 (OPT_Node x) +{ + x->conval = OPT_NewConst(); + x->conval->intval = *StatSeq__30_s->pos; +} + +static void CheckBool__33 (OPT_Node *x) +{ + if ((*x)->class == 8 || (*x)->class == 9) { + OPP_err(126); + *x = OPB_NewBoolConst(0); + } else if ((*x)->typ->form != 2) { + OPP_err(120); + *x = OPB_NewBoolConst(0); + } + *StatSeq__30_s->pos = OPM_errpos; +} + +static void OPP_StatSeq (OPT_Node *stat) +{ + OPT_Object fpar = NIL, id = NIL, t = NIL, obj = NIL; + OPT_Struct idtyp = NIL; + BOOLEAN e; + OPT_Node s = NIL, x = NIL, y = NIL, z = NIL, apar = NIL, last = NIL, lastif = NIL; + LONGINT pos; + OPS_Name name; + struct StatSeq__30 _s; + _s.pos = &pos; + _s.lnk = StatSeq__30_s; + StatSeq__30_s = &_s; + *stat = NIL; + last = NIL; + for (;;) { + x = NIL; + if (OPP_sym < 38) { + OPP_err(14); + do { + OPS_Get(&OPP_sym); + } while (!(OPP_sym >= 38)); + } + if (OPP_sym == 38) { + OPP_qualident(&id); + x = OPB_NewLeaf(id); + OPP_selector(&x); + if (OPP_sym == 34) { + OPS_Get(&OPP_sym); + OPP_Expression(&y); + OPB_Assign(&x, y); + } else if (OPP_sym == 9) { + OPP_err(34); + OPS_Get(&OPP_sym); + OPP_Expression(&y); + OPB_Assign(&x, y); + } else if ((x->class == 9 && x->obj->mode == 8)) { + OPP_StandProcCall(&x); + if ((x != NIL && x->typ != OPT_notyp)) { + OPP_err(55); + } + } else { + OPB_PrepCall(&x, &fpar); + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPP_ActualParameters(&apar, fpar); + OPP_CheckSym(22); + } else { + apar = NIL; + if (fpar != NIL) { + OPP_err(65); + } + } + OPB_Call(&x, apar, fpar); + if (x->typ != OPT_notyp) { + OPP_err(55); + } + if (OPP_level > 0) { + OPT_topScope->link->leaf = 0; + } + } + pos = OPM_errpos; + } else if (OPP_sym == 45) { + OPS_Get(&OPP_sym); + OPP_Expression(&x); + CheckBool__33(&x); + OPP_CheckSym(26); + OPP_StatSeq(&y); + OPB_Construct(15, &x, y); + SetPos__35(x); + lastif = x; + while (OPP_sym == 43) { + OPS_Get(&OPP_sym); + OPP_Expression(&y); + CheckBool__33(&y); + OPP_CheckSym(26); + OPP_StatSeq(&z); + OPB_Construct(15, &y, z); + SetPos__35(y); + OPB_Link(&x, &lastif, y); + } + if (OPP_sym == 42) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&y); + } else { + y = NIL; + } + OPB_Construct(20, &x, y); + OPP_CheckSym(41); + OPB_OptIf(&x); + pos = OPM_errpos; + } else if (OPP_sym == 46) { + OPS_Get(&OPP_sym); + CasePart__31(&x); + OPP_CheckSym(41); + } else if (OPP_sym == 47) { + OPS_Get(&OPP_sym); + OPP_Expression(&x); + CheckBool__33(&x); + OPP_CheckSym(27); + OPP_StatSeq(&y); + OPB_Construct(22, &x, y); + OPP_CheckSym(41); + } else if (OPP_sym == 48) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&x); + if (OPP_sym == 44) { + OPS_Get(&OPP_sym); + OPP_Expression(&y); + CheckBool__33(&y); + } else { + OPP_err(44); + } + OPB_Construct(23, &x, y); + } else if (OPP_sym == 49) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPP_qualident(&id); + if (!__IN(id->typ->form, 0x70)) { + OPP_err(68); + } + OPP_CheckSym(34); + OPP_Expression(&y); + pos = OPM_errpos; + x = OPB_NewLeaf(id); + OPB_Assign(&x, y); + SetPos__35(x); + OPP_CheckSym(28); + OPP_Expression(&y); + pos = OPM_errpos; + if (y->class != 7) { + __MOVE("@@", name, 3); + OPT_Insert(name, &t); + __MOVE("@for", t->name, 5); + t->mode = 1; + t->typ = x->left->typ; + obj = OPT_topScope->scope; + if (obj == NIL) { + OPT_topScope->scope = t; + } else { + while (obj->link != NIL) { + obj = obj->link; + } + obj->link = t; + } + z = OPB_NewLeaf(t); + OPB_Assign(&z, y); + SetPos__35(z); + OPB_Link(&*stat, &last, z); + y = OPB_NewLeaf(t); + } else if (y->typ->form < 4 || y->typ->form > x->left->typ->form) { + OPP_err(113); + } + OPB_Link(&*stat, &last, x); + if (OPP_sym == 29) { + OPS_Get(&OPP_sym); + OPP_ConstExpression(&z); + } else { + z = OPB_NewIntConst(((LONGINT)(1))); + } + pos = OPM_errpos; + x = OPB_NewLeaf(id); + if (z->conval->intval > 0) { + OPB_Op(12, &x, y); + } else if (z->conval->intval < 0) { + OPB_Op(14, &x, y); + } else { + OPP_err(63); + OPB_Op(14, &x, y); + } + OPP_CheckSym(27); + OPP_StatSeq(&s); + y = OPB_NewLeaf(id); + OPB_StPar1(&y, z, 13); + SetPos__35(y); + if (s == NIL) { + s = y; + } else { + z = s; + while (z->link != NIL) { + z = z->link; + } + z->link = y; + } + OPP_CheckSym(41); + OPB_Construct(22, &x, s); + } else { + OPP_err(38); + } + } else if (OPP_sym == 50) { + OPS_Get(&OPP_sym); + OPP_LoopLevel += 1; + OPP_StatSeq(&x); + OPP_LoopLevel -= 1; + OPB_Construct(24, &x, NIL); + OPP_CheckSym(41); + pos = OPM_errpos; + } else if (OPP_sym == 51) { + OPS_Get(&OPP_sym); + idtyp = NIL; + x = NIL; + for (;;) { + if (OPP_sym == 38) { + OPP_qualident(&id); + y = OPB_NewLeaf(id); + if ((((id != NIL && id->typ->form == 13)) && (id->mode == 2 || !id->leaf))) { + OPP_err(245); + } + OPP_CheckSym(20); + if (OPP_sym == 38) { + OPP_qualident(&t); + if (t->mode == 5) { + if (id != NIL) { + idtyp = id->typ; + OPB_TypTest(&y, t, 0); + id->typ = t->typ; + } else { + OPP_err(130); + } + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + } else { + OPP_err(38); + } + pos = OPM_errpos; + OPP_CheckSym(27); + OPP_StatSeq(&s); + OPB_Construct(15, &y, s); + SetPos__35(y); + if (idtyp != NIL) { + id->typ = idtyp; + idtyp = NIL; + } + if (x == NIL) { + x = y; + lastif = x; + } else { + OPB_Link(&x, &lastif, y); + } + if (OPP_sym == 40) { + OPS_Get(&OPP_sym); + } else { + break; + } + } + e = OPP_sym == 42; + if (e) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&s); + } else { + s = NIL; + } + OPB_Construct(27, &x, s); + OPP_CheckSym(41); + if (e) { + x->subcl = 1; + } + } else if (OPP_sym == 52) { + OPS_Get(&OPP_sym); + if (OPP_LoopLevel == 0) { + OPP_err(46); + } + OPB_Construct(25, &x, NIL); + pos = OPM_errpos; + } else if (OPP_sym == 53) { + OPS_Get(&OPP_sym); + if (OPP_sym < 39) { + OPP_Expression(&x); + } + if (OPP_level > 0) { + OPB_Return(&x, OPT_topScope->link); + } else { + OPB_Return(&x, NIL); + } + pos = OPM_errpos; + } + if (x != NIL) { + SetPos__35(x); + OPB_Link(&*stat, &last, x); + } + if (OPP_sym == 39) { + OPS_Get(&OPP_sym); + } else if (OPP_sym <= 38 || (45 <= OPP_sym && OPP_sym <= 53)) { + OPP_err(39); + } else { + break; + } + } + StatSeq__30_s = _s.lnk; +} + +static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq) +{ + OPT_Struct typ = NIL; + OPT_Object obj = NIL, first = NIL, last = NIL; + OPT_Node x = NIL, lastdec = NIL; + INTEGER i; + first = NIL; + last = NIL; + OPP_nofFwdPtr = 0; + for (;;) { + if (OPP_sym == 58) { + OPS_Get(&OPP_sym); + while (OPP_sym == 38) { + OPT_Insert(OPS_name, &obj); + OPP_CheckMark(&obj->vis); + obj->typ = OPT_sinttyp; + obj->mode = 1; + if (OPP_sym == 9) { + OPS_Get(&OPP_sym); + OPP_ConstExpression(&x); + } else if (OPP_sym == 34) { + OPP_err(9); + OPS_Get(&OPP_sym); + OPP_ConstExpression(&x); + } else { + OPP_err(9); + x = OPB_NewIntConst(((LONGINT)(1))); + } + obj->mode = 3; + obj->typ = x->typ; + obj->conval = x->conval; + OPP_CheckSym(39); + } + } + if (OPP_sym == 59) { + OPS_Get(&OPP_sym); + while (OPP_sym == 38) { + OPT_Insert(OPS_name, &obj); + obj->mode = 5; + obj->typ = OPT_undftyp; + OPP_CheckMark(&obj->vis); + if (OPP_sym == 9) { + OPS_Get(&OPP_sym); + OPP_TypeDecl(&obj->typ, &obj->typ); + } else if (OPP_sym == 34 || OPP_sym == 20) { + OPP_err(9); + OPS_Get(&OPP_sym); + OPP_TypeDecl(&obj->typ, &obj->typ); + } else { + OPP_err(9); + } + if (obj->typ->strobj == NIL) { + obj->typ->strobj = obj; + } + if (__IN(obj->typ->comp, 0x1c)) { + i = 0; + while (i < OPP_nofFwdPtr) { + typ = OPP_FwdPtr[__X(i, ((LONGINT)(64)))]; + i += 1; + if (__STRCMP(typ->link->name, obj->name) == 0) { + typ->BaseTyp = obj->typ; + typ->link->name[0] = 0x00; + } + } + } + OPP_CheckSym(39); + } + } + if (OPP_sym == 60) { + OPS_Get(&OPP_sym); + while (OPP_sym == 38) { + for (;;) { + if (OPP_sym == 38) { + OPT_Insert(OPS_name, &obj); + OPP_CheckMark(&obj->vis); + obj->mode = 1; + obj->link = NIL; + obj->leaf = obj->vis == 0; + obj->typ = OPT_undftyp; + if (first == NIL) { + first = obj; + } + if (last == NIL) { + OPT_topScope->scope = obj; + } else { + last->link = obj; + } + last = obj; + } else { + OPP_err(38); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(19); + } else { + break; + } + } + OPP_CheckSym(20); + OPP_Type(&typ, &OPT_notyp); + typ->pvused = 1; + if (typ->comp == 3) { + typ = OPT_undftyp; + OPP_err(88); + } + while (first != NIL) { + first->typ = typ; + first = first->link; + } + OPP_CheckSym(39); + } + } + if (OPP_sym < 58 || OPP_sym > 60) { + break; + } + } + i = 0; + while (i < OPP_nofFwdPtr) { + if (OPP_FwdPtr[__X(i, ((LONGINT)(64)))]->link->name[0] != 0x00) { + OPP_err(128); + } + OPP_FwdPtr[__X(i, ((LONGINT)(64)))] = NIL; + i += 1; + } + OPT_topScope->adr = OPM_errpos; + *procdec = NIL; + lastdec = NIL; + while (OPP_sym == 61) { + OPS_Get(&OPP_sym); + OPP_ProcedureDeclaration(&x); + if (x != NIL) { + if (lastdec == NIL) { + *procdec = x; + } else { + lastdec->link = x; + } + lastdec = x; + } + OPP_CheckSym(39); + } + if (OPP_sym == 57) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&*statseq); + } else { + *statseq = NIL; + } + if ((OPP_level == 0 && OPP_TDinit != NIL)) { + OPP_lastTDinit->link = *statseq; + *statseq = OPP_TDinit; + } + OPP_CheckSym(41); +} + +void OPP_Module (OPT_Node *prog, SET opt) +{ + OPS_Name impName, aliasName; + OPT_Node procdec = NIL, statseq = NIL; + LONGINT c; + BOOLEAN done; + OPS_Init(); + OPP_LoopLevel = 0; + OPP_level = 0; + OPS_Get(&OPP_sym); + if (OPP_sym == 63) { + OPS_Get(&OPP_sym); + } else { + OPP_err(16); + } + if (OPP_sym == 38) { + OPM_LogWStr((CHAR*)"compiling ", (LONGINT)11); + OPM_LogWStr(OPS_name, ((LONGINT)(256))); + OPM_LogW('.'); + OPT_Init(OPS_name, opt); + OPS_Get(&OPP_sym); + OPP_CheckSym(39); + if (OPP_sym == 62) { + OPS_Get(&OPP_sym); + for (;;) { + if (OPP_sym == 38) { + __COPY(OPS_name, aliasName, ((LONGINT)(256))); + __COPY(aliasName, impName, ((LONGINT)(256))); + OPS_Get(&OPP_sym); + if (OPP_sym == 34) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + __COPY(OPS_name, impName, ((LONGINT)(256))); + OPS_Get(&OPP_sym); + } else { + OPP_err(38); + } + } + OPT_Import(aliasName, impName, &done); + } else { + OPP_err(38); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(19); + } else { + break; + } + } + OPP_CheckSym(39); + } + if (OPM_noerr) { + OPP_TDinit = NIL; + OPP_lastTDinit = NIL; + c = OPM_errpos; + OPP_Block(&procdec, &statseq); + OPB_Enter(&procdec, statseq, NIL); + *prog = procdec; + (*prog)->conval = OPT_NewConst(); + (*prog)->conval->intval = c; + if (OPP_sym == 38) { + if (__STRCMP(OPS_name, OPT_SelfName) != 0) { + OPP_err(4); + } + OPS_Get(&OPP_sym); + } else { + OPP_err(38); + } + if (OPP_sym != 18) { + OPP_err(18); + } + } + } else { + OPP_err(38); + } + OPP_TDinit = NIL; + OPP_lastTDinit = NIL; +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(OPP_TDinit); + P(OPP_lastTDinit); + __ENUMP(OPP_FwdPtr, 64, P); +} + +__TDESC(OPP__1, 1, 0) = {__TDFLDS("", 8), {-4}}; + +export void *OPP__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPB); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPS); + __MODULE_IMPORT(OPT); + __REGMOD("OPP", EnumPtrs); + __INITYP(OPP__1, OPP__1, 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-48/OPP.h b/bootstrap/unix-48/OPP.h new file mode 100644 index 00000000..1e0a1809 --- /dev/null +++ b/bootstrap/unix-48/OPP.h @@ -0,0 +1,16 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPP__h +#define OPP__h + +#include "SYSTEM.h" +#include "OPT.h" + + + + +import void OPP_Module (OPT_Node *prog, SET opt); +import void *OPP__init(void); + + +#endif diff --git a/bootstrap/unix-48/OPS.c b/bootstrap/unix-48/OPS.c new file mode 100644 index 00000000..88944148 --- /dev/null +++ b/bootstrap/unix-48/OPS.c @@ -0,0 +1,623 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tspkaSfF */ +#include "SYSTEM.h" +#include "OPM.h" + +typedef + CHAR OPS_Name[256]; + +typedef + CHAR OPS_String[256]; + + +export OPS_Name OPS_name; +export OPS_String OPS_str; +export INTEGER OPS_numtyp; +export LONGINT OPS_intval; +export REAL OPS_realval; +export LONGREAL OPS_lrlval; +static CHAR OPS_ch; + + +export void OPS_Get (SHORTINT *sym); +static void OPS_Identifier (SHORTINT *sym); +export void OPS_Init (void); +static void OPS_Number (void); +static void OPS_Str (SHORTINT *sym); +static void OPS_err (INTEGER n); + + +static void OPS_err (INTEGER n) +{ + OPM_err(n); +} + +static void OPS_Str (SHORTINT *sym) +{ + INTEGER i; + CHAR och; + i = 0; + och = OPS_ch; + for (;;) { + OPM_Get(&OPS_ch); + if (OPS_ch == och) { + break; + } + if (OPS_ch < ' ') { + OPS_err(3); + break; + } + if (i == 255) { + OPS_err(241); + break; + } + OPS_str[i] = OPS_ch; + i += 1; + } + OPM_Get(&OPS_ch); + OPS_str[i] = 0x00; + OPS_intval = i + 1; + if (OPS_intval == 2) { + *sym = 35; + OPS_numtyp = 1; + OPS_intval = (int)OPS_str[0]; + } else { + *sym = 37; + } +} + +static void OPS_Identifier (SHORTINT *sym) +{ + INTEGER i; + i = 0; + do { + OPS_name[i] = OPS_ch; + i += 1; + OPM_Get(&OPS_ch); + } while (!(((OPS_ch < '0' || ('9' < OPS_ch && __CAP(OPS_ch) < 'A')) || 'Z' < __CAP(OPS_ch)) || i == 256)); + if (i == 256) { + OPS_err(240); + i -= 1; + } + OPS_name[i] = 0x00; + *sym = 38; +} + +static struct Number__6 { + struct Number__6 *lnk; +} *Number__6_s; + +static INTEGER Ord__7 (CHAR ch, BOOLEAN hex); +static LONGREAL Ten__9 (INTEGER e); + +static LONGREAL Ten__9 (INTEGER e) +{ + LONGREAL _o_result; + LONGREAL x, p; + x = (LONGREAL)1; + p = (LONGREAL)10; + while (e > 0) { + if (__ODD(e)) { + x = x * p; + } + e = __ASHR(e, 1); + if (e > 0) { + p = p * p; + } + } + _o_result = x; + return _o_result; +} + +static INTEGER Ord__7 (CHAR ch, BOOLEAN hex) +{ + INTEGER _o_result; + if (ch <= '9') { + _o_result = (int)ch - 48; + return _o_result; + } else if (hex) { + _o_result = ((int)ch - 65) + 10; + return _o_result; + } else { + OPS_err(2); + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +static void OPS_Number (void) +{ + INTEGER i, m, n, d, e; + CHAR dig[24]; + LONGREAL f; + CHAR expCh; + BOOLEAN neg; + struct Number__6 _s; + _s.lnk = Number__6_s; + Number__6_s = &_s; + i = 0; + m = 0; + n = 0; + d = 0; + for (;;) { + if (('0' <= OPS_ch && OPS_ch <= '9') || (((d == 0 && 'A' <= OPS_ch)) && OPS_ch <= 'F')) { + if (m > 0 || OPS_ch != '0') { + if (n < 24) { + dig[n] = OPS_ch; + n += 1; + } + m += 1; + } + OPM_Get(&OPS_ch); + i += 1; + } else if (OPS_ch == '.') { + OPM_Get(&OPS_ch); + if (OPS_ch == '.') { + OPS_ch = 0x7f; + break; + } else if (d == 0) { + d = i; + } else { + OPS_err(2); + } + } else { + break; + } + } + if (d == 0) { + if (n == m) { + OPS_intval = 0; + i = 0; + if (OPS_ch == 'X') { + OPM_Get(&OPS_ch); + OPS_numtyp = 1; + if (n <= 2) { + while (i < n) { + OPS_intval = __ASHL(OPS_intval, 4) + (LONGINT)Ord__7(dig[i], 1); + i += 1; + } + } else { + OPS_err(203); + } + } else if (OPS_ch == 'H') { + OPM_Get(&OPS_ch); + OPS_numtyp = 2; + if (n <= 8) { + if ((n == 8 && dig[0] > '7')) { + OPS_intval = -1; + } + while (i < n) { + OPS_intval = __ASHL(OPS_intval, 4) + (LONGINT)Ord__7(dig[i], 1); + i += 1; + } + } else { + OPS_err(203); + } + } else { + OPS_numtyp = 2; + while (i < n) { + d = Ord__7(dig[i], 0); + i += 1; + if (OPS_intval <= __DIV(2147483647 - (LONGINT)d, 10)) { + OPS_intval = OPS_intval * 10 + (LONGINT)d; + } else { + OPS_err(203); + } + } + } + } else { + OPS_err(203); + } + } else { + f = (LONGREAL)0; + e = 0; + expCh = 'E'; + while (n > 0) { + n -= 1; + f = (Ord__7(dig[n], 0) + f) / (LONGREAL)(LONGREAL)10; + } + if (OPS_ch == 'E' || OPS_ch == 'D') { + expCh = OPS_ch; + OPM_Get(&OPS_ch); + neg = 0; + if (OPS_ch == '-') { + neg = 1; + OPM_Get(&OPS_ch); + } else if (OPS_ch == '+') { + OPM_Get(&OPS_ch); + } + if (('0' <= OPS_ch && OPS_ch <= '9')) { + do { + n = Ord__7(OPS_ch, 0); + OPM_Get(&OPS_ch); + if (e <= __DIV(32767 - n, 10)) { + e = e * 10 + n; + } else { + OPS_err(203); + } + } while (!(OPS_ch < '0' || '9' < OPS_ch)); + if (neg) { + e = -e; + } + } else { + OPS_err(2); + } + } + e -= (i - d) - m; + if (expCh == 'E') { + OPS_numtyp = 3; + if ((-37 < e && e <= 38)) { + if (e < 0) { + OPS_realval = (f / (LONGREAL)Ten__9(-e)); + } else { + OPS_realval = (f * Ten__9(e)); + } + } else { + OPS_err(203); + } + } else { + OPS_numtyp = 4; + if ((-307 < e && e <= 308)) { + if (e < 0) { + OPS_lrlval = f / (LONGREAL)Ten__9(-e); + } else { + OPS_lrlval = f * Ten__9(e); + } + } else { + OPS_err(203); + } + } + } + Number__6_s = _s.lnk; +} + +static struct Get__1 { + struct Get__1 *lnk; +} *Get__1_s; + +static void Comment__2 (void); + +static void Comment__2 (void) +{ + OPM_Get(&OPS_ch); + for (;;) { + for (;;) { + while (OPS_ch == '(') { + OPM_Get(&OPS_ch); + if (OPS_ch == '*') { + Comment__2(); + } + } + if (OPS_ch == '*') { + OPM_Get(&OPS_ch); + break; + } + if (OPS_ch == 0x00) { + break; + } + OPM_Get(&OPS_ch); + } + if (OPS_ch == ')') { + OPM_Get(&OPS_ch); + break; + } + if (OPS_ch == 0x00) { + OPS_err(5); + break; + } + } +} + +void OPS_Get (SHORTINT *sym) +{ + SHORTINT s; + struct Get__1 _s; + _s.lnk = Get__1_s; + Get__1_s = &_s; + OPM_errpos = OPM_curpos - 1; + while (OPS_ch <= ' ') { + if (OPS_ch == 0x00) { + *sym = 64; + return; + } else { + OPM_Get(&OPS_ch); + } + } + switch (OPS_ch) { + case '\"': case '\'': + OPS_Str(&s); + break; + case '#': + s = 10; + OPM_Get(&OPS_ch); + break; + case '&': + s = 5; + OPM_Get(&OPS_ch); + break; + case '(': + OPM_Get(&OPS_ch); + if (OPS_ch == '*') { + Comment__2(); + OPS_Get(&s); + } else { + s = 30; + } + break; + case ')': + s = 22; + OPM_Get(&OPS_ch); + break; + case '*': + s = 1; + OPM_Get(&OPS_ch); + break; + case '+': + s = 6; + OPM_Get(&OPS_ch); + break; + case ',': + s = 19; + OPM_Get(&OPS_ch); + break; + case '-': + s = 7; + OPM_Get(&OPS_ch); + break; + case '.': + OPM_Get(&OPS_ch); + if (OPS_ch == '.') { + OPM_Get(&OPS_ch); + s = 21; + } else { + s = 18; + } + break; + case '/': + s = 2; + OPM_Get(&OPS_ch); + break; + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + OPS_Number(); + s = 35; + break; + case ':': + OPM_Get(&OPS_ch); + if (OPS_ch == '=') { + OPM_Get(&OPS_ch); + s = 34; + } else { + s = 20; + } + break; + case ';': + s = 39; + OPM_Get(&OPS_ch); + break; + case '<': + OPM_Get(&OPS_ch); + if (OPS_ch == '=') { + OPM_Get(&OPS_ch); + s = 12; + } else { + s = 11; + } + break; + case '=': + s = 9; + OPM_Get(&OPS_ch); + break; + case '>': + OPM_Get(&OPS_ch); + if (OPS_ch == '=') { + OPM_Get(&OPS_ch); + s = 14; + } else { + s = 13; + } + break; + case 'A': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "ARRAY") == 0) { + s = 54; + } + break; + case 'B': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "BEGIN") == 0) { + s = 57; + } else if (__STRCMP(OPS_name, "BY") == 0) { + s = 29; + } + break; + case 'C': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "CASE") == 0) { + s = 46; + } else if (__STRCMP(OPS_name, "CONST") == 0) { + s = 58; + } + break; + case 'D': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "DO") == 0) { + s = 27; + } else if (__STRCMP(OPS_name, "DIV") == 0) { + s = 3; + } + break; + case 'E': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "END") == 0) { + s = 41; + } else if (__STRCMP(OPS_name, "ELSE") == 0) { + s = 42; + } else if (__STRCMP(OPS_name, "ELSIF") == 0) { + s = 43; + } else if (__STRCMP(OPS_name, "EXIT") == 0) { + s = 52; + } + break; + case 'F': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "FOR") == 0) { + s = 49; + } + break; + case 'I': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "IF") == 0) { + s = 45; + } else if (__STRCMP(OPS_name, "IN") == 0) { + s = 15; + } else if (__STRCMP(OPS_name, "IS") == 0) { + s = 16; + } else if (__STRCMP(OPS_name, "IMPORT") == 0) { + s = 62; + } + break; + case 'L': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "LOOP") == 0) { + s = 50; + } + break; + case 'M': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "MOD") == 0) { + s = 4; + } else if (__STRCMP(OPS_name, "MODULE") == 0) { + s = 63; + } + break; + case 'N': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "NIL") == 0) { + s = 36; + } + break; + case 'O': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "OR") == 0) { + s = 8; + } else if (__STRCMP(OPS_name, "OF") == 0) { + s = 25; + } + break; + case 'P': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "PROCEDURE") == 0) { + s = 61; + } else if (__STRCMP(OPS_name, "POINTER") == 0) { + s = 56; + } + break; + case 'R': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "RECORD") == 0) { + s = 55; + } else if (__STRCMP(OPS_name, "REPEAT") == 0) { + s = 48; + } else if (__STRCMP(OPS_name, "RETURN") == 0) { + s = 53; + } + break; + case 'T': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "THEN") == 0) { + s = 26; + } else if (__STRCMP(OPS_name, "TO") == 0) { + s = 28; + } else if (__STRCMP(OPS_name, "TYPE") == 0) { + s = 59; + } + break; + case 'U': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "UNTIL") == 0) { + s = 44; + } + break; + case 'V': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "VAR") == 0) { + s = 60; + } + break; + case 'W': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "WHILE") == 0) { + s = 47; + } else if (__STRCMP(OPS_name, "WITH") == 0) { + s = 51; + } + break; + case 'G': case 'H': case 'J': case 'K': case 'Q': + case 'S': case 'X': case 'Y': case 'Z': + OPS_Identifier(&s); + break; + case '[': + s = 31; + OPM_Get(&OPS_ch); + break; + case ']': + s = 23; + OPM_Get(&OPS_ch); + break; + case '^': + s = 17; + OPM_Get(&OPS_ch); + break; + case 'a': case 'b': case 'c': case 'd': case 'e': + case 'f': case 'g': case 'h': case 'i': case 'j': + case 'k': case 'l': case 'm': case 'n': case 'o': + case 'p': case 'q': case 'r': case 's': case 't': + case 'u': case 'v': case 'w': case 'x': case 'y': + case 'z': + OPS_Identifier(&s); + break; + case '{': + s = 32; + OPM_Get(&OPS_ch); + break; + case '|': + s = 40; + OPM_Get(&OPS_ch); + break; + case '}': + s = 24; + OPM_Get(&OPS_ch); + break; + case '~': + s = 33; + OPM_Get(&OPS_ch); + break; + case 0x7f: + s = 21; + OPM_Get(&OPS_ch); + break; + default: + s = 0; + OPM_Get(&OPS_ch); + break; + } + *sym = s; + Get__1_s = _s.lnk; +} + +void OPS_Init (void) +{ + OPS_ch = ' '; +} + + +export void *OPS__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPM); + __REGMOD("OPS", 0); + __REGCMD("Init", OPS_Init); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-48/OPS.h b/bootstrap/unix-48/OPS.h new file mode 100644 index 00000000..87a614f4 --- /dev/null +++ b/bootstrap/unix-48/OPS.h @@ -0,0 +1,28 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tspkaSfF */ + +#ifndef OPS__h +#define OPS__h + +#include "SYSTEM.h" + +typedef + CHAR OPS_Name[256]; + +typedef + CHAR OPS_String[256]; + + +import OPS_Name OPS_name; +import OPS_String OPS_str; +import INTEGER OPS_numtyp; +import LONGINT OPS_intval; +import REAL OPS_realval; +import LONGREAL OPS_lrlval; + + +import void OPS_Get (SHORTINT *sym); +import void OPS_Init (void); +import void *OPS__init(void); + + +#endif diff --git a/bootstrap/unix-48/OPT.c b/bootstrap/unix-48/OPT.c new file mode 100644 index 00000000..fc80ce02 --- /dev/null +++ b/bootstrap/unix-48/OPT.c @@ -0,0 +1,1858 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "OPM.h" +#include "OPS.h" + +typedef + struct OPT_ConstDesc *OPT_Const; + +typedef + OPS_String *OPT_ConstExt; + +typedef + struct OPT_ConstDesc { + OPT_ConstExt ext; + LONGINT intval, intval2; + SET setval; + LONGREAL realval; + } OPT_ConstDesc; + +typedef + struct OPT_ExpCtxt { + LONGINT reffp; + INTEGER ref; + SHORTINT nofm; + SHORTINT locmno[64]; + } OPT_ExpCtxt; + +typedef + struct OPT_StrDesc *OPT_Struct; + +typedef + struct OPT_ObjDesc *OPT_Object; + +typedef + struct OPT_ImpCtxt { + LONGINT nextTag, reffp; + INTEGER nofr, minr, nofm; + BOOLEAN self; + OPT_Struct ref[255]; + OPT_Object old[255]; + LONGINT pvfp[255]; + SHORTINT glbmno[64]; + } OPT_ImpCtxt; + +typedef + struct OPT_NodeDesc *OPT_Node; + +typedef + struct OPT_NodeDesc { + OPT_Node left, right, link; + SHORTINT class, subcl; + BOOLEAN readonly; + OPT_Struct typ; + OPT_Object obj; + OPT_Const conval; + } OPT_NodeDesc; + +typedef + struct OPT_ObjDesc { + OPT_Object left, right, link, scope; + OPS_Name name; + BOOLEAN leaf; + SHORTINT mode, mnolev, vis, history; + BOOLEAN used, fpdone; + LONGINT fprint; + OPT_Struct typ; + OPT_Const conval; + LONGINT adr, linkadr; + INTEGER x; + } OPT_ObjDesc; + +typedef + struct OPT_StrDesc { + SHORTINT form, comp, mno, extlev; + INTEGER ref, sysflag; + LONGINT n, size, align, txtpos; + BOOLEAN allocated, pbused, pvused, fpdone, idfpdone; + LONGINT idfp, pbfp, pvfp; + OPT_Struct BaseTyp; + OPT_Object link, strobj; + } OPT_StrDesc; + + +export void (*OPT_typSize)(OPT_Struct); +export OPT_Object OPT_topScope; +export OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp; +export SHORTINT OPT_nofGmod; +export OPT_Object OPT_GlbMod[64]; +export OPS_Name OPT_SelfName; +export BOOLEAN OPT_SYSimported; +static OPT_Object OPT_universe, OPT_syslink; +static OPT_ImpCtxt OPT_impCtxt; +static OPT_ExpCtxt OPT_expCtxt; +static LONGINT OPT_nofhdfld; +static BOOLEAN OPT_newsf, OPT_findpc, OPT_extsf, OPT_sfpresent, OPT_symExtended, OPT_symNew; + +export LONGINT *OPT_ConstDesc__typ; +export LONGINT *OPT_ObjDesc__typ; +export LONGINT *OPT_StrDesc__typ; +export LONGINT *OPT_NodeDesc__typ; +export LONGINT *OPT_ImpCtxt__typ; +export LONGINT *OPT_ExpCtxt__typ; + +export void OPT_Close (void); +export void OPT_CloseScope (void); +static void OPT_DebugStruct (OPT_Struct btyp); +static void OPT_EnterBoolConst (OPS_Name name, LONGINT value); +static void OPT_EnterProc (OPS_Name name, INTEGER num); +static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res); +export void OPT_Export (BOOLEAN *ext, BOOLEAN *new); +export void OPT_FPrintErr (OPT_Object obj, INTEGER errcode); +static void OPT_FPrintName (LONGINT *fp, CHAR *name, LONGINT name__len); +export void OPT_FPrintObj (OPT_Object obj); +static void OPT_FPrintSign (LONGINT *fp, OPT_Struct result, OPT_Object par); +export void OPT_FPrintStr (OPT_Struct typ); +export void OPT_Find (OPT_Object *res); +export void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res); +export void OPT_FindImport (OPT_Object mod, OPT_Object *res); +export void OPT_IdFPrint (OPT_Struct typ); +export void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done); +static void OPT_InConstant (LONGINT f, OPT_Const conval); +static OPT_Object OPT_InFld (void); +static void OPT_InMod (SHORTINT *mno); +static void OPT_InName (CHAR *name, LONGINT name__len); +static OPT_Object OPT_InObj (SHORTINT mno); +static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par); +static void OPT_InStruct (OPT_Struct *typ); +static OPT_Object OPT_InTProc (SHORTINT mno); +export void OPT_Init (OPS_Name name, SET opt); +static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form); +export void OPT_Insert (OPS_Name name, OPT_Object *obj); +export void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old); +export OPT_Const OPT_NewConst (void); +export OPT_ConstExt OPT_NewExt (void); +export OPT_Node OPT_NewNode (SHORTINT class); +export OPT_Object OPT_NewObj (void); +export OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp); +export void OPT_OpenScope (SHORTINT level, OPT_Object owner); +static void OPT_OutConstant (OPT_Object obj); +static void OPT_OutFlds (OPT_Object fld, LONGINT adr, BOOLEAN visible); +static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr); +static void OPT_OutMod (INTEGER mno); +static void OPT_OutName (CHAR *name, LONGINT name__len); +static void OPT_OutObj (OPT_Object obj); +static void OPT_OutSign (OPT_Struct result, OPT_Object par); +static void OPT_OutStr (OPT_Struct typ); +static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj); +static void OPT_err (INTEGER n); + + +static void OPT_err (INTEGER n) +{ + OPM_err(n); +} + +OPT_Const OPT_NewConst (void) +{ + OPT_Const _o_result; + OPT_Const const_ = NIL; + __NEW(const_, OPT_ConstDesc); + _o_result = const_; + return _o_result; +} + +OPT_Object OPT_NewObj (void) +{ + OPT_Object _o_result; + OPT_Object obj = NIL; + __NEW(obj, OPT_ObjDesc); + _o_result = obj; + return _o_result; +} + +OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp) +{ + OPT_Struct _o_result; + OPT_Struct typ = NIL; + __NEW(typ, OPT_StrDesc); + typ->form = form; + typ->comp = comp; + typ->ref = 255; + if (form != 0) { + typ->txtpos = OPM_errpos; + } + typ->size = -1; + typ->BaseTyp = OPT_undftyp; + _o_result = typ; + return _o_result; +} + +OPT_Node OPT_NewNode (SHORTINT class) +{ + OPT_Node _o_result; + OPT_Node node = NIL; + __NEW(node, OPT_NodeDesc); + node->class = class; + _o_result = node; + return _o_result; +} + +OPT_ConstExt OPT_NewExt (void) +{ + OPT_ConstExt _o_result; + OPT_ConstExt ext = NIL; + ext = __NEWARR(NIL, ((LONGINT)(1)), 1, 1, 0, (LONGINT)256); + _o_result = ext; + return _o_result; +} + +void OPT_OpenScope (SHORTINT level, OPT_Object owner) +{ + OPT_Object head = NIL; + head = OPT_NewObj(); + head->mode = 12; + head->mnolev = level; + head->link = owner; + if (owner != NIL) { + owner->scope = head; + } + head->left = OPT_topScope; + head->right = NIL; + head->scope = NIL; + OPT_topScope = head; +} + +void OPT_CloseScope (void) +{ + OPT_topScope = OPT_topScope->left; +} + +void OPT_Init (OPS_Name name, SET opt) +{ + OPT_topScope = OPT_universe; + OPT_OpenScope(0, NIL); + OPT_SYSimported = 0; + __COPY(name, OPT_SelfName, ((LONGINT)(256))); + __COPY(name, OPT_topScope->name, ((LONGINT)(256))); + OPT_GlbMod[0] = OPT_topScope; + OPT_nofGmod = 1; + OPT_newsf = __IN(4, opt); + OPT_findpc = __IN(8, opt); + OPT_extsf = OPT_newsf || __IN(9, opt); + OPT_sfpresent = 1; +} + +void OPT_Close (void) +{ + INTEGER i; + OPT_CloseScope(); + i = 0; + while (i < 64) { + OPT_GlbMod[__X(i, ((LONGINT)(64)))] = NIL; + i += 1; + } + i = 16; + while (i < 255) { + OPT_impCtxt.ref[__X(i, ((LONGINT)(255)))] = NIL; + OPT_impCtxt.old[__X(i, ((LONGINT)(255)))] = NIL; + i += 1; + } +} + +void OPT_FindImport (OPT_Object mod, OPT_Object *res) +{ + OPT_Object obj = NIL; + obj = mod->scope; + for (;;) { + if (obj == NIL) { + break; + } + if (__STRCMP(OPS_name, obj->name) < 0) { + obj = obj->left; + } else if (__STRCMP(OPS_name, obj->name) > 0) { + obj = obj->right; + } else { + if ((obj->mode == 5 && obj->vis == 0)) { + obj = NIL; + } else { + obj->used = 1; + } + break; + } + } + *res = obj; +} + +void OPT_Find (OPT_Object *res) +{ + OPT_Object obj = NIL, head = NIL; + head = OPT_topScope; + for (;;) { + obj = head->right; + for (;;) { + if (obj == NIL) { + break; + } + if (__STRCMP(OPS_name, obj->name) < 0) { + obj = obj->left; + } else if (__STRCMP(OPS_name, obj->name) > 0) { + obj = obj->right; + } else { + break; + } + } + if (obj != NIL) { + break; + } + head = head->left; + if (head == NIL) { + break; + } + } + *res = obj; +} + +void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res) +{ + OPT_Object obj = NIL; + while (typ != NIL) { + obj = typ->link; + while (obj != NIL) { + if (__STRCMP(name, obj->name) < 0) { + obj = obj->left; + } else if (__STRCMP(name, obj->name) > 0) { + obj = obj->right; + } else { + *res = obj; + return; + } + } + typ = typ->BaseTyp; + } + *res = NIL; +} + +void OPT_Insert (OPS_Name name, OPT_Object *obj) +{ + OPT_Object ob0 = NIL, ob1 = NIL; + BOOLEAN left; + SHORTINT mnolev; + ob0 = OPT_topScope; + ob1 = ob0->right; + left = 0; + for (;;) { + if (ob1 != NIL) { + if (__STRCMP(name, ob1->name) < 0) { + ob0 = ob1; + ob1 = ob0->left; + left = 1; + } else if (__STRCMP(name, ob1->name) > 0) { + ob0 = ob1; + ob1 = ob0->right; + left = 0; + } else { + OPT_err(1); + ob0 = ob1; + ob1 = ob0->right; + } + } else { + ob1 = OPT_NewObj(); + ob1->leaf = 1; + if (left) { + ob0->left = ob1; + } else { + ob0->right = ob1; + } + ob1->left = NIL; + ob1->right = NIL; + __COPY(name, ob1->name, ((LONGINT)(256))); + mnolev = OPT_topScope->mnolev; + ob1->mnolev = mnolev; + break; + } + } + *obj = ob1; +} + +static void OPT_FPrintName (LONGINT *fp, CHAR *name, LONGINT name__len) +{ + INTEGER i; + CHAR ch; + i = 0; + do { + ch = name[__X(i, name__len)]; + OPM_FPrint(&*fp, (int)ch); + i += 1; + } while (!(ch == 0x00)); +} + +static void OPT_DebugStruct (OPT_Struct btyp) +{ + OPM_LogWLn(); + if (btyp == NIL) { + OPM_LogWStr((CHAR*)"btyp is nil", (LONGINT)12); + OPM_LogWLn(); + } + OPM_LogWStr((CHAR*)"btyp^.strobji^.name = ", (LONGINT)23); + OPM_LogWStr(btyp->strobj->name, ((LONGINT)(256))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.form = ", (LONGINT)14); + OPM_LogWNum(btyp->form, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.comp = ", (LONGINT)14); + OPM_LogWNum(btyp->comp, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.mno = ", (LONGINT)13); + OPM_LogWNum(btyp->mno, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.extlev = ", (LONGINT)16); + OPM_LogWNum(btyp->extlev, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.size = ", (LONGINT)14); + OPM_LogWNum(btyp->size, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.align = ", (LONGINT)15); + OPM_LogWNum(btyp->align, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.txtpos = ", (LONGINT)16); + OPM_LogWNum(btyp->txtpos, ((LONGINT)(0))); + OPM_LogWLn(); +} + +static void OPT_FPrintSign (LONGINT *fp, OPT_Struct result, OPT_Object par) +{ + OPT_IdFPrint(result); + OPM_FPrint(&*fp, result->idfp); + while (par != NIL) { + OPM_FPrint(&*fp, par->mode); + OPT_IdFPrint(par->typ); + OPM_FPrint(&*fp, par->typ->idfp); + par = par->link; + } +} + +void OPT_IdFPrint (OPT_Struct typ) +{ + OPT_Struct btyp = NIL; + OPT_Object strobj = NIL; + LONGINT idfp; + INTEGER f, c; + if (!typ->idfpdone) { + typ->idfpdone = 1; + idfp = 0; + f = typ->form; + c = typ->comp; + OPM_FPrint(&idfp, f); + OPM_FPrint(&idfp, c); + btyp = typ->BaseTyp; + strobj = typ->strobj; + if ((strobj != NIL && strobj->name[0] != 0x00)) { + OPT_FPrintName(&idfp, (void*)OPT_GlbMod[__X(typ->mno, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + OPT_FPrintName(&idfp, (void*)strobj->name, ((LONGINT)(256))); + } + if ((f == 13 || (c == 4 && btyp != NIL)) || c == 3) { + OPT_IdFPrint(btyp); + OPM_FPrint(&idfp, btyp->idfp); + } else if (c == 2) { + OPT_IdFPrint(btyp); + OPM_FPrint(&idfp, btyp->idfp); + OPM_FPrint(&idfp, typ->n); + } else if (f == 14) { + OPT_FPrintSign(&idfp, btyp, typ->link); + } + typ->idfp = idfp; + } +} + +static struct FPrintStr__12 { + LONGINT *pbfp, *pvfp; + struct FPrintStr__12 *lnk; +} *FPrintStr__12_s; + +static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible); +static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr); +static void FPrintTProcs__17 (OPT_Object obj); + +static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr) +{ + LONGINT i, j, n; + OPT_Struct btyp = NIL; + if (typ->comp == 4) { + FPrintFlds__13(typ->link, adr, 0); + } else if (typ->comp == 2) { + btyp = typ->BaseTyp; + n = typ->n; + while (btyp->comp == 2) { + n = btyp->n * n; + btyp = btyp->BaseTyp; + } + if (btyp->form == 13 || btyp->comp == 4) { + j = OPT_nofhdfld; + FPrintHdFld__15(btyp, fld, adr); + if (j != OPT_nofhdfld) { + i = 1; + while ((i < n && OPT_nofhdfld <= 2048)) { + adr += btyp->size; + FPrintHdFld__15(btyp, fld, adr); + i += 1; + } + } + } + } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) { + OPM_FPrint(&*FPrintStr__12_s->pvfp, ((LONGINT)(13))); + OPM_FPrint(&*FPrintStr__12_s->pvfp, adr); + OPT_nofhdfld += 1; + } +} + +static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible) +{ + while ((fld != NIL && fld->mode == 4)) { + if ((fld->vis != 0 && visible)) { + OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->vis); + OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)fld->name, ((LONGINT)(256))); + OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->adr); + OPT_FPrintStr(fld->typ); + OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->typ->pbfp); + OPM_FPrint(&*FPrintStr__12_s->pvfp, fld->typ->pvfp); + } else { + FPrintHdFld__15(fld->typ, fld, fld->adr + adr); + } + fld = fld->link; + } +} + +static void FPrintTProcs__17 (OPT_Object obj) +{ + if (obj != NIL) { + FPrintTProcs__17(obj->left); + if (obj->mode == 13) { + if (obj->vis != 0) { + OPM_FPrint(&*FPrintStr__12_s->pbfp, ((LONGINT)(13))); + OPM_FPrint(&*FPrintStr__12_s->pbfp, __ASHR(obj->adr, 16)); + OPT_FPrintSign(&*FPrintStr__12_s->pbfp, obj->typ, obj->link); + OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)obj->name, ((LONGINT)(256))); + } + } + FPrintTProcs__17(obj->right); + } +} + +void OPT_FPrintStr (OPT_Struct typ) +{ + INTEGER f, c; + OPT_Struct btyp = NIL; + OPT_Object strobj = NIL, bstrobj = NIL; + LONGINT pbfp, pvfp; + struct FPrintStr__12 _s; + _s.pbfp = &pbfp; + _s.pvfp = &pvfp; + _s.lnk = FPrintStr__12_s; + FPrintStr__12_s = &_s; + if (!typ->fpdone) { + OPT_IdFPrint(typ); + pbfp = typ->idfp; + if (typ->sysflag != 0) { + OPM_FPrint(&pbfp, typ->sysflag); + } + pvfp = pbfp; + typ->pbfp = pbfp; + typ->pvfp = pvfp; + typ->fpdone = 1; + f = typ->form; + c = typ->comp; + btyp = typ->BaseTyp; + if (f == 13) { + strobj = typ->strobj; + bstrobj = btyp->strobj; + if (((strobj == NIL || strobj->name[0] == 0x00) || bstrobj == NIL) || bstrobj->name[0] == 0x00) { + OPT_FPrintStr(btyp); + OPM_FPrint(&pbfp, btyp->pbfp); + pvfp = pbfp; + } + } else if (f == 14) { + } else if (__IN(c, 0x0c)) { + OPT_FPrintStr(btyp); + OPM_FPrint(&pbfp, btyp->pvfp); + pvfp = pbfp; + } else { + if (btyp != NIL) { + OPT_FPrintStr(btyp); + OPM_FPrint(&pbfp, btyp->pbfp); + OPM_FPrint(&pvfp, btyp->pvfp); + } + OPM_FPrint(&pvfp, typ->size); + OPM_FPrint(&pvfp, typ->align); + OPM_FPrint(&pvfp, typ->n); + OPT_nofhdfld = 0; + FPrintFlds__13(typ->link, ((LONGINT)(0)), 1); + if (OPT_nofhdfld > 2048) { + OPM_Mark(225, typ->txtpos); + } + FPrintTProcs__17(typ->link); + OPM_FPrint(&pvfp, pbfp); + strobj = typ->strobj; + if (strobj == NIL || strobj->name[0] == 0x00) { + pbfp = pvfp; + } + } + typ->pbfp = pbfp; + typ->pvfp = pvfp; + } + FPrintStr__12_s = _s.lnk; +} + +void OPT_FPrintObj (OPT_Object obj) +{ + LONGINT fprint; + INTEGER f, m; + REAL rval; + OPT_ConstExt ext = NIL; + if (!obj->fpdone) { + fprint = 0; + obj->fpdone = 1; + OPM_FPrint(&fprint, obj->mode); + if (obj->mode == 3) { + f = obj->typ->form; + OPM_FPrint(&fprint, f); + switch (f) { + case 2: case 3: case 4: case 5: case 6: + OPM_FPrint(&fprint, obj->conval->intval); + break; + case 9: + OPM_FPrintSet(&fprint, obj->conval->setval); + break; + case 7: + rval = obj->conval->realval; + OPM_FPrintReal(&fprint, rval); + break; + case 8: + OPM_FPrintLReal(&fprint, obj->conval->realval); + break; + case 10: + OPT_FPrintName(&fprint, (void*)*obj->conval->ext, ((LONGINT)(256))); + break; + case 11: + break; + default: + OPT_err(127); + break; + } + } else if (obj->mode == 1) { + OPM_FPrint(&fprint, obj->vis); + OPT_FPrintStr(obj->typ); + OPM_FPrint(&fprint, obj->typ->pbfp); + } else if (__IN(obj->mode, 0x0480)) { + OPT_FPrintSign(&fprint, obj->typ, obj->link); + } else if (obj->mode == 9) { + OPT_FPrintSign(&fprint, obj->typ, obj->link); + ext = obj->conval->ext; + m = (int)(*ext)[0]; + f = 1; + OPM_FPrint(&fprint, m); + while (f <= m) { + OPM_FPrint(&fprint, (int)(*ext)[__X(f, ((LONGINT)(256)))]); + f += 1; + } + } else if (obj->mode == 5) { + OPT_FPrintStr(obj->typ); + OPM_FPrint(&fprint, obj->typ->pbfp); + } + obj->fprint = fprint; + } +} + +void OPT_FPrintErr (OPT_Object obj, INTEGER errcode) +{ + INTEGER i, j; + CHAR ch; + if (obj->mnolev != 0) { + __COPY(OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, OPM_objname, ((LONGINT)(64))); + i = 0; + while (OPM_objname[__X(i, ((LONGINT)(64)))] != 0x00) { + i += 1; + } + OPM_objname[__X(i, ((LONGINT)(64)))] = '.'; + j = 0; + i += 1; + do { + ch = obj->name[__X(j, ((LONGINT)(256)))]; + OPM_objname[__X(i, ((LONGINT)(64)))] = ch; + j += 1; + i += 1; + } while (!(ch == 0x00)); + } else { + __COPY(obj->name, OPM_objname, ((LONGINT)(64))); + } + if (errcode == 249) { + if (OPM_noerr) { + OPT_err(errcode); + } + } else if (errcode == 253) { + if ((((!OPT_symNew && !OPT_symExtended)) && !OPT_extsf)) { + OPT_err(errcode); + } + OPT_symExtended = 1; + } else { + if ((!OPT_symNew && !OPT_newsf)) { + OPT_err(errcode); + } + OPT_symNew = 1; + } +} + +void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old) +{ + OPT_Object ob0 = NIL, ob1 = NIL; + BOOLEAN left; + if (*root == NIL) { + *root = obj; + *old = NIL; + } else { + ob0 = *root; + ob1 = ob0->right; + left = 0; + if (__STRCMP(obj->name, ob0->name) < 0) { + ob1 = ob0->left; + left = 1; + } else if (__STRCMP(obj->name, ob0->name) > 0) { + ob1 = ob0->right; + left = 0; + } else { + *old = ob0; + return; + } + for (;;) { + if (ob1 != NIL) { + if (__STRCMP(obj->name, ob1->name) < 0) { + ob0 = ob1; + ob1 = ob1->left; + left = 1; + } else if (__STRCMP(obj->name, ob1->name) > 0) { + ob0 = ob1; + ob1 = ob1->right; + left = 0; + } else { + *old = ob1; + break; + } + } else { + ob1 = obj; + if (left) { + ob0->left = ob1; + } else { + ob0->right = ob1; + } + ob1->left = NIL; + ob1->right = NIL; + *old = NIL; + break; + } + } + } +} + +static void OPT_InName (CHAR *name, LONGINT name__len) +{ + INTEGER i; + CHAR ch; + i = 0; + do { + OPM_SymRCh(&ch); + name[__X(i, name__len)] = ch; + i += 1; + } while (!(ch == 0x00)); +} + +static void OPT_InMod (SHORTINT *mno) +{ + OPT_Object head = NIL; + OPS_Name name; + LONGINT mn; + SHORTINT i; + mn = OPM_SymRInt(); + if (mn == 0) { + *mno = OPT_impCtxt.glbmno[0]; + } else { + if (mn == 16) { + OPT_InName((void*)name, ((LONGINT)(256))); + if ((__STRCMP(name, OPT_SelfName) == 0 && !OPT_impCtxt.self)) { + OPT_err(154); + } + i = 0; + while ((i < OPT_nofGmod && __STRCMP(name, OPT_GlbMod[__X(i, ((LONGINT)(64)))]->name) != 0)) { + i += 1; + } + if (i < OPT_nofGmod) { + *mno = i; + } else { + head = OPT_NewObj(); + head->mode = 12; + __COPY(name, head->name, ((LONGINT)(256))); + *mno = OPT_nofGmod; + head->mnolev = -*mno; + if (OPT_nofGmod < 64) { + OPT_GlbMod[__X(*mno, ((LONGINT)(64)))] = head; + OPT_nofGmod += 1; + } else { + OPT_err(227); + } + } + OPT_impCtxt.glbmno[__X(OPT_impCtxt.nofm, ((LONGINT)(64)))] = *mno; + OPT_impCtxt.nofm += 1; + } else { + *mno = OPT_impCtxt.glbmno[__X(-mn, ((LONGINT)(64)))]; + } + } +} + +static void OPT_InConstant (LONGINT f, OPT_Const conval) +{ + CHAR ch; + INTEGER i; + OPT_ConstExt ext = NIL; + REAL rval; + switch (f) { + case 1: case 3: case 2: + OPM_SymRCh(&ch); + conval->intval = (int)ch; + break; + case 4: case 5: case 6: + conval->intval = OPM_SymRInt(); + break; + case 9: + OPM_SymRSet(&conval->setval); + break; + case 7: + OPM_SymRReal(&rval); + conval->realval = rval; + conval->intval = -1; + break; + case 8: + OPM_SymRLReal(&conval->realval); + conval->intval = -1; + break; + case 10: + ext = OPT_NewExt(); + conval->ext = ext; + i = 0; + do { + OPM_SymRCh(&ch); + (*ext)[__X(i, ((LONGINT)(256)))] = ch; + i += 1; + } while (!(ch == 0x00)); + conval->intval2 = i; + conval->intval = -1; + break; + case 11: + conval->intval = 0; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPT.InConstant(), f = ", (LONGINT)41); + OPM_LogWNum(f, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } +} + +static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par) +{ + OPT_Object last = NIL, new = NIL; + LONGINT tag; + OPT_InStruct(&*res); + tag = OPM_SymRInt(); + last = NIL; + while (tag != 18) { + new = OPT_NewObj(); + new->mnolev = -mno; + if (last == NIL) { + *par = new; + } else { + last->link = new; + } + if (tag == 23) { + new->mode = 1; + } else { + new->mode = 2; + } + OPT_InStruct(&new->typ); + new->adr = OPM_SymRInt(); + OPT_InName((void*)new->name, ((LONGINT)(256))); + last = new; + tag = OPM_SymRInt(); + } +} + +static OPT_Object OPT_InFld (void) +{ + OPT_Object _o_result; + LONGINT tag; + OPT_Object obj = NIL; + tag = OPT_impCtxt.nextTag; + obj = OPT_NewObj(); + if (tag <= 26) { + obj->mode = 4; + if (tag == 26) { + obj->vis = 2; + } else { + obj->vis = 1; + } + OPT_InStruct(&obj->typ); + OPT_InName((void*)obj->name, ((LONGINT)(256))); + obj->adr = OPM_SymRInt(); + } else { + obj->mode = 4; + if (tag == 27) { + __MOVE("@ptr", obj->name, 5); + } else { + __MOVE("@proc", obj->name, 6); + } + obj->typ = OPT_undftyp; + obj->vis = 0; + obj->adr = OPM_SymRInt(); + } + _o_result = obj; + return _o_result; +} + +static OPT_Object OPT_InTProc (SHORTINT mno) +{ + OPT_Object _o_result; + LONGINT tag; + OPT_Object obj = NIL; + tag = OPT_impCtxt.nextTag; + obj = OPT_NewObj(); + obj->mnolev = -mno; + if (tag == 29) { + obj->mode = 13; + obj->conval = OPT_NewConst(); + obj->conval->intval = -1; + OPT_InSign(mno, &obj->typ, &obj->link); + obj->vis = 1; + OPT_InName((void*)obj->name, ((LONGINT)(256))); + obj->adr = __ASHL(OPM_SymRInt(), 16); + } else { + obj->mode = 13; + __MOVE("@tproc", obj->name, 7); + obj->link = OPT_NewObj(); + obj->typ = OPT_undftyp; + obj->vis = 0; + obj->adr = __ASHL(OPM_SymRInt(), 16); + } + _o_result = obj; + return _o_result; +} + +static void OPT_InStruct (OPT_Struct *typ) +{ + SHORTINT mno; + INTEGER ref; + LONGINT tag; + OPS_Name name; + OPT_Struct t = NIL; + OPT_Object obj = NIL, last = NIL, fld = NIL, old = NIL, dummy = NIL; + tag = OPM_SymRInt(); + if (tag != 34) { + *typ = OPT_impCtxt.ref[__X(-tag, ((LONGINT)(255)))]; + } else { + ref = OPT_impCtxt.nofr; + OPT_impCtxt.nofr += 1; + if (ref < OPT_impCtxt.minr) { + OPT_impCtxt.minr = ref; + } + OPT_InMod(&mno); + OPT_InName((void*)name, ((LONGINT)(256))); + obj = OPT_NewObj(); + if (name[0] == 0x00) { + if (OPT_impCtxt.self) { + old = NIL; + } else { + __MOVE("@", obj->name, 2); + OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old); + obj->name[0] = 0x00; + } + *typ = OPT_NewStr(0, 1); + } else { + __COPY(name, obj->name, ((LONGINT)(256))); + OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old); + if (old != NIL) { + OPT_FPrintObj(old); + OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] = old->typ->pvfp; + if (OPT_impCtxt.self) { + *typ = OPT_NewStr(0, 1); + } else { + *typ = old->typ; + (*typ)->link = NIL; + (*typ)->sysflag = 0; + (*typ)->fpdone = 0; + (*typ)->idfpdone = 0; + } + } else { + *typ = OPT_NewStr(0, 1); + } + } + OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))] = *typ; + OPT_impCtxt.old[__X(ref, ((LONGINT)(255)))] = old; + (*typ)->ref = ref + 255; + (*typ)->mno = mno; + (*typ)->allocated = 1; + (*typ)->strobj = obj; + obj->mode = 5; + obj->typ = *typ; + obj->mnolev = -mno; + obj->vis = 0; + tag = OPM_SymRInt(); + if (tag == 35) { + (*typ)->sysflag = (int)OPM_SymRInt(); + tag = OPM_SymRInt(); + } + switch (tag) { + case 36: + (*typ)->form = 13; + (*typ)->size = OPM_PointerSize; + (*typ)->n = 0; + OPT_InStruct(&(*typ)->BaseTyp); + break; + case 37: + (*typ)->form = 15; + (*typ)->comp = 2; + OPT_InStruct(&(*typ)->BaseTyp); + (*typ)->n = OPM_SymRInt(); + (*OPT_typSize)(*typ); + break; + case 38: + (*typ)->form = 15; + (*typ)->comp = 3; + OPT_InStruct(&(*typ)->BaseTyp); + if ((*typ)->BaseTyp->comp == 3) { + (*typ)->n = (*typ)->BaseTyp->n + 1; + } else { + (*typ)->n = 0; + } + (*OPT_typSize)(*typ); + break; + case 39: + (*typ)->form = 15; + (*typ)->comp = 4; + OPT_InStruct(&(*typ)->BaseTyp); + if ((*typ)->BaseTyp == OPT_notyp) { + (*typ)->BaseTyp = NIL; + } + (*typ)->extlev = 0; + t = (*typ)->BaseTyp; + while (t != NIL) { + (*typ)->extlev += 1; + t = t->BaseTyp; + } + (*typ)->size = OPM_SymRInt(); + (*typ)->align = OPM_SymRInt(); + (*typ)->n = OPM_SymRInt(); + OPT_impCtxt.nextTag = OPM_SymRInt(); + last = NIL; + while ((OPT_impCtxt.nextTag >= 25 && OPT_impCtxt.nextTag <= 28)) { + fld = OPT_InFld(); + fld->mnolev = -mno; + if (last != NIL) { + last->link = fld; + } + last = fld; + OPT_InsertImport(fld, &(*typ)->link, &dummy); + OPT_impCtxt.nextTag = OPM_SymRInt(); + } + while (OPT_impCtxt.nextTag != 18) { + fld = OPT_InTProc(mno); + OPT_InsertImport(fld, &(*typ)->link, &dummy); + OPT_impCtxt.nextTag = OPM_SymRInt(); + } + break; + case 40: + (*typ)->form = 14; + (*typ)->size = OPM_ProcSize; + OPT_InSign(mno, &(*typ)->BaseTyp, &(*typ)->link); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.InStruct, tag = ", (LONGINT)39); + OPM_LogWNum(tag, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + if (ref == OPT_impCtxt.minr) { + while (ref < OPT_impCtxt.nofr) { + t = OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))]; + OPT_FPrintStr(t); + obj = t->strobj; + if (obj->name[0] != 0x00) { + OPT_FPrintObj(obj); + } + old = OPT_impCtxt.old[__X(ref, ((LONGINT)(255)))]; + if (old != NIL) { + t->strobj = old; + if (OPT_impCtxt.self) { + if (old->mnolev < 0) { + if (old->history != 5) { + if (old->fprint != obj->fprint) { + old->history = 2; + } else if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) { + old->history = 3; + } + } + } else if (old->fprint != obj->fprint) { + old->history = 2; + } else if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) { + old->history = 3; + } else if (old->vis == 0) { + old->history = 1; + } else { + old->history = 0; + } + } else { + if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) { + old->history = 5; + } + if (old->fprint != obj->fprint) { + OPT_FPrintErr(old, 249); + } + } + } else if (OPT_impCtxt.self) { + obj->history = 4; + } else { + obj->history = 1; + } + ref += 1; + } + OPT_impCtxt.minr = 255; + } + } +} + +static OPT_Object OPT_InObj (SHORTINT mno) +{ + OPT_Object _o_result; + INTEGER i, s; + CHAR ch; + OPT_Object obj = NIL, old = NIL; + OPT_Struct typ = NIL; + LONGINT tag; + OPT_ConstExt ext = NIL; + tag = OPT_impCtxt.nextTag; + if (tag == 19) { + OPT_InStruct(&typ); + obj = typ->strobj; + if (!OPT_impCtxt.self) { + obj->vis = 1; + } + } else { + obj = OPT_NewObj(); + obj->mnolev = -mno; + obj->vis = 1; + if (tag <= 13) { + obj->mode = 3; + obj->typ = OPT_impCtxt.ref[__X(tag, ((LONGINT)(255)))]; + obj->conval = OPT_NewConst(); + OPT_InConstant(tag, obj->conval); + } else if (tag >= 31) { + obj->conval = OPT_NewConst(); + obj->conval->intval = -1; + OPT_InSign(mno, &obj->typ, &obj->link); + switch (tag) { + case 31: + obj->mode = 7; + break; + case 32: + obj->mode = 10; + break; + case 33: + obj->mode = 9; + ext = OPT_NewExt(); + obj->conval->ext = ext; + s = (int)OPM_SymRInt(); + (*ext)[0] = (CHAR)s; + i = 1; + while (i <= s) { + OPM_SymRCh(&(*ext)[__X(i, ((LONGINT)(256)))]); + i += 1; + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.InObj, tag = ", (LONGINT)36); + OPM_LogWNum(tag, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } else if (tag == 20) { + obj->mode = 5; + OPT_InStruct(&obj->typ); + } else { + obj->mode = 1; + if (tag == 22) { + obj->vis = 2; + } + OPT_InStruct(&obj->typ); + } + OPT_InName((void*)obj->name, ((LONGINT)(256))); + } + OPT_FPrintObj(obj); + if ((obj->mode == 1 && (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00))) { + OPM_FPrint(&OPT_impCtxt.reffp, obj->typ->ref - 255); + } + if (tag != 19) { + OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old); + if (OPT_impCtxt.self) { + if (old != NIL) { + if (old->vis == 0) { + old->history = 4; + } else { + OPT_FPrintObj(old); + if (obj->fprint != old->fprint) { + old->history = 2; + } else if (obj->typ->pvfp != old->typ->pvfp) { + old->history = 3; + } else { + old->history = 1; + } + } + } else { + obj->history = 4; + } + } + } else { + if (OPT_impCtxt.self) { + if (obj->vis == 0) { + obj->history = 4; + } else if (obj->history == 0) { + obj->history = 1; + } + } + } + _o_result = obj; + return _o_result; +} + +void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done) +{ + OPT_Object obj = NIL; + SHORTINT mno; + OPS_Name aliasName__copy; + __DUPARR(aliasName, OPS_Name); + if (__STRCMP(name, "SYSTEM") == 0) { + OPT_SYSimported = 1; + OPT_Insert(aliasName, &obj); + obj->mode = 11; + obj->mnolev = 0; + obj->scope = OPT_syslink; + obj->typ = OPT_notyp; + } else { + OPT_impCtxt.nofr = 16; + OPT_impCtxt.minr = 255; + OPT_impCtxt.nofm = 0; + OPT_impCtxt.self = __STRCMP(aliasName, "@self") == 0; + OPT_impCtxt.reffp = 0; + OPM_OldSym((void*)name, ((LONGINT)(256)), &*done); + if (*done) { + OPT_InMod(&mno); + OPT_impCtxt.nextTag = OPM_SymRInt(); + while (!OPM_eofSF()) { + obj = OPT_InObj(mno); + OPT_impCtxt.nextTag = OPM_SymRInt(); + } + OPT_Insert(aliasName, &obj); + obj->mode = 11; + obj->scope = OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right; + OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->link = obj; + obj->mnolev = -mno; + obj->typ = OPT_notyp; + OPM_CloseOldSym(); + } else if (OPT_impCtxt.self) { + OPT_newsf = 1; + OPT_extsf = 1; + OPT_sfpresent = 0; + } else { + OPT_err(152); + } + } +} + +static void OPT_OutName (CHAR *name, LONGINT name__len) +{ + INTEGER i; + CHAR ch; + i = 0; + do { + ch = name[__X(i, name__len)]; + OPM_SymWCh(ch); + i += 1; + } while (!(ch == 0x00)); +} + +static void OPT_OutMod (INTEGER mno) +{ + if (OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))] < 0) { + OPM_SymWInt(((LONGINT)(16))); + OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))] = OPT_expCtxt.nofm; + OPT_expCtxt.nofm += 1; + OPT_OutName((void*)OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + } else { + OPM_SymWInt(-OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))]); + } +} + +static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr) +{ + LONGINT i, j, n; + OPT_Struct btyp = NIL; + if (typ->comp == 4) { + OPT_OutFlds(typ->link, adr, 0); + } else if (typ->comp == 2) { + btyp = typ->BaseTyp; + n = typ->n; + while (btyp->comp == 2) { + n = btyp->n * n; + btyp = btyp->BaseTyp; + } + if (btyp->form == 13 || btyp->comp == 4) { + j = OPT_nofhdfld; + OPT_OutHdFld(btyp, fld, adr); + if (j != OPT_nofhdfld) { + i = 1; + while ((i < n && OPT_nofhdfld <= 2048)) { + adr += btyp->size; + OPT_OutHdFld(btyp, fld, adr); + i += 1; + } + } + } + } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) { + OPM_SymWInt(((LONGINT)(27))); + OPM_SymWInt(adr); + OPT_nofhdfld += 1; + } +} + +static void OPT_OutFlds (OPT_Object fld, LONGINT adr, BOOLEAN visible) +{ + while ((fld != NIL && fld->mode == 4)) { + if ((fld->vis != 0 && visible)) { + if (fld->vis == 2) { + OPM_SymWInt(((LONGINT)(26))); + } else { + OPM_SymWInt(((LONGINT)(25))); + } + OPT_OutStr(fld->typ); + OPT_OutName((void*)fld->name, ((LONGINT)(256))); + OPM_SymWInt(fld->adr); + } else { + OPT_OutHdFld(fld->typ, fld, fld->adr + adr); + } + fld = fld->link; + } +} + +static void OPT_OutSign (OPT_Struct result, OPT_Object par) +{ + OPT_OutStr(result); + while (par != NIL) { + if (par->mode == 1) { + OPM_SymWInt(((LONGINT)(23))); + } else { + OPM_SymWInt(((LONGINT)(24))); + } + OPT_OutStr(par->typ); + OPM_SymWInt(par->adr); + OPT_OutName((void*)par->name, ((LONGINT)(256))); + par = par->link; + } + OPM_SymWInt(((LONGINT)(18))); +} + +static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj) +{ + if (obj != NIL) { + OPT_OutTProcs(typ, obj->left); + if (obj->mode == 13) { + if ((((typ->BaseTyp != NIL && __ASHR(obj->adr, 16) < typ->BaseTyp->n)) && obj->vis == 0)) { + OPM_Mark(109, typ->txtpos); + } + if (obj->vis != 0) { + if (obj->vis != 0) { + OPM_SymWInt(((LONGINT)(29))); + OPT_OutSign(obj->typ, obj->link); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + OPM_SymWInt(__ASHR(obj->adr, 16)); + } else { + OPM_SymWInt(((LONGINT)(30))); + OPM_SymWInt(__ASHR(obj->adr, 16)); + } + } + } + OPT_OutTProcs(typ, obj->right); + } +} + +static void OPT_OutStr (OPT_Struct typ) +{ + OPT_Object strobj = NIL; + if (typ->ref < OPT_expCtxt.ref) { + OPM_SymWInt(-typ->ref); + } else { + OPM_SymWInt(((LONGINT)(34))); + typ->ref = OPT_expCtxt.ref; + OPT_expCtxt.ref += 1; + if (OPT_expCtxt.ref >= 255) { + OPT_err(228); + } + OPT_OutMod(typ->mno); + strobj = typ->strobj; + if ((strobj != NIL && strobj->name[0] != 0x00)) { + OPT_OutName((void*)strobj->name, ((LONGINT)(256))); + switch (strobj->history) { + case 2: + OPT_FPrintErr(strobj, 252); + break; + case 3: + OPT_FPrintErr(strobj, 251); + break; + case 5: + OPT_FPrintErr(strobj, 249); + break; + default: + break; + } + } else { + OPM_SymWCh(0x00); + } + if (typ->sysflag != 0) { + OPM_SymWInt(((LONGINT)(35))); + OPM_SymWInt(typ->sysflag); + } + switch (typ->form) { + case 13: + OPM_SymWInt(((LONGINT)(36))); + OPT_OutStr(typ->BaseTyp); + break; + case 14: + OPM_SymWInt(((LONGINT)(40))); + OPT_OutSign(typ->BaseTyp, typ->link); + break; + case 15: + switch (typ->comp) { + case 2: + OPM_SymWInt(((LONGINT)(37))); + OPT_OutStr(typ->BaseTyp); + OPM_SymWInt(typ->n); + break; + case 3: + OPM_SymWInt(((LONGINT)(38))); + OPT_OutStr(typ->BaseTyp); + break; + case 4: + OPM_SymWInt(((LONGINT)(39))); + if (typ->BaseTyp == NIL) { + OPT_OutStr(OPT_notyp); + } else { + OPT_OutStr(typ->BaseTyp); + } + OPM_SymWInt(typ->size); + OPM_SymWInt(typ->align); + OPM_SymWInt(typ->n); + OPT_nofhdfld = 0; + OPT_OutFlds(typ->link, ((LONGINT)(0)), 1); + if (OPT_nofhdfld > 2048) { + OPM_Mark(223, typ->txtpos); + } + OPT_OutTProcs(typ, typ->link); + OPM_SymWInt(((LONGINT)(18))); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.OutStr, typ^.comp = ", (LONGINT)43); + OPM_LogWNum(typ->comp, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.OutStr, typ^.form = ", (LONGINT)43); + OPM_LogWNum(typ->form, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } +} + +static void OPT_OutConstant (OPT_Object obj) +{ + INTEGER f; + REAL rval; + f = obj->typ->form; + OPM_SymWInt(f); + switch (f) { + case 2: case 3: + OPM_SymWCh((CHAR)obj->conval->intval); + break; + case 4: case 5: case 6: + OPM_SymWInt(obj->conval->intval); + break; + case 9: + OPM_SymWSet(obj->conval->setval); + break; + case 7: + rval = obj->conval->realval; + OPM_SymWReal(rval); + break; + case 8: + OPM_SymWLReal(obj->conval->realval); + break; + case 10: + OPT_OutName((void*)*obj->conval->ext, ((LONGINT)(256))); + break; + case 11: + break; + default: + OPT_err(127); + break; + } +} + +static void OPT_OutObj (OPT_Object obj) +{ + INTEGER i, j; + OPT_ConstExt ext = NIL; + if (obj != NIL) { + OPT_OutObj(obj->left); + if (__IN(obj->mode, 0x06ea)) { + if (obj->history == 4) { + OPT_FPrintErr(obj, 250); + } else if (obj->vis != 0) { + switch (obj->history) { + case 0: + OPT_FPrintErr(obj, 253); + break; + case 1: + break; + case 2: + OPT_FPrintErr(obj, 252); + break; + case 3: + OPT_FPrintErr(obj, 251); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.OutObj, obj^.history = ", (LONGINT)46); + OPM_LogWNum(obj->history, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + switch (obj->mode) { + case 3: + OPT_OutConstant(obj); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + break; + case 5: + if (obj->typ->strobj == obj) { + OPM_SymWInt(((LONGINT)(19))); + OPT_OutStr(obj->typ); + } else { + OPM_SymWInt(((LONGINT)(20))); + OPT_OutStr(obj->typ); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + } + break; + case 1: + if (obj->vis == 2) { + OPM_SymWInt(((LONGINT)(22))); + } else { + OPM_SymWInt(((LONGINT)(21))); + } + OPT_OutStr(obj->typ); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + if (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00) { + OPM_FPrint(&OPT_expCtxt.reffp, obj->typ->ref); + } + break; + case 7: + OPM_SymWInt(((LONGINT)(31))); + OPT_OutSign(obj->typ, obj->link); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + break; + case 10: + OPM_SymWInt(((LONGINT)(32))); + OPT_OutSign(obj->typ, obj->link); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + break; + case 9: + OPM_SymWInt(((LONGINT)(33))); + OPT_OutSign(obj->typ, obj->link); + ext = obj->conval->ext; + j = (int)(*ext)[0]; + i = 1; + OPM_SymWInt(j); + while (i <= j) { + OPM_SymWCh((*ext)[__X(i, ((LONGINT)(256)))]); + i += 1; + } + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.OutObj, obj.mode = ", (LONGINT)42); + OPM_LogWNum(obj->mode, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } + } + OPT_OutObj(obj->right); + } +} + +void OPT_Export (BOOLEAN *ext, BOOLEAN *new) +{ + INTEGER i; + SHORTINT nofmod; + BOOLEAN done; + OPT_symExtended = 0; + OPT_symNew = 0; + nofmod = OPT_nofGmod; + OPT_Import((CHAR*)"@self", OPT_SelfName, &done); + OPT_nofGmod = nofmod; + if (OPM_noerr) { + OPM_NewSym((void*)OPT_SelfName, ((LONGINT)(256))); + if (OPM_noerr) { + OPM_SymWInt(((LONGINT)(16))); + OPT_OutName((void*)OPT_SelfName, ((LONGINT)(256))); + OPT_expCtxt.reffp = 0; + OPT_expCtxt.ref = 16; + OPT_expCtxt.nofm = 1; + OPT_expCtxt.locmno[0] = 0; + i = 1; + while (i < 64) { + OPT_expCtxt.locmno[__X(i, ((LONGINT)(64)))] = -1; + i += 1; + } + OPT_OutObj(OPT_topScope->right); + *ext = (OPT_sfpresent && OPT_symExtended); + *new = !OPT_sfpresent || OPT_symNew; + if (OPM_forceNewSym) { + *new = 1; + } + if ((((OPM_noerr && OPT_sfpresent)) && OPT_impCtxt.reffp != OPT_expCtxt.reffp)) { + *new = 1; + if (!OPT_extsf) { + OPT_err(155); + } + } + OPT_newsf = 0; + OPT_symNew = 0; + if (!OPM_noerr || OPT_findpc) { + OPM_DeleteNewSym(); + } + } + } +} + +static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form) +{ + *typ = OPT_NewStr(form, 1); + (*typ)->ref = form; + (*typ)->size = OPM_ByteSize; + (*typ)->allocated = 1; + (*typ)->strobj = OPT_NewObj(); + (*typ)->pbfp = form; + (*typ)->pvfp = form; + (*typ)->fpdone = 1; + (*typ)->idfp = form; + (*typ)->idfpdone = 1; +} + +static void OPT_EnterBoolConst (OPS_Name name, LONGINT value) +{ + OPT_Object obj = NIL; + OPS_Name name__copy; + __DUPARR(name, OPS_Name); + OPT_Insert(name, &obj); + obj->conval = OPT_NewConst(); + obj->mode = 3; + obj->typ = OPT_booltyp; + obj->conval->intval = value; +} + +static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res) +{ + OPT_Object obj = NIL; + OPT_Struct typ = NIL; + OPS_Name name__copy; + __DUPARR(name, OPS_Name); + OPT_Insert(name, &obj); + typ = OPT_NewStr(form, 1); + obj->mode = 5; + obj->typ = typ; + obj->vis = 1; + typ->strobj = obj; + typ->size = size; + typ->ref = form; + typ->allocated = 1; + typ->pbfp = form; + typ->pvfp = form; + typ->fpdone = 1; + typ->idfp = form; + typ->idfpdone = 1; + *res = typ; +} + +static void OPT_EnterProc (OPS_Name name, INTEGER num) +{ + OPT_Object obj = NIL; + OPS_Name name__copy; + __DUPARR(name, OPS_Name); + OPT_Insert(name, &obj); + obj->mode = 8; + obj->typ = OPT_notyp; + obj->adr = num; +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(OPT_topScope); + P(OPT_undftyp); + P(OPT_bytetyp); + P(OPT_booltyp); + P(OPT_chartyp); + P(OPT_sinttyp); + P(OPT_inttyp); + P(OPT_linttyp); + P(OPT_realtyp); + P(OPT_lrltyp); + P(OPT_settyp); + P(OPT_stringtyp); + P(OPT_niltyp); + P(OPT_notyp); + P(OPT_sysptrtyp); + __ENUMP(OPT_GlbMod, 64, P); + P(OPT_universe); + P(OPT_syslink); + __ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 3140, 1, P); +} + +__TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 24), {0, -8}}; +__TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 304), {0, 4, 8, 12, 284, 288, -28}}; +__TDESC(OPT_StrDesc, 1, 3) = {__TDFLDS("StrDesc", 56), {44, 48, 52, -16}}; +__TDESC(OPT_NodeDesc, 1, 6) = {__TDFLDS("NodeDesc", 28), {0, 4, 8, 16, 20, 24, -28}}; +__TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 3140), {16, 20, 24, 28, 32, 36, 40, 44, 48, 52, 56, 60, 64, 68, 72, 76, + 80, 84, 88, 92, 96, 100, 104, 108, 112, 116, 120, 124, 128, 132, 136, 140, + 144, 148, 152, 156, 160, 164, 168, 172, 176, 180, 184, 188, 192, 196, 200, 204, + 208, 212, 216, 220, 224, 228, 232, 236, 240, 244, 248, 252, 256, 260, 264, 268, + 272, 276, 280, 284, 288, 292, 296, 300, 304, 308, 312, 316, 320, 324, 328, 332, + 336, 340, 344, 348, 352, 356, 360, 364, 368, 372, 376, 380, 384, 388, 392, 396, + 400, 404, 408, 412, 416, 420, 424, 428, 432, 436, 440, 444, 448, 452, 456, 460, + 464, 468, 472, 476, 480, 484, 488, 492, 496, 500, 504, 508, 512, 516, 520, 524, + 528, 532, 536, 540, 544, 548, 552, 556, 560, 564, 568, 572, 576, 580, 584, 588, + 592, 596, 600, 604, 608, 612, 616, 620, 624, 628, 632, 636, 640, 644, 648, 652, + 656, 660, 664, 668, 672, 676, 680, 684, 688, 692, 696, 700, 704, 708, 712, 716, + 720, 724, 728, 732, 736, 740, 744, 748, 752, 756, 760, 764, 768, 772, 776, 780, + 784, 788, 792, 796, 800, 804, 808, 812, 816, 820, 824, 828, 832, 836, 840, 844, + 848, 852, 856, 860, 864, 868, 872, 876, 880, 884, 888, 892, 896, 900, 904, 908, + 912, 916, 920, 924, 928, 932, 936, 940, 944, 948, 952, 956, 960, 964, 968, 972, + 976, 980, 984, 988, 992, 996, 1000, 1004, 1008, 1012, 1016, 1020, 1024, 1028, 1032, 1036, + 1040, 1044, 1048, 1052, 1056, 1060, 1064, 1068, 1072, 1076, 1080, 1084, 1088, 1092, 1096, 1100, + 1104, 1108, 1112, 1116, 1120, 1124, 1128, 1132, 1136, 1140, 1144, 1148, 1152, 1156, 1160, 1164, + 1168, 1172, 1176, 1180, 1184, 1188, 1192, 1196, 1200, 1204, 1208, 1212, 1216, 1220, 1224, 1228, + 1232, 1236, 1240, 1244, 1248, 1252, 1256, 1260, 1264, 1268, 1272, 1276, 1280, 1284, 1288, 1292, + 1296, 1300, 1304, 1308, 1312, 1316, 1320, 1324, 1328, 1332, 1336, 1340, 1344, 1348, 1352, 1356, + 1360, 1364, 1368, 1372, 1376, 1380, 1384, 1388, 1392, 1396, 1400, 1404, 1408, 1412, 1416, 1420, + 1424, 1428, 1432, 1436, 1440, 1444, 1448, 1452, 1456, 1460, 1464, 1468, 1472, 1476, 1480, 1484, + 1488, 1492, 1496, 1500, 1504, 1508, 1512, 1516, 1520, 1524, 1528, 1532, 1536, 1540, 1544, 1548, + 1552, 1556, 1560, 1564, 1568, 1572, 1576, 1580, 1584, 1588, 1592, 1596, 1600, 1604, 1608, 1612, + 1616, 1620, 1624, 1628, 1632, 1636, 1640, 1644, 1648, 1652, 1656, 1660, 1664, 1668, 1672, 1676, + 1680, 1684, 1688, 1692, 1696, 1700, 1704, 1708, 1712, 1716, 1720, 1724, 1728, 1732, 1736, 1740, + 1744, 1748, 1752, 1756, 1760, 1764, 1768, 1772, 1776, 1780, 1784, 1788, 1792, 1796, 1800, 1804, + 1808, 1812, 1816, 1820, 1824, 1828, 1832, 1836, 1840, 1844, 1848, 1852, 1856, 1860, 1864, 1868, + 1872, 1876, 1880, 1884, 1888, 1892, 1896, 1900, 1904, 1908, 1912, 1916, 1920, 1924, 1928, 1932, + 1936, 1940, 1944, 1948, 1952, 1956, 1960, 1964, 1968, 1972, 1976, 1980, 1984, 1988, 1992, 1996, + 2000, 2004, 2008, 2012, 2016, 2020, 2024, 2028, 2032, 2036, 2040, 2044, 2048, 2052, -2044}}; +__TDESC(OPT_ExpCtxt, 1, 0) = {__TDFLDS("ExpCtxt", 72), {-4}}; + +export void *OPT__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPS); + __REGMOD("OPT", EnumPtrs); + __REGCMD("Close", OPT_Close); + __REGCMD("CloseScope", OPT_CloseScope); + __INITYP(OPT_ConstDesc, OPT_ConstDesc, 0); + __INITYP(OPT_ObjDesc, OPT_ObjDesc, 0); + __INITYP(OPT_StrDesc, OPT_StrDesc, 0); + __INITYP(OPT_NodeDesc, OPT_NodeDesc, 0); + __INITYP(OPT_ImpCtxt, OPT_ImpCtxt, 0); + __INITYP(OPT_ExpCtxt, OPT_ExpCtxt, 0); +/* BEGIN */ + OPT_topScope = NIL; + OPT_OpenScope(0, NIL); + OPM_errpos = 0; + OPT_InitStruct(&OPT_undftyp, 0); + OPT_InitStruct(&OPT_notyp, 12); + OPT_InitStruct(&OPT_stringtyp, 10); + OPT_InitStruct(&OPT_niltyp, 11); + OPT_undftyp->BaseTyp = OPT_undftyp; + OPT_EnterTyp((CHAR*)"BYTE", 1, OPM_ByteSize, &OPT_bytetyp); + OPT_EnterTyp((CHAR*)"PTR", 13, OPM_PointerSize, &OPT_sysptrtyp); + OPT_EnterProc((CHAR*)"ADR", 20); + OPT_EnterProc((CHAR*)"CC", 21); + OPT_EnterProc((CHAR*)"LSH", 22); + OPT_EnterProc((CHAR*)"ROT", 23); + OPT_EnterProc((CHAR*)"GET", 24); + OPT_EnterProc((CHAR*)"PUT", 25); + OPT_EnterProc((CHAR*)"GETREG", 26); + OPT_EnterProc((CHAR*)"PUTREG", 27); + OPT_EnterProc((CHAR*)"BIT", 28); + OPT_EnterProc((CHAR*)"VAL", 29); + OPT_EnterProc((CHAR*)"NEW", 30); + OPT_EnterProc((CHAR*)"MOVE", 31); + OPT_syslink = OPT_topScope->right; + OPT_universe = OPT_topScope; + OPT_topScope->right = NIL; + OPT_EnterTyp((CHAR*)"CHAR", 3, OPM_CharSize, &OPT_chartyp); + OPT_EnterTyp((CHAR*)"SET", 9, OPM_SetSize, &OPT_settyp); + OPT_EnterTyp((CHAR*)"REAL", 7, OPM_RealSize, &OPT_realtyp); + OPT_EnterTyp((CHAR*)"INTEGER", 5, OPM_IntSize, &OPT_inttyp); + OPT_EnterTyp((CHAR*)"LONGINT", 6, OPM_LIntSize, &OPT_linttyp); + OPT_EnterTyp((CHAR*)"LONGREAL", 8, OPM_LRealSize, &OPT_lrltyp); + OPT_EnterTyp((CHAR*)"SHORTINT", 4, OPM_SIntSize, &OPT_sinttyp); + OPT_EnterTyp((CHAR*)"BOOLEAN", 2, OPM_BoolSize, &OPT_booltyp); + OPT_EnterBoolConst((CHAR*)"FALSE", ((LONGINT)(0))); + OPT_EnterBoolConst((CHAR*)"TRUE", ((LONGINT)(1))); + OPT_EnterProc((CHAR*)"HALT", 0); + OPT_EnterProc((CHAR*)"NEW", 1); + OPT_EnterProc((CHAR*)"ABS", 2); + OPT_EnterProc((CHAR*)"CAP", 3); + OPT_EnterProc((CHAR*)"ORD", 4); + OPT_EnterProc((CHAR*)"ENTIER", 5); + OPT_EnterProc((CHAR*)"ODD", 6); + OPT_EnterProc((CHAR*)"MIN", 7); + OPT_EnterProc((CHAR*)"MAX", 8); + OPT_EnterProc((CHAR*)"CHR", 9); + OPT_EnterProc((CHAR*)"SHORT", 10); + OPT_EnterProc((CHAR*)"LONG", 11); + OPT_EnterProc((CHAR*)"SIZE", 12); + OPT_EnterProc((CHAR*)"INC", 13); + OPT_EnterProc((CHAR*)"DEC", 14); + OPT_EnterProc((CHAR*)"INCL", 15); + OPT_EnterProc((CHAR*)"EXCL", 16); + OPT_EnterProc((CHAR*)"LEN", 17); + OPT_EnterProc((CHAR*)"COPY", 18); + OPT_EnterProc((CHAR*)"ASH", 19); + OPT_EnterProc((CHAR*)"ASSERT", 32); + OPT_impCtxt.ref[0] = OPT_undftyp; + OPT_impCtxt.ref[1] = OPT_bytetyp; + OPT_impCtxt.ref[2] = OPT_booltyp; + OPT_impCtxt.ref[3] = OPT_chartyp; + OPT_impCtxt.ref[4] = OPT_sinttyp; + OPT_impCtxt.ref[5] = OPT_inttyp; + OPT_impCtxt.ref[6] = OPT_linttyp; + OPT_impCtxt.ref[7] = OPT_realtyp; + OPT_impCtxt.ref[8] = OPT_lrltyp; + OPT_impCtxt.ref[9] = OPT_settyp; + OPT_impCtxt.ref[10] = OPT_stringtyp; + OPT_impCtxt.ref[11] = OPT_niltyp; + OPT_impCtxt.ref[12] = OPT_notyp; + OPT_impCtxt.ref[13] = OPT_sysptrtyp; + __ENDMOD; +} diff --git a/bootstrap/unix-48/OPT.h b/bootstrap/unix-48/OPT.h new file mode 100644 index 00000000..1a22d0df --- /dev/null +++ b/bootstrap/unix-48/OPT.h @@ -0,0 +1,105 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPT__h +#define OPT__h + +#include "SYSTEM.h" +#include "OPS.h" + +typedef + struct OPT_ConstDesc *OPT_Const; + +typedef + OPS_String *OPT_ConstExt; + +typedef + struct OPT_ConstDesc { + OPT_ConstExt ext; + LONGINT intval, intval2; + SET setval; + LONGREAL realval; + } OPT_ConstDesc; + +typedef + struct OPT_NodeDesc *OPT_Node; + +typedef + struct OPT_StrDesc *OPT_Struct; + +typedef + struct OPT_ObjDesc *OPT_Object; + +typedef + struct OPT_NodeDesc { + OPT_Node left, right, link; + SHORTINT class, subcl; + BOOLEAN readonly; + OPT_Struct typ; + OPT_Object obj; + OPT_Const conval; + } OPT_NodeDesc; + +typedef + struct OPT_ObjDesc { + OPT_Object left, right, link, scope; + OPS_Name name; + BOOLEAN leaf; + SHORTINT mode, mnolev, vis, history; + BOOLEAN used, fpdone; + LONGINT fprint; + OPT_Struct typ; + OPT_Const conval; + LONGINT adr, linkadr; + INTEGER x; + } OPT_ObjDesc; + +typedef + struct OPT_StrDesc { + SHORTINT form, comp, mno, extlev; + INTEGER ref, sysflag; + LONGINT n, size, align, txtpos; + BOOLEAN allocated, pbused, pvused; + char _prvt0[8]; + LONGINT pbfp, pvfp; + OPT_Struct BaseTyp; + OPT_Object link, strobj; + } OPT_StrDesc; + + +import void (*OPT_typSize)(OPT_Struct); +import OPT_Object OPT_topScope; +import OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp; +import SHORTINT OPT_nofGmod; +import OPT_Object OPT_GlbMod[64]; +import OPS_Name OPT_SelfName; +import BOOLEAN OPT_SYSimported; + +import LONGINT *OPT_ConstDesc__typ; +import LONGINT *OPT_ObjDesc__typ; +import LONGINT *OPT_StrDesc__typ; +import LONGINT *OPT_NodeDesc__typ; + +import void OPT_Close (void); +import void OPT_CloseScope (void); +import void OPT_Export (BOOLEAN *ext, BOOLEAN *new); +import void OPT_FPrintErr (OPT_Object obj, INTEGER errcode); +import void OPT_FPrintObj (OPT_Object obj); +import void OPT_FPrintStr (OPT_Struct typ); +import void OPT_Find (OPT_Object *res); +import void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res); +import void OPT_FindImport (OPT_Object mod, OPT_Object *res); +import void OPT_IdFPrint (OPT_Struct typ); +import void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done); +import void OPT_Init (OPS_Name name, SET opt); +import void OPT_Insert (OPS_Name name, OPT_Object *obj); +import void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old); +import OPT_Const OPT_NewConst (void); +import OPT_ConstExt OPT_NewExt (void); +import OPT_Node OPT_NewNode (SHORTINT class); +import OPT_Object OPT_NewObj (void); +import OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp); +import void OPT_OpenScope (SHORTINT level, OPT_Object owner); +import void *OPT__init(void); + + +#endif diff --git a/bootstrap/unix-48/OPV.c b/bootstrap/unix-48/OPV.c new file mode 100644 index 00000000..572285dc --- /dev/null +++ b/bootstrap/unix-48/OPV.c @@ -0,0 +1,1688 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "OPC.h" +#include "OPM.h" +#include "OPS.h" +#include "OPT.h" + +typedef + struct OPV_ExitInfo { + INTEGER level, label; + } OPV_ExitInfo; + + +static BOOLEAN OPV_assert, OPV_inxchk, OPV_mainprog, OPV_ansi; +static INTEGER OPV_stamp; +static LONGINT OPV_recno; +static OPV_ExitInfo OPV_exit; +static INTEGER OPV_nofExitLabels; +static BOOLEAN OPV_naturalAlignment; + +export LONGINT *OPV_ExitInfo__typ; + +static void OPV_ActualPar (OPT_Node n, OPT_Object fp); +export void OPV_AdrAndSize (OPT_Object topScope); +static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc); +static void OPV_Convert (OPT_Node n, INTEGER form, INTEGER prec); +static void OPV_DefineTDescs (OPT_Node n); +static void OPV_Entier (OPT_Node n, INTEGER prec); +static void OPV_GetTProcNum (OPT_Object obj); +static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc); +static BOOLEAN OPV_ImplicitReturn (OPT_Node n); +static void OPV_Index (OPT_Node n, OPT_Node d, INTEGER prec, INTEGER dim); +export void OPV_Init (void); +static void OPV_InitTDescs (OPT_Node n); +static void OPV_Len (OPT_Node n, LONGINT dim); +export void OPV_Module (OPT_Node prog); +static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max); +static void OPV_NewArr (OPT_Node d, OPT_Node x); +static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp); +static BOOLEAN OPV_SideEffects (OPT_Node n); +static void OPV_Stamp (OPS_Name s); +static OPT_Object OPV_SuperProc (OPT_Node n); +static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported); +static void OPV_TraverseRecord (OPT_Struct typ); +export void OPV_TypSize (OPT_Struct typ); +static void OPV_TypeOf (OPT_Node n); +static void OPV_design (OPT_Node n, INTEGER prec); +static void OPV_expr (OPT_Node n, INTEGER prec); +static void OPV_stat (OPT_Node n, OPT_Object outerProc); + + +static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max) +{ + LONGINT _o_result; + LONGINT i; + if (size >= max) { + _o_result = max; + return _o_result; + } else { + i = 1; + while (i < size) { + i += i; + } + _o_result = i; + return _o_result; + } + __RETCHK; +} + +void OPV_TypSize (OPT_Struct typ) +{ + INTEGER f, c; + LONGINT offset, size, base, fbase, off0; + OPT_Object fld = NIL; + OPT_Struct btyp = NIL; + if (typ == OPT_undftyp) { + OPM_err(58); + } else if (typ->size == -1) { + f = typ->form; + c = typ->comp; + if (c == 4) { + btyp = typ->BaseTyp; + if (btyp == NIL) { + offset = 0; + base = OPM_RecAlign; + } else { + OPV_TypSize(btyp); + offset = btyp->size - (LONGINT)__ASHR(btyp->sysflag, 8); + base = btyp->align; + } + fld = typ->link; + while ((fld != NIL && fld->mode == 4)) { + btyp = fld->typ; + OPV_TypSize(btyp); + size = btyp->size; + fbase = OPC_Base(btyp); + OPC_Align(&offset, fbase); + fld->adr = offset; + offset += size; + if (fbase > base) { + base = fbase; + } + fld = fld->link; + } + off0 = offset; + if (offset == 0) { + offset = 1; + } + if (OPM_RecSize == 0) { + base = OPV_NaturalAlignment(offset, OPM_RecAlign); + } + OPC_Align(&offset, base); + if ((typ->strobj == NIL && __MASK(typ->align, -65536) == 0)) { + OPV_recno += 1; + base += __ASHL(OPV_recno, 16); + } + typ->size = offset; + typ->align = base; + typ->sysflag = __MASK(typ->sysflag, -256) + (int)__ASHL(offset - off0, 8); + } else if (c == 2) { + OPV_TypSize(typ->BaseTyp); + typ->size = typ->n * typ->BaseTyp->size; + } else if (f == 13) { + typ->size = OPM_PointerSize; + if (typ->BaseTyp == OPT_undftyp) { + OPM_Mark(128, typ->n); + } else { + OPV_TypSize(typ->BaseTyp); + } + } else if (f == 14) { + typ->size = OPM_ProcSize; + } else if (c == 3) { + btyp = typ->BaseTyp; + OPV_TypSize(btyp); + if (btyp->comp == 3) { + typ->size = btyp->size + 4; + } else { + typ->size = 8; + } + } + } +} + +void OPV_Init (void) +{ + OPV_stamp = 0; + OPV_recno = 0; + OPV_nofExitLabels = 0; + OPV_assert = __IN(7, OPM_opt); + OPV_inxchk = __IN(0, OPM_opt); + OPV_mainprog = __IN(10, OPM_opt); + OPV_ansi = __IN(6, OPM_opt); +} + +static void OPV_GetTProcNum (OPT_Object obj) +{ + LONGINT oldPos; + OPT_Struct typ = NIL; + OPT_Object redef = NIL; + oldPos = OPM_errpos; + OPM_errpos = obj->scope->adr; + typ = obj->link->typ; + if (typ->form == 13) { + typ = typ->BaseTyp; + } + OPT_FindField(obj->name, typ->BaseTyp, &redef); + if (redef != NIL) { + obj->adr = __ASHL(__ASHR(redef->adr, 16), 16); + if (!__IN(2, obj->conval->setval)) { + OPM_err(119); + } + } else { + obj->adr += __ASHL(typ->n, 16); + typ->n += 1; + } + OPM_errpos = oldPos; +} + +static void OPV_TraverseRecord (OPT_Struct typ) +{ + if (!typ->allocated) { + if (typ->BaseTyp != NIL) { + OPV_TraverseRecord(typ->BaseTyp); + typ->n = typ->BaseTyp->n; + } + typ->allocated = 1; + OPV_Traverse(typ->link, typ->strobj, 0); + } +} + +static void OPV_Stamp (OPS_Name s) +{ + INTEGER i, j, k; + CHAR n[10]; + OPV_stamp += 1; + i = 0; + j = OPV_stamp; + while (s[__X(i, ((LONGINT)(256)))] != 0x00) { + i += 1; + } + if (i > 25) { + i = 25; + } + s[__X(i, ((LONGINT)(256)))] = '_'; + s[__X(i + 1, ((LONGINT)(256)))] = '_'; + i += 2; + k = 0; + do { + n[__X(k, ((LONGINT)(10)))] = (CHAR)((int)__MOD(j, 10) + 48); + j = __DIV(j, 10); + k += 1; + } while (!(j == 0)); + do { + k -= 1; + s[__X(i, ((LONGINT)(256)))] = n[__X(k, ((LONGINT)(10)))]; + i += 1; + } while (!(k == 0)); + s[__X(i, ((LONGINT)(256)))] = 0x00; +} + +static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported) +{ + INTEGER mode; + OPT_Object scope = NIL; + OPT_Struct typ = NIL; + if (obj != NIL) { + OPV_Traverse(obj->left, outerScope, exported); + if (obj->name[0] == '@') { + obj->name[0] = '_'; + OPV_Stamp(obj->name); + } + obj->linkadr = 0; + mode = obj->mode; + if ((mode == 5 && (obj->vis != 0) == exported)) { + typ = obj->typ; + OPV_TypSize(obj->typ); + if (typ->form == 13) { + typ = typ->BaseTyp; + } + if (typ->comp == 4) { + OPV_TraverseRecord(typ); + } + } else if (mode == 13) { + OPV_GetTProcNum(obj); + } else if (mode == 1) { + OPV_TypSize(obj->typ); + } + if (!exported) { + if ((__IN(mode, 0x60) && obj->mnolev > 0)) { + OPV_Stamp(obj->name); + } + if (__IN(mode, 0x26)) { + obj->scope = outerScope; + } else if (__IN(mode, 0x26c0)) { + if (obj->conval->setval == 0x0) { + OPM_err(129); + } + scope = obj->scope; + scope->leaf = 1; + __COPY(obj->name, scope->name, ((LONGINT)(256))); + OPV_Stamp(scope->name); + if (mode == 9) { + obj->adr = 1; + } + if (scope->mnolev > 1) { + outerScope->leaf = 0; + } + OPV_Traverse(obj->scope->right, obj->scope, 0); + } + } + OPV_Traverse(obj->right, outerScope, exported); + } +} + +void OPV_AdrAndSize (OPT_Object topScope) +{ + OPM_errpos = topScope->adr; + topScope->leaf = 1; + OPV_Traverse(topScope->right, topScope, 1); + OPV_Traverse(topScope->right, topScope, 0); + OPT_chartyp->strobj->linkadr = 2; + OPT_settyp->strobj->linkadr = 2; + OPT_realtyp->strobj->linkadr = 2; + OPT_inttyp->strobj->linkadr = 2; + OPT_linttyp->strobj->linkadr = 2; + OPT_lrltyp->strobj->linkadr = 2; + OPT_sinttyp->strobj->linkadr = 2; + OPT_booltyp->strobj->linkadr = 2; + OPT_bytetyp->strobj->linkadr = 2; + OPT_sysptrtyp->strobj->linkadr = 2; +} + +static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp) +{ + INTEGER _o_result; + switch (class) { + case 7: case 0: case 2: case 4: case 9: + case 13: + _o_result = 10; + return _o_result; + break; + case 5: + if (__IN(3, OPM_opt)) { + _o_result = 10; + return _o_result; + } else { + _o_result = 9; + return _o_result; + } + break; + case 1: + if (__IN(comp, 0x0c)) { + _o_result = 10; + return _o_result; + } else { + _o_result = 9; + return _o_result; + } + break; + case 3: + _o_result = 9; + return _o_result; + break; + case 11: + switch (subclass) { + case 33: case 7: case 24: case 29: case 20: + _o_result = 9; + return _o_result; + break; + case 16: case 21: case 22: case 23: case 25: + _o_result = 10; + return _o_result; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence Nmop, subclass = ", (LONGINT)51); + OPM_LogWNum(subclass, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + break; + case 12: + switch (subclass) { + case 1: + if (form == 9) { + _o_result = 4; + return _o_result; + } else { + _o_result = 8; + return _o_result; + } + break; + case 2: + if (form == 9) { + _o_result = 3; + return _o_result; + } else { + _o_result = 8; + return _o_result; + } + break; + case 3: case 4: + _o_result = 10; + return _o_result; + break; + case 6: + if (form == 9) { + _o_result = 2; + return _o_result; + } else { + _o_result = 7; + return _o_result; + } + break; + case 7: + if (form == 9) { + _o_result = 4; + return _o_result; + } else { + _o_result = 7; + return _o_result; + } + break; + case 11: case 12: case 13: case 14: + _o_result = 6; + return _o_result; + break; + case 9: case 10: + _o_result = 5; + return _o_result; + break; + case 5: + _o_result = 1; + return _o_result; + break; + case 8: + _o_result = 0; + return _o_result; + break; + case 19: case 15: case 17: case 18: case 26: + case 27: case 28: + _o_result = 10; + return _o_result; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence Ndop, subclass = ", (LONGINT)51); + OPM_LogWNum(subclass, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + break; + case 10: + _o_result = 10; + return _o_result; + break; + case 8: case 6: + _o_result = 12; + return _o_result; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence, class = ", (LONGINT)43); + OPM_LogWNum(class, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + __RETCHK; +} + +static void OPV_Len (OPT_Node n, LONGINT dim) +{ + while ((n->class == 4 && n->typ->comp == 3)) { + dim += 1; + n = n->left; + } + if ((n->class == 3 && n->typ->comp == 3)) { + OPV_design(n->left, 10); + OPM_WriteString((CHAR*)"->len[", (LONGINT)7); + OPM_WriteInt(dim); + OPM_Write(']'); + } else { + OPC_Len(n->obj, n->typ, dim); + } +} + +static BOOLEAN OPV_SideEffects (OPT_Node n) +{ + BOOLEAN _o_result; + if (n != NIL) { + _o_result = (n->class == 13 || OPV_SideEffects(n->left)) || OPV_SideEffects(n->right); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +static void OPV_Entier (OPT_Node n, INTEGER prec) +{ + if (__IN(n->typ->form, 0x0180)) { + OPM_WriteString((CHAR*)"__ENTIER(", (LONGINT)10); + OPV_expr(n, -1); + OPM_Write(')'); + } else { + OPV_expr(n, prec); + } +} + +static void OPV_Convert (OPT_Node n, INTEGER form, INTEGER prec) +{ + INTEGER from; + from = n->typ->form; + if (form == 9) { + OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9); + OPV_Entier(n, -1); + OPM_Write(')'); + } else if (form == 6) { + if (from < 6) { + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + } + OPV_Entier(n, 9); + } else if (form == 5) { + if (from < 5) { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + OPV_expr(n, 9); + } else { + if (__IN(2, OPM_opt)) { + OPM_WriteString((CHAR*)"__SHORT", (LONGINT)8); + if (OPV_SideEffects(n)) { + OPM_Write('F'); + } + OPM_Write('('); + OPV_Entier(n, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(OPM_MaxInt + 1); + OPM_Write(')'); + } else { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + OPV_Entier(n, 9); + } + } + } else if (form == 4) { + if (__IN(2, OPM_opt)) { + OPM_WriteString((CHAR*)"__SHORT", (LONGINT)8); + if (OPV_SideEffects(n)) { + OPM_Write('F'); + } + OPM_Write('('); + OPV_Entier(n, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(OPM_MaxSInt + 1); + OPM_Write(')'); + } else { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + OPV_Entier(n, 9); + } + } else if (form == 3) { + if (__IN(2, OPM_opt)) { + OPM_WriteString((CHAR*)"__CHR", (LONGINT)6); + if (OPV_SideEffects(n)) { + OPM_Write('F'); + } + OPM_Write('('); + OPV_Entier(n, -1); + OPM_Write(')'); + } else { + OPM_WriteString((CHAR*)"(CHAR)", (LONGINT)7); + OPV_Entier(n, 9); + } + } else { + OPV_expr(n, prec); + } +} + +static void OPV_TypeOf (OPT_Node n) +{ + if (n->typ->form == 13) { + OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10); + OPV_expr(n, -1); + OPM_Write(')'); + } else if (__IN(n->class, 0x15)) { + OPC_Andent(n->typ); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } else if (n->class == 3) { + OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10); + OPV_expr(n->left, -1); + OPM_Write(')'); + } else if (n->class == 5) { + OPV_TypeOf(n->left); + } else if ((n->class == 11 && n->subcl == 29)) { + OPC_TypeOf(n->left->obj); + } else { + OPC_TypeOf(n->obj); + } +} + +static void OPV_Index (OPT_Node n, OPT_Node d, INTEGER prec, INTEGER dim) +{ + if (!OPV_inxchk || (n->right->class == 7 && (n->right->conval->intval == 0 || n->left->typ->comp != 3))) { + OPV_expr(n->right, prec); + } else { + if (OPV_SideEffects(n->right)) { + OPM_WriteString((CHAR*)"__XF(", (LONGINT)6); + } else { + OPM_WriteString((CHAR*)"__X(", (LONGINT)5); + } + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_Len(d, dim); + OPM_Write(')'); + } +} + +static void OPV_design (OPT_Node n, INTEGER prec) +{ + OPT_Object obj = NIL; + OPT_Struct typ = NIL; + INTEGER class, designPrec, comp; + OPT_Node d = NIL, x = NIL; + INTEGER dims, i, _for__26; + comp = n->typ->comp; + obj = n->obj; + class = n->class; + designPrec = OPV_Precedence(class, n->subcl, n->typ->form, comp); + if ((((((class == 0 && obj->mnolev > 0)) && (int)obj->mnolev != OPM_level)) && prec == 10)) { + designPrec = 9; + } + if (prec > designPrec) { + OPM_Write('('); + } + if (prec == 11) { + OPM_Write('*'); + } + switch (class) { + case 9: + OPC_Ident(n->obj); + break; + case 0: + OPC_CompleteIdent(n->obj); + break; + case 1: + if (!__IN(comp, 0x0c)) { + OPM_Write('*'); + } + OPC_CompleteIdent(n->obj); + break; + case 2: + if (n->left->class == 3) { + OPV_design(n->left->left, designPrec); + OPM_WriteString((CHAR*)"->", (LONGINT)3); + } else { + OPV_design(n->left, designPrec); + OPM_Write('.'); + } + OPC_Ident(n->obj); + break; + case 3: + if (n->typ->comp == 3) { + OPV_design(n->left, 10); + OPM_WriteString((CHAR*)"->data", (LONGINT)7); + } else { + OPM_Write('*'); + OPV_design(n->left, designPrec); + } + break; + case 4: + d = n->left; + if (d->typ->comp == 3) { + dims = 0; + while (d->class == 4) { + d = d->left; + dims += 1; + } + if (n->typ->comp == 3) { + OPM_Write('&'); + } + OPV_design(d, designPrec); + OPM_Write('['); + if (n->typ->comp == 3) { + OPM_Write('('); + } + i = dims; + x = n; + while (x != d) { + if (x->left != d) { + OPV_Index(x, d, 7, i); + OPM_WriteString((CHAR*)" + ", (LONGINT)4); + OPV_Len(d, i); + OPM_WriteString((CHAR*)" * (", (LONGINT)5); + i -= 1; + } else { + OPV_Index(x, d, -1, i); + } + x = x->left; + } + _for__26 = dims; + i = 1; + while (i <= _for__26) { + OPM_Write(')'); + i += 1; + } + if (n->typ->comp == 3) { + OPM_Write(')'); + while ((LONGINT)i < __ASHR(d->typ->size - 4, 2)) { + OPM_WriteString((CHAR*)" * ", (LONGINT)4); + OPV_Len(d, i); + i += 1; + } + } + OPM_Write(']'); + } else { + OPV_design(n->left, designPrec); + OPM_Write('['); + OPV_Index(n, n->left, -1, 0); + OPM_Write(']'); + } + break; + case 5: + typ = n->typ; + obj = n->left->obj; + if (__IN(3, OPM_opt)) { + if (typ->comp == 4) { + OPM_WriteString((CHAR*)"__GUARDR(", (LONGINT)10); + if ((int)obj->mnolev != OPM_level) { + OPM_WriteStringVar((void*)obj->scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"__curr->", (LONGINT)9); + OPC_Ident(obj); + } else { + OPC_Ident(obj); + } + } else { + if (typ->BaseTyp->strobj == NIL) { + OPM_WriteString((CHAR*)"__GUARDA(", (LONGINT)10); + } else { + OPM_WriteString((CHAR*)"__GUARDP(", (LONGINT)10); + } + OPV_expr(n->left, -1); + typ = typ->BaseTyp; + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(typ); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(typ->extlev); + OPM_Write(')'); + } else { + if (typ->comp == 4) { + OPM_WriteString((CHAR*)"*(", (LONGINT)3); + OPC_Ident(typ->strobj); + OPM_WriteString((CHAR*)"*)", (LONGINT)3); + OPC_CompleteIdent(obj); + } else { + OPM_Write('('); + OPC_Ident(typ->strobj); + OPM_Write(')'); + OPV_expr(n->left, designPrec); + } + } + break; + case 6: + if (__IN(3, OPM_opt)) { + if (n->left->class == 1) { + OPM_WriteString((CHAR*)"__GUARDEQR(", (LONGINT)12); + OPC_CompleteIdent(n->left->obj); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_TypeOf(n->left); + } else { + OPM_WriteString((CHAR*)"__GUARDEQP(", (LONGINT)12); + OPV_expr(n->left->left, -1); + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(n->left->typ->strobj); + OPM_Write(')'); + } else { + OPV_expr(n->left, -1); + } + break; + case 11: + if (n->subcl == 29) { + OPV_design(n->left, prec); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.design, class = ", (LONGINT)39); + OPM_LogWNum(class, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + if (prec > designPrec) { + OPM_Write(')'); + } +} + +static void OPV_ActualPar (OPT_Node n, OPT_Object fp) +{ + OPT_Struct typ = NIL, aptyp = NIL; + INTEGER comp, form, mode, prec, dim; + OPM_Write('('); + while (n != NIL) { + typ = fp->typ; + comp = typ->comp; + form = typ->form; + mode = fp->mode; + prec = -1; + if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) { + OPM_Write('('); + OPC_Ident(n->typ->strobj); + OPM_WriteString((CHAR*)"*)", (LONGINT)3); + prec = 10; + } + if (!__IN(n->typ->comp, 0x0c)) { + if (mode == 2) { + if ((OPV_ansi && typ != n->typ)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } + OPM_Write('&'); + prec = 9; + } else if (OPV_ansi) { + if ((__IN(comp, 0x0c) && n->class == 7)) { + OPM_WriteString((CHAR*)"(CHAR*)", (LONGINT)8); + } else if ((((form == 13 && typ != n->typ)) && n->typ != OPT_niltyp)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } + } else { + if ((__IN(form, 0x0180) && __IN(n->typ->form, 0x70))) { + OPM_WriteString((CHAR*)"(double)", (LONGINT)9); + prec = 9; + } else if ((form == 6 && n->typ->form < 6)) { + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + prec = 9; + } + } + } else if (OPV_ansi) { + if ((((mode == 2 && typ != n->typ)) && prec == -1)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } + } + if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) { + OPV_expr(n->left, prec); + } else if ((((((form == 6 && n->class == 7)) && n->conval->intval <= OPM_MaxInt)) && n->conval->intval >= OPM_MinInt)) { + OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12); + OPV_expr(n, prec); + OPM_WriteString((CHAR*)"))", (LONGINT)3); + } else { + OPV_expr(n, prec); + } + if ((comp == 4 && mode == 2)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_TypeOf(n); + } else if (comp == 3) { + if (n->class == 7) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + OPM_WriteInt(n->conval->intval2); + } else { + aptyp = n->typ; + dim = 0; + while ((typ->comp == 3 && typ->BaseTyp->form != 1)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_Len(n, dim); + typ = typ->BaseTyp; + aptyp = aptyp->BaseTyp; + dim += 1; + } + if ((typ->comp == 3 && typ->BaseTyp->form == 1)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + while (aptyp->comp == 3) { + OPV_Len(n, dim); + OPM_WriteString((CHAR*)" * ", (LONGINT)4); + dim += 1; + aptyp = aptyp->BaseTyp; + } + OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12); + OPM_WriteInt(aptyp->size); + OPM_WriteString((CHAR*)"))", (LONGINT)3); + } + } + } + n = n->link; + fp = fp->link; + if (n != NIL) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + } + } + OPM_Write(')'); +} + +static OPT_Object OPV_SuperProc (OPT_Node n) +{ + OPT_Object _o_result; + OPT_Object obj = NIL; + OPT_Struct typ = NIL; + typ = n->right->typ; + if (typ->form == 13) { + typ = typ->BaseTyp; + } + OPT_FindField(n->left->obj->name, typ->BaseTyp, &obj); + _o_result = obj; + return _o_result; +} + +static void OPV_expr (OPT_Node n, INTEGER prec) +{ + INTEGER class, subclass, form, exprPrec; + OPT_Struct typ = NIL; + OPT_Node l = NIL, r = NIL; + OPT_Object proc = NIL; + class = n->class; + subclass = n->subcl; + form = n->typ->form; + l = n->left; + r = n->right; + exprPrec = OPV_Precedence(class, subclass, form, n->typ->comp); + if ((exprPrec <= prec && __IN(class, 0x3ce0))) { + OPM_Write('('); + } + switch (class) { + case 7: + OPC_Constant(n->conval, form); + break; + case 10: + OPM_WriteString((CHAR*)"__SETRNG(", (LONGINT)10); + OPV_expr(l, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(r, -1); + OPM_Write(')'); + break; + case 11: + switch (subclass) { + case 33: + OPM_Write('!'); + OPV_expr(l, exprPrec); + break; + case 7: + if (form == 9) { + OPM_Write('~'); + } else { + OPM_Write('-'); + } + OPV_expr(l, exprPrec); + break; + case 16: + typ = n->obj->typ; + if (l->typ->comp == 4) { + OPM_WriteString((CHAR*)"__IS(", (LONGINT)6); + OPC_TypeOf(l->obj); + } else { + OPM_WriteString((CHAR*)"__ISP(", (LONGINT)7); + OPV_expr(l, -1); + typ = typ->BaseTyp; + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(typ); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(typ->extlev); + OPM_Write(')'); + break; + case 20: + OPV_Convert(l, form, exprPrec); + break; + case 21: + if (OPV_SideEffects(l)) { + if (l->typ->form < 7) { + if (l->typ->form < 6) { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + } + OPM_WriteString((CHAR*)"__ABSF(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ABSFD(", (LONGINT)9); + } + } else { + OPM_WriteString((CHAR*)"__ABS(", (LONGINT)7); + } + OPV_expr(l, -1); + OPM_Write(')'); + break; + case 22: + OPM_WriteString((CHAR*)"__CAP(", (LONGINT)7); + OPV_expr(l, -1); + OPM_Write(')'); + break; + case 23: + OPM_WriteString((CHAR*)"__ODD(", (LONGINT)7); + OPV_expr(l, -1); + OPM_Write(')'); + break; + case 24: + OPM_WriteString((CHAR*)"(LONGINT)(uintptr_t)", (LONGINT)21); + if (l->class == 1) { + OPC_CompleteIdent(l->obj); + } else { + if ((l->typ->form != 10 && !__IN(l->typ->comp, 0x0c))) { + OPM_Write('&'); + } + OPV_expr(l, exprPrec); + } + break; + case 29: + if ((((__IN(n->typ->form, 0x6240) && __IN(l->typ->form, 0x6240))) && n->typ->size == l->typ->size) || !__IN(l->class, 0x17)) { + OPM_Write('('); + OPC_Ident(n->typ->strobj); + OPM_Write(')'); + if (__IN(n->typ->form, 0x6000) || __IN(l->typ->form, 0x6000)) { + OPM_WriteString((CHAR*)"(uintptr_t)", (LONGINT)12); + } + OPV_expr(l, exprPrec); + } else { + if (__IN(n->typ->form, 0x6000) || __IN(l->typ->form, 0x6000)) { + OPM_WriteString((CHAR*)"__VALP(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__VAL(", (LONGINT)7); + } + OPC_Ident(n->typ->strobj); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(l, -1); + OPM_Write(')'); + } + break; + default: + OPM_err(200); + break; + } + break; + case 12: + switch (subclass) { + case 19: + OPV_Len(l, r->conval->intval); + break; + case 15: case 17: case 18: case 26: case 27: + case 28: case 3: case 4: + switch (subclass) { + case 15: + OPM_WriteString((CHAR*)"__IN(", (LONGINT)6); + break; + case 17: + if (r->class == 7) { + if (r->conval->intval >= 0) { + OPM_WriteString((CHAR*)"__ASHL(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ASHR(", (LONGINT)8); + } + } else if (OPV_SideEffects(r)) { + OPM_WriteString((CHAR*)"__ASHF(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ASH(", (LONGINT)7); + } + break; + case 18: + OPM_WriteString((CHAR*)"__MASK(", (LONGINT)8); + break; + case 26: + OPM_WriteString((CHAR*)"__BIT(", (LONGINT)7); + break; + case 27: + if (r->class == 7) { + if (r->conval->intval >= 0) { + OPM_WriteString((CHAR*)"__LSHL(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__LSHR(", (LONGINT)8); + } + } else { + OPM_WriteString((CHAR*)"__LSH(", (LONGINT)7); + } + break; + case 28: + if (r->class == 7) { + if (r->conval->intval >= 0) { + OPM_WriteString((CHAR*)"__ROTL(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ROTR(", (LONGINT)8); + } + } else { + OPM_WriteString((CHAR*)"__ROT(", (LONGINT)7); + } + break; + case 3: + if (OPV_SideEffects(n)) { + if (form < 6) { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + } + OPM_WriteString((CHAR*)"__DIVF(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__DIV(", (LONGINT)7); + } + break; + case 4: + if (form < 6) { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + } + if (OPV_SideEffects(n)) { + OPM_WriteString((CHAR*)"__MODF(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__MOD(", (LONGINT)7); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", (LONGINT)40); + OPM_LogWNum(subclass, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + OPV_expr(l, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if ((((__IN(subclass, 0x18020000) && r->class == 7)) && r->conval->intval < 0)) { + OPM_WriteInt(-r->conval->intval); + } else { + OPV_expr(r, -1); + } + if (__IN(subclass, 0x18000000)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(l->typ->strobj); + } + OPM_Write(')'); + break; + case 9: case 10: case 11: case 12: case 13: + case 14: + if (__IN(l->typ->form, 0x8400)) { + OPM_WriteString((CHAR*)"__STRCMP(", (LONGINT)10); + OPV_expr(l, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(r, -1); + OPM_Write(')'); + OPC_Cmp(subclass); + OPM_Write('0'); + } else { + OPV_expr(l, exprPrec); + OPC_Cmp(subclass); + typ = l->typ; + if ((((((typ->form == 13 && r->typ->form != 11)) && r->typ != typ)) && r->typ != OPT_sysptrtyp)) { + OPM_WriteString((CHAR*)"(void *) ", (LONGINT)10); + } + OPV_expr(r, exprPrec); + } + break; + default: + if (subclass == 5 || (form == 9 && (subclass == 1 || subclass == 7))) { + OPM_Write('('); + } + OPV_expr(l, exprPrec); + switch (subclass) { + case 1: + if (form == 9) { + OPM_WriteString((CHAR*)" & ", (LONGINT)4); + } else { + OPM_WriteString((CHAR*)" * ", (LONGINT)4); + } + break; + case 2: + if (form == 9) { + OPM_WriteString((CHAR*)" ^ ", (LONGINT)4); + } else { + OPM_WriteString((CHAR*)" / ", (LONGINT)4); + if (r->obj == NIL || __IN(r->obj->typ->form, 0x70)) { + OPM_Write('('); + OPC_Ident(n->typ->strobj); + OPM_Write(')'); + } + } + break; + case 5: + OPM_WriteString((CHAR*)" && ", (LONGINT)5); + break; + case 6: + if (form == 9) { + OPM_WriteString((CHAR*)" | ", (LONGINT)4); + } else { + OPM_WriteString((CHAR*)" + ", (LONGINT)4); + } + break; + case 7: + if (form == 9) { + OPM_WriteString((CHAR*)" & ~", (LONGINT)5); + } else { + OPM_WriteString((CHAR*)" - ", (LONGINT)4); + } + break; + case 8: + OPM_WriteString((CHAR*)" || ", (LONGINT)5); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", (LONGINT)40); + OPM_LogWNum(subclass, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + OPV_expr(r, exprPrec); + if (subclass == 5 || (form == 9 && (subclass == 1 || subclass == 7))) { + OPM_Write(')'); + } + break; + } + break; + case 13: + if ((l->obj != NIL && l->obj->mode == 13)) { + if (l->subcl == 1) { + proc = OPV_SuperProc(n); + } else { + OPM_WriteString((CHAR*)"__", (LONGINT)3); + proc = OPC_BaseTProc(l->obj); + } + OPC_Ident(proc); + n->obj = proc->link; + } else if (l->class == 9) { + OPV_design(l, 10); + } else { + OPV_design(l, 11); + } + OPV_ActualPar(r, n->obj); + break; + default: + OPV_design(n, prec); + break; + } + if ((exprPrec <= prec && __IN(class, 0x3ca0))) { + OPM_Write(')'); + } +} + +static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc) +{ + OPT_Node if_ = NIL; + OPT_Object obj = NIL; + OPT_Struct typ = NIL; + LONGINT adr; + if_ = n->left; + while (if_ != NIL) { + OPM_WriteString((CHAR*)"if ", (LONGINT)4); + OPV_expr(if_->left, 12); + OPM_Write(' '); + OPC_BegBlk(); + if ((n->class == 27 && if_->left->left != NIL)) { + obj = if_->left->left->obj; + typ = obj->typ; + adr = obj->adr; + if (typ->comp == 4) { + OPC_BegStat(); + OPC_Ident(if_->left->obj); + OPM_WriteString((CHAR*)" *", (LONGINT)3); + OPM_WriteString(obj->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"__ = (void*)", (LONGINT)13); + obj->adr = 0; + OPC_CompleteIdent(obj); + OPC_EndStat(); + } + obj->adr = 1; + obj->typ = if_->left->obj->typ; + OPV_stat(if_->right, outerProc); + obj->typ = typ; + obj->adr = adr; + } else { + OPV_stat(if_->right, outerProc); + } + if_ = if_->link; + if ((if_ != NIL || n->right != NIL) || withtrap) { + OPC_EndBlk0(); + OPM_WriteString((CHAR*)" else ", (LONGINT)7); + } else { + OPC_EndBlk(); + } + } + if (withtrap) { + OPM_WriteString((CHAR*)"__WITHCHK", (LONGINT)10); + OPC_EndStat(); + } else if (n->right != NIL) { + OPC_BegBlk(); + OPV_stat(n->right, outerProc); + OPC_EndBlk(); + } +} + +static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc) +{ + OPT_Node switchCase = NIL, label = NIL; + LONGINT low, high; + INTEGER form, i; + OPM_WriteString((CHAR*)"switch ", (LONGINT)8); + OPV_expr(n->left, 12); + OPM_Write(' '); + OPC_BegBlk(); + form = n->left->typ->form; + switchCase = n->right->left; + while (switchCase != NIL) { + label = switchCase->left; + i = 0; + while (label != NIL) { + low = label->conval->intval; + high = label->conval->intval2; + while (low <= high) { + if (i == 0) { + OPC_BegStat(); + } + OPC_Case(low, form); + low += 1; + i += 1; + if (i == 5) { + OPM_WriteLn(); + i = 0; + } + } + label = label->link; + } + if (i > 0) { + OPM_WriteLn(); + } + OPC_Indent(1); + OPV_stat(switchCase->right, outerProc); + OPC_BegStat(); + OPM_WriteString((CHAR*)"break", (LONGINT)6); + OPC_EndStat(); + OPC_Indent(-1); + switchCase = switchCase->link; + } + OPC_BegStat(); + OPM_WriteString((CHAR*)"default: ", (LONGINT)10); + if (n->right->conval->setval != 0x0) { + OPC_Indent(1); + OPM_WriteLn(); + OPV_stat(n->right->right, outerProc); + OPC_BegStat(); + OPM_WriteString((CHAR*)"break", (LONGINT)6); + OPC_Indent(-1); + } else { + OPM_WriteString((CHAR*)"__CASECHK", (LONGINT)10); + } + OPC_EndStat(); + OPC_EndBlk(); +} + +static BOOLEAN OPV_ImplicitReturn (OPT_Node n) +{ + BOOLEAN _o_result; + while ((n != NIL && n->class != 26)) { + n = n->link; + } + _o_result = n == NIL; + return _o_result; +} + +static void OPV_NewArr (OPT_Node d, OPT_Node x) +{ + OPT_Struct typ = NIL, base = NIL; + INTEGER nofdim, nofdyn; + typ = d->typ->BaseTyp; + base = typ; + nofdim = 0; + nofdyn = 0; + while (base->comp == 3) { + nofdim += 1; + nofdyn += 1; + base = base->BaseTyp; + } + OPV_design(d, -1); + OPM_WriteString((CHAR*)" = __NEWARR(", (LONGINT)13); + while (base->comp == 2) { + nofdim += 1; + base = base->BaseTyp; + } + if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) { + OPC_Ident(base->strobj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } else if (base->form == 13) { + OPM_WriteString((CHAR*)"POINTER__typ", (LONGINT)13); + } else { + OPM_WriteString((CHAR*)"NIL", (LONGINT)4); + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12); + OPM_WriteInt(base->size); + OPM_WriteString((CHAR*)"))", (LONGINT)3); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(OPC_Base(base)); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(nofdim); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(nofdyn); + while (typ != base) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (typ->comp == 3) { + if (x->class == 7) { + OPM_WriteString((CHAR*)"(LONGINT)(", (LONGINT)11); + OPV_expr(x, -1); + OPM_WriteString((CHAR*)")", (LONGINT)2); + } else { + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + OPV_expr(x, 10); + } + x = x->link; + } else { + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + OPM_WriteInt(typ->n); + } + typ = typ->BaseTyp; + } + OPM_Write(')'); +} + +static void OPV_DefineTDescs (OPT_Node n) +{ + while ((n != NIL && n->class == 14)) { + OPC_TDescDecl(n->typ); + n = n->link; + } +} + +static void OPV_InitTDescs (OPT_Node n) +{ + while ((n != NIL && n->class == 14)) { + OPC_InitTDesc(n->typ); + n = n->link; + } +} + +static void OPV_stat (OPT_Node n, OPT_Object outerProc) +{ + OPT_Object proc = NIL; + OPV_ExitInfo saved; + OPT_Node l = NIL, r = NIL; + while ((n != NIL && OPM_noerr)) { + OPM_errpos = n->conval->intval; + if (n->class != 14) { + OPC_BegStat(); + } + switch (n->class) { + case 18: + if (n->obj == NIL) { + OPM_level += 1; + OPV_stat(n->left, outerProc); + OPM_level -= 1; + OPC_GenEnumPtrs(OPT_topScope->scope); + OPV_DefineTDescs(n->right); + OPC_EnterBody(); + OPV_InitTDescs(n->right); + OPM_WriteString((CHAR*)"/* BEGIN */", (LONGINT)12); + OPM_WriteLn(); + OPV_stat(n->right, outerProc); + OPC_ExitBody(); + } else { + proc = n->obj; + OPC_TypeDefs(proc->scope->right, 0); + if (!proc->scope->leaf) { + OPC_DefineInter(proc); + } + OPM_level += 1; + OPV_stat(n->left, proc); + OPM_level -= 1; + OPC_EnterProc(proc); + OPV_stat(n->right, proc); + OPC_ExitProc(proc, 1, OPV_ImplicitReturn(n->right)); + } + break; + case 14: + break; + case 19: + switch (n->subcl) { + case 0: + l = n->left; + r = n->right; + if (l->typ->comp == 2) { + OPM_WriteString((CHAR*)"__MOVE(", (LONGINT)8); + OPV_expr(r, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(l, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (r->typ == OPT_stringtyp) { + OPM_WriteInt(r->conval->intval2); + } else { + OPM_WriteInt(r->typ->size); + } + OPM_Write(')'); + } else { + if ((((((l->typ->form == 13 && l->obj != NIL)) && l->obj->adr == 1)) && l->obj->mode == 1)) { + l->obj->adr = 0; + OPV_design(l, -1); + l->obj->adr = 1; + if (r->typ->form != 11) { + OPM_WriteString((CHAR*)" = (void*)", (LONGINT)11); + } else { + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + } + } else { + OPV_design(l, -1); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + } + if (l->typ == r->typ) { + OPV_expr(r, -1); + } else if ((((l->typ->form == 13 && r->typ->form != 11)) && l->typ->strobj != NIL)) { + OPM_Write('('); + OPC_Ident(l->typ->strobj); + OPM_Write(')'); + OPV_expr(r, -1); + } else if (l->typ->comp == 4) { + OPM_WriteString((CHAR*)"*(", (LONGINT)3); + OPC_Andent(l->typ); + OPM_WriteString((CHAR*)"*)&", (LONGINT)4); + OPV_expr(r, 9); + } else { + OPV_expr(r, -1); + } + } + break; + case 1: + if (n->left->typ->BaseTyp->comp == 4) { + OPM_WriteString((CHAR*)"__NEW(", (LONGINT)7); + OPV_design(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(n->left->typ->BaseTyp); + OPM_WriteString((CHAR*)")", (LONGINT)2); + } else if (__IN(n->left->typ->BaseTyp->comp, 0x0c)) { + OPV_NewArr(n->left, n->right); + } + break; + case 13: case 14: + OPV_expr(n->left, -1); + OPC_Increment(n->subcl == 14); + OPV_expr(n->right, -1); + break; + case 15: case 16: + OPV_expr(n->left, -1); + OPC_SetInclude(n->subcl == 16); + OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9); + OPV_expr(n->right, -1); + OPM_Write(')'); + break; + case 18: + OPM_WriteString((CHAR*)"__COPY(", (LONGINT)8); + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_Len(n->left, ((LONGINT)(0))); + OPM_Write(')'); + break; + case 31: + OPM_WriteString((CHAR*)"__MOVE(", (LONGINT)8); + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->right->link, -1); + OPM_Write(')'); + break; + case 24: + OPM_WriteString((CHAR*)"__GET(", (LONGINT)7); + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(n->left->typ->strobj); + OPM_Write(')'); + break; + case 25: + OPM_WriteString((CHAR*)"__PUT(", (LONGINT)7); + OPV_expr(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(n->right->typ->strobj); + OPM_Write(')'); + break; + case 26: case 27: + OPM_err(200); + break; + case 30: + OPM_WriteString((CHAR*)"__SYSNEW(", (LONGINT)10); + OPV_design(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->right, -1); + OPM_Write(')'); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.subcl = ", (LONGINT)40); + OPM_LogWNum(n->subcl, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + break; + case 13: + if ((n->left->obj != NIL && n->left->obj->mode == 13)) { + if (n->left->subcl == 1) { + proc = OPV_SuperProc(n); + } else { + OPM_WriteString((CHAR*)"__", (LONGINT)3); + proc = OPC_BaseTProc(n->left->obj); + } + OPC_Ident(proc); + n->obj = proc->link; + } else if (n->left->class == 9) { + OPV_design(n->left, 10); + } else { + OPV_design(n->left, 11); + } + OPV_ActualPar(n->right, n->obj); + break; + case 20: + if (n->subcl != 32) { + OPV_IfStat(n, 0, outerProc); + } else if (OPV_assert) { + OPM_WriteString((CHAR*)"__ASSERT(", (LONGINT)10); + OPV_expr(n->left->left->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(n->left->right->right->conval->intval); + OPM_Write(')'); + OPC_EndStat(); + } + break; + case 21: + OPV_exit.level += 1; + OPV_CaseStat(n, outerProc); + OPV_exit.level -= 1; + break; + case 22: + OPV_exit.level += 1; + OPM_WriteString((CHAR*)"while ", (LONGINT)7); + OPV_expr(n->left, 12); + OPM_Write(' '); + OPC_BegBlk(); + OPV_stat(n->right, outerProc); + OPC_EndBlk(); + OPV_exit.level -= 1; + break; + case 23: + OPV_exit.level += 1; + OPM_WriteString((CHAR*)"do ", (LONGINT)4); + OPC_BegBlk(); + OPV_stat(n->left, outerProc); + OPC_EndBlk0(); + OPM_WriteString((CHAR*)" while (!", (LONGINT)10); + OPV_expr(n->right, 9); + OPM_Write(')'); + OPV_exit.level -= 1; + break; + case 24: + saved = OPV_exit; + OPV_exit.level = 0; + OPV_exit.label = -1; + OPM_WriteString((CHAR*)"for (;;) ", (LONGINT)10); + OPC_BegBlk(); + OPV_stat(n->left, outerProc); + OPC_EndBlk(); + if (OPV_exit.label != -1) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"exit__", (LONGINT)7); + OPM_WriteInt(OPV_exit.label); + OPM_Write(':'); + OPC_EndStat(); + } + OPV_exit = saved; + break; + case 25: + if (OPV_exit.level == 0) { + OPM_WriteString((CHAR*)"break", (LONGINT)6); + } else { + if (OPV_exit.label == -1) { + OPV_exit.label = OPV_nofExitLabels; + OPV_nofExitLabels += 1; + } + OPM_WriteString((CHAR*)"goto exit__", (LONGINT)12); + OPM_WriteInt(OPV_exit.label); + } + break; + case 26: + if (OPM_level == 0) { + if (OPV_mainprog) { + OPM_WriteString((CHAR*)"__FINI", (LONGINT)7); + } else { + OPM_WriteString((CHAR*)"__ENDMOD", (LONGINT)9); + } + } else { + if (n->left != NIL) { + OPM_WriteString((CHAR*)"_o_result = ", (LONGINT)13); + if ((n->left->typ->form == 13 && n->obj->typ != n->left->typ)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + OPV_expr(n->left, 10); + } else { + OPV_expr(n->left, -1); + } + OPM_WriteString((CHAR*)";", (LONGINT)2); + OPM_WriteLn(); + OPC_BegStat(); + OPC_ExitProc(outerProc, 0, 0); + OPM_WriteString((CHAR*)"return _o_result", (LONGINT)17); + } else { + OPM_WriteString((CHAR*)"return", (LONGINT)7); + } + } + break; + case 27: + OPV_IfStat(n, n->subcl == 0, outerProc); + break; + case 28: + OPC_Halt(n->right->conval->intval); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.class = ", (LONGINT)40); + OPM_LogWNum(n->class, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + if (!__IN(n->class, 0x09744000)) { + OPC_EndStat(); + } + n = n->link; + } +} + +void OPV_Module (OPT_Node prog) +{ + if (!OPV_mainprog) { + OPC_GenHdr(prog->right); + OPC_GenHdrIncludes(); + } + OPC_GenBdy(prog->right); + OPV_stat(prog, NIL); +} + +__TDESC(OPV_ExitInfo, 1, 0) = {__TDFLDS("ExitInfo", 4), {-4}}; + +export void *OPV__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPC); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPS); + __MODULE_IMPORT(OPT); + __REGMOD("OPV", 0); + __REGCMD("Init", OPV_Init); + __INITYP(OPV_ExitInfo, OPV_ExitInfo, 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-48/OPV.h b/bootstrap/unix-48/OPV.h new file mode 100644 index 00000000..9907a1ef --- /dev/null +++ b/bootstrap/unix-48/OPV.h @@ -0,0 +1,19 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPV__h +#define OPV__h + +#include "SYSTEM.h" +#include "OPT.h" + + + + +import void OPV_AdrAndSize (OPT_Object topScope); +import void OPV_Init (void); +import void OPV_Module (OPT_Node prog); +import void OPV_TypSize (OPT_Struct typ); +import void *OPV__init(void); + + +#endif diff --git a/bootstrap/unix-48/Platform.c b/bootstrap/unix-48/Platform.c new file mode 100644 index 00000000..013e6f9c --- /dev/null +++ b/bootstrap/unix-48/Platform.c @@ -0,0 +1,792 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" + +typedef + CHAR (*Platform_ArgPtr)[1024]; + +typedef + Platform_ArgPtr (*Platform_ArgVec)[1024]; + +typedef + LONGINT (*Platform_ArgVecPtr)[1]; + +typedef + CHAR (*Platform_EnvPtr)[1024]; + +typedef + struct Platform_FileIdentity { + LONGINT volume, index, mtime; + } Platform_FileIdentity; + +typedef + void (*Platform_HaltProcedure)(LONGINT); + +typedef + void (*Platform_SignalHandler)(INTEGER); + + +export BOOLEAN Platform_LittleEndian; +export LONGINT Platform_MainStackFrame, Platform_HaltCode; +export INTEGER Platform_PID; +export CHAR Platform_CWD[256]; +export INTEGER Platform_ArgCount; +export LONGINT Platform_ArgVector; +static Platform_HaltProcedure Platform_HaltHandler; +static LONGINT Platform_TimeStart; +export INTEGER Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd; +export CHAR Platform_nl[3]; + +export LONGINT *Platform_FileIdentity__typ; + +export BOOLEAN Platform_Absent (INTEGER e); +export INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len); +export void Platform_AssertFail (LONGINT code); +export INTEGER Platform_Chdir (CHAR *n, LONGINT n__len); +export INTEGER Platform_Close (LONGINT h); +export BOOLEAN Platform_ConnectionFailed (INTEGER e); +export void Platform_Delay (LONGINT ms); +export BOOLEAN Platform_DifferentFilesystems (INTEGER e); +static void Platform_DisplayHaltCode (LONGINT code); +export INTEGER Platform_Error (void); +export void Platform_Exit (INTEGER code); +export void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len); +export void Platform_GetClock (LONGINT *t, LONGINT *d); +export void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len); +export void Platform_GetIntArg (INTEGER n, LONGINT *val); +export void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec); +export void Platform_Halt (LONGINT code); +export INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ); +export INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ); +export BOOLEAN Platform_Inaccessible (INTEGER e); +export void Platform_Init (INTEGER argc, LONGINT argvadr); +export void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d); +export INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h); +export BOOLEAN Platform_NoSuchDirectory (INTEGER e); +export LONGINT Platform_OSAllocate (LONGINT size); +export void Platform_OSFree (LONGINT address); +export INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h); +export INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h); +export INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n); +export INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n); +export INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len); +export BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2); +export BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2); +export INTEGER Platform_Seek (LONGINT h, LONGINT offset, INTEGER whence); +export void Platform_SetBadInstructionHandler (Platform_SignalHandler handler); +export void Platform_SetHalt (Platform_HaltProcedure p); +export void Platform_SetInterruptHandler (Platform_SignalHandler handler); +export void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source); +export void Platform_SetQuitHandler (Platform_SignalHandler handler); +export INTEGER Platform_Size (LONGINT h, LONGINT *l); +export INTEGER Platform_Sync (LONGINT h); +export INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len); +static void Platform_TestLittleEndian (void); +export LONGINT Platform_Time (void); +export BOOLEAN Platform_TimedOut (INTEGER e); +export BOOLEAN Platform_TooManyFiles (INTEGER e); +export INTEGER Platform_Truncate (LONGINT h, LONGINT l); +export INTEGER Platform_Unlink (CHAR *n, LONGINT n__len); +export INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l); +static void Platform_YMDHMStoClock (LONGINT ye, LONGINT mo, LONGINT da, LONGINT ho, LONGINT mi, LONGINT se, LONGINT *t, LONGINT *d); +static void Platform_errch (CHAR c); +static void Platform_errint (LONGINT l); +static void Platform_errln (void); +static void Platform_errposint (LONGINT l); +export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len); + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#define Platform_EACCES() EACCES +#define Platform_EAGAIN() EAGAIN +#define Platform_ECONNABORTED() ECONNABORTED +#define Platform_ECONNREFUSED() ECONNREFUSED +#define Platform_EHOSTUNREACH() EHOSTUNREACH +#define Platform_EMFILE() EMFILE +#define Platform_ENETUNREACH() ENETUNREACH +#define Platform_ENFILE() ENFILE +#define Platform_ENOENT() ENOENT +#define Platform_EROFS() EROFS +#define Platform_ETIMEDOUT() ETIMEDOUT +#define Platform_EXDEV() EXDEV +extern void Heap_InitHeap(); +#define Platform_HeapInitHeap() Heap_InitHeap() +#define Platform_allocate(size) (LONGINT)(uintptr_t)((void*)malloc((size_t)size)) +#define Platform_chdir(n, n__len) chdir((char*)n) +#define Platform_closefile(fd) close(fd) +#define Platform_err() errno +#define Platform_errc(c) write(1, &c, 1) +#define Platform_errstring(s, s__len) write(1, s, s__len-1) +#define Platform_exit(code) exit(code) +#define Platform_free(address) free((void*)(uintptr_t)address) +#define Platform_fstat(fd) fstat(fd, &s) +#define Platform_fsync(fd) fsync(fd) +#define Platform_ftruncate(fd, l) ftruncate(fd, l) +#define Platform_getcwd(cwd, cwd__len) getcwd((char*)cwd, cwd__len) +#define Platform_getenv(var, var__len) (Platform_EnvPtr)getenv((char*)var) +#define Platform_getpid() (INTEGER)getpid() +#define Platform_gettimeval() struct timeval tv; gettimeofday(&tv,0) +#define Platform_lseek(fd, o, w) lseek(fd, o, w) +#define Platform_nanosleep(s, ns) struct timespec req, rem; req.tv_sec = s; req.tv_nsec = ns; nanosleep(&req, &rem) +#define Platform_opennew(n, n__len) open((char*)n, O_CREAT | O_TRUNC | O_RDWR, 0664) +#define Platform_openro(n, n__len) open((char*)n, O_RDONLY) +#define Platform_openrw(n, n__len) open((char*)n, O_RDWR) +#define Platform_readfile(fd, p, l) read(fd, (void*)(uintptr_t)(p), l) +#define Platform_rename(o, o__len, n, n__len) rename((char*)o, (char*)n) +#define Platform_sectotm(s) struct tm *time = localtime((time_t*)&s) +#define Platform_seekcur() SEEK_CUR +#define Platform_seekend() SEEK_END +#define Platform_seekset() SEEK_SET +#define Platform_sethandler(s, h) SystemSetHandler(s, (uintptr_t)h) +#define Platform_stat(n, n__len) stat((char*)n, &s) +#define Platform_statdev() (LONGINT)s.st_dev +#define Platform_statino() (LONGINT)s.st_ino +#define Platform_statmtime() (LONGINT)s.st_mtime +#define Platform_statsize() (LONGINT)s.st_size +#define Platform_structstats() struct stat s +#define Platform_system(str, str__len) system((char*)str) +#define Platform_tmhour() (LONGINT)time->tm_hour +#define Platform_tmmday() (LONGINT)time->tm_mday +#define Platform_tmmin() (LONGINT)time->tm_min +#define Platform_tmmon() (LONGINT)time->tm_mon +#define Platform_tmsec() (LONGINT)time->tm_sec +#define Platform_tmyear() (LONGINT)time->tm_year +#define Platform_tvsec() tv.tv_sec +#define Platform_tvusec() tv.tv_usec +#define Platform_unlink(n, n__len) unlink((char*)n) +#define Platform_writefile(fd, p, l) write(fd, (void*)(uintptr_t)(p), l) + +BOOLEAN Platform_TooManyFiles (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_EMFILE() || e == Platform_ENFILE(); + return _o_result; +} + +BOOLEAN Platform_NoSuchDirectory (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_ENOENT(); + return _o_result; +} + +BOOLEAN Platform_DifferentFilesystems (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_EXDEV(); + return _o_result; +} + +BOOLEAN Platform_Inaccessible (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = (e == Platform_EACCES() || e == Platform_EROFS()) || e == Platform_EAGAIN(); + return _o_result; +} + +BOOLEAN Platform_Absent (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_ENOENT(); + return _o_result; +} + +BOOLEAN Platform_TimedOut (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_ETIMEDOUT(); + return _o_result; +} + +BOOLEAN Platform_ConnectionFailed (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = ((e == Platform_ECONNREFUSED() || e == Platform_ECONNABORTED()) || e == Platform_ENETUNREACH()) || e == Platform_EHOSTUNREACH(); + return _o_result; +} + +LONGINT Platform_OSAllocate (LONGINT size) +{ + LONGINT _o_result; + _o_result = Platform_allocate(size); + return _o_result; +} + +void Platform_OSFree (LONGINT address) +{ + Platform_free(address); +} + +void Platform_Init (INTEGER argc, LONGINT argvadr) +{ + Platform_ArgVecPtr av = NIL; + Platform_MainStackFrame = argvadr; + Platform_ArgCount = argc; + av = (Platform_ArgVecPtr)(uintptr_t)argvadr; + Platform_ArgVector = (*av)[0]; + Platform_HaltCode = -128; + Platform_HeapInitHeap(); +} + +BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len) +{ + BOOLEAN _o_result; + Platform_EnvPtr p = NIL; + __DUP(var, var__len, CHAR); + p = Platform_getenv(var, var__len); + if (p != NIL) { + __COPY(*p, val, val__len); + } + _o_result = p != NIL; + __DEL(var); + return _o_result; +} + +void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len) +{ + __DUP(var, var__len, CHAR); + if (!Platform_getEnv(var, var__len, (void*)val, val__len)) { + val[0] = 0x00; + } + __DEL(var); +} + +void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len) +{ + Platform_ArgVec av = NIL; + if (n < Platform_ArgCount) { + av = (Platform_ArgVec)(uintptr_t)Platform_ArgVector; + __COPY(*(*av)[__X(n, ((LONGINT)(1024)))], val, val__len); + } +} + +void Platform_GetIntArg (INTEGER n, LONGINT *val) +{ + CHAR s[64]; + LONGINT k, d, i; + s[0] = 0x00; + Platform_GetArg(n, (void*)s, ((LONGINT)(64))); + i = 0; + if (s[0] == '-') { + i = 1; + } + k = 0; + d = (int)s[__X(i, ((LONGINT)(64)))] - 48; + while ((d >= 0 && d <= 9)) { + k = k * 10 + d; + i += 1; + d = (int)s[__X(i, ((LONGINT)(64)))] - 48; + } + if (s[0] == '-') { + k = -k; + i -= 1; + } + if (i > 0) { + *val = k; + } +} + +INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len) +{ + INTEGER _o_result; + INTEGER i; + CHAR arg[256]; + __DUP(s, s__len, CHAR); + i = 0; + Platform_GetArg(i, (void*)arg, ((LONGINT)(256))); + while ((i < Platform_ArgCount && __STRCMP(s, arg) != 0)) { + i += 1; + Platform_GetArg(i, (void*)arg, ((LONGINT)(256))); + } + _o_result = i; + __DEL(s); + return _o_result; +} + +void Platform_SetInterruptHandler (Platform_SignalHandler handler) +{ + Platform_sethandler(2, handler); +} + +void Platform_SetQuitHandler (Platform_SignalHandler handler) +{ + Platform_sethandler(3, handler); +} + +void Platform_SetBadInstructionHandler (Platform_SignalHandler handler) +{ + Platform_sethandler(4, handler); +} + +static void Platform_YMDHMStoClock (LONGINT ye, LONGINT mo, LONGINT da, LONGINT ho, LONGINT mi, LONGINT se, LONGINT *t, LONGINT *d) +{ + *d = (__ASHL(__MOD(ye, 100), 9) + __ASHL(mo + 1, 5)) + da; + *t = (__ASHL(ho, 12) + __ASHL(mi, 6)) + se; +} + +void Platform_GetClock (LONGINT *t, LONGINT *d) +{ + Platform_gettimeval(); + Platform_sectotm(Platform_tvsec()); + Platform_YMDHMStoClock(Platform_tmyear(), Platform_tmmon(), Platform_tmmday(), Platform_tmhour(), Platform_tmmin(), Platform_tmsec(), &*t, &*d); +} + +void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec) +{ + Platform_gettimeval(); + *sec = Platform_tvsec(); + *usec = Platform_tvusec(); +} + +LONGINT Platform_Time (void) +{ + LONGINT _o_result; + LONGINT ms; + Platform_gettimeval(); + ms = __DIVF(Platform_tvusec(), 1000) + Platform_tvsec() * 1000; + _o_result = __MOD(ms - Platform_TimeStart, 2147483647); + return _o_result; +} + +void Platform_Delay (LONGINT ms) +{ + LONGINT s, ns; + s = __DIV(ms, 1000); + ns = __MOD(ms, 1000) * 1000000; + Platform_nanosleep(s, ns); +} + +INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len) +{ + INTEGER _o_result; + __DUP(cmd, cmd__len, CHAR); + _o_result = Platform_system(cmd, cmd__len); + __DEL(cmd); + return _o_result; +} + +INTEGER Platform_Error (void) +{ + INTEGER _o_result; + _o_result = Platform_err(); + return _o_result; +} + +INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h) +{ + INTEGER _o_result; + INTEGER fd; + fd = Platform_openro(n, n__len); + if (fd < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + *h = fd; + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h) +{ + INTEGER _o_result; + INTEGER fd; + fd = Platform_openrw(n, n__len); + if (fd < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + *h = fd; + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h) +{ + INTEGER _o_result; + INTEGER fd; + fd = Platform_opennew(n, n__len); + if (fd < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + *h = fd; + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Close (LONGINT h) +{ + INTEGER _o_result; + if (Platform_closefile(h) < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ) +{ + INTEGER _o_result; + Platform_structstats(); + if (Platform_fstat(h) < 0) { + _o_result = Platform_err(); + return _o_result; + } + (*identity).volume = Platform_statdev(); + (*identity).index = Platform_statino(); + (*identity).mtime = Platform_statmtime(); + _o_result = 0; + return _o_result; +} + +INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ) +{ + INTEGER _o_result; + __DUP(n, n__len, CHAR); + Platform_structstats(); + if (Platform_stat(n, n__len) < 0) { + _o_result = Platform_err(); + __DEL(n); + return _o_result; + } + (*identity).volume = Platform_statdev(); + (*identity).index = Platform_statino(); + (*identity).mtime = Platform_statmtime(); + _o_result = 0; + __DEL(n); + return _o_result; +} + +BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2) +{ + BOOLEAN _o_result; + _o_result = (i1.index == i2.index && i1.volume == i2.volume); + return _o_result; +} + +BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2) +{ + BOOLEAN _o_result; + _o_result = i1.mtime == i2.mtime; + return _o_result; +} + +void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source) +{ + (*target).mtime = source.mtime; +} + +void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d) +{ + Platform_sectotm(i.mtime); + Platform_YMDHMStoClock(Platform_tmyear(), Platform_tmmon(), Platform_tmmday(), Platform_tmhour(), Platform_tmmin(), Platform_tmsec(), &*t, &*d); +} + +INTEGER Platform_Size (LONGINT h, LONGINT *l) +{ + INTEGER _o_result; + Platform_structstats(); + if (Platform_fstat(h) < 0) { + _o_result = Platform_err(); + return _o_result; + } + *l = Platform_statsize(); + _o_result = 0; + return _o_result; +} + +INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n) +{ + INTEGER _o_result; + *n = Platform_readfile(h, p, l); + if (*n < 0) { + *n = 0; + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n) +{ + INTEGER _o_result; + *n = Platform_readfile(h, (LONGINT)(uintptr_t)b, b__len); + if (*n < 0) { + *n = 0; + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l) +{ + INTEGER _o_result; + LONGINT written; + written = Platform_writefile(h, p, l); + if (written < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Sync (LONGINT h) +{ + INTEGER _o_result; + if (Platform_fsync(h) < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Seek (LONGINT h, LONGINT offset, INTEGER whence) +{ + INTEGER _o_result; + if (Platform_lseek(h, offset, whence) < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Truncate (LONGINT h, LONGINT l) +{ + INTEGER _o_result; + if (Platform_ftruncate(h, l) < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Unlink (CHAR *n, LONGINT n__len) +{ + INTEGER _o_result; + if (Platform_unlink(n, n__len) < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Chdir (CHAR *n, LONGINT n__len) +{ + INTEGER _o_result; + INTEGER r; + r = Platform_chdir(n, n__len); + Platform_getcwd((void*)Platform_CWD, ((LONGINT)(256))); + if (r < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len) +{ + INTEGER _o_result; + if (Platform_rename(o, o__len, n, n__len) < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +void Platform_Exit (INTEGER code) +{ + Platform_exit(code); +} + +static void Platform_errch (CHAR c) +{ + Platform_errc(c); +} + +static void Platform_errln (void) +{ + Platform_errch(0x0d); + Platform_errch(0x0a); +} + +static void Platform_errposint (LONGINT l) +{ + if (l > 10) { + Platform_errposint(__DIV(l, 10)); + } + Platform_errch((CHAR)(48 + __MOD(l, 10))); +} + +static void Platform_errint (LONGINT l) +{ + if (l < 0) { + Platform_errch('-'); + l = -l; + } + Platform_errposint(l); +} + +static void Platform_DisplayHaltCode (LONGINT code) +{ + switch (code) { + case -1: + Platform_errstring((CHAR*)"Assertion failure.", (LONGINT)19); + break; + case -2: + Platform_errstring((CHAR*)"Index out of range.", (LONGINT)20); + break; + case -3: + Platform_errstring((CHAR*)"Reached end of function without reaching RETURN.", (LONGINT)49); + break; + case -4: + Platform_errstring((CHAR*)"CASE statement: no matching label and no ELSE.", (LONGINT)47); + break; + case -5: + Platform_errstring((CHAR*)"Type guard failed.", (LONGINT)19); + break; + case -6: + Platform_errstring((CHAR*)"Implicit type guard in record assignment failed.", (LONGINT)49); + break; + case -7: + Platform_errstring((CHAR*)"Invalid case in WITH statement.", (LONGINT)32); + break; + case -8: + Platform_errstring((CHAR*)"Value out of range.", (LONGINT)20); + break; + case -9: + Platform_errstring((CHAR*)"Heap interrupted while locked, but lockdepth = 0 at unlock.", (LONGINT)60); + break; + case -10: + Platform_errstring((CHAR*)"NIL access.", (LONGINT)12); + break; + case -11: + Platform_errstring((CHAR*)"Alignment error.", (LONGINT)17); + break; + case -12: + Platform_errstring((CHAR*)"Divide by zero.", (LONGINT)16); + break; + case -13: + Platform_errstring((CHAR*)"Arithmetic overflow/underflow.", (LONGINT)31); + break; + case -14: + Platform_errstring((CHAR*)"Invalid function argument.", (LONGINT)27); + break; + case -15: + Platform_errstring((CHAR*)"Internal error, e.g. Type descriptor size mismatch.", (LONGINT)52); + break; + case -20: + Platform_errstring((CHAR*)"Too many, or negative number of, elements in dynamic array.", (LONGINT)60); + break; + default: + break; + } +} + +void Platform_Halt (LONGINT code) +{ + INTEGER e; + Platform_HaltCode = code; + if (Platform_HaltHandler != NIL) { + (*Platform_HaltHandler)(code); + } + Platform_errstring((CHAR*)"Terminated by Halt(", (LONGINT)20); + Platform_errint(code); + Platform_errstring((CHAR*)"). ", (LONGINT)4); + if (code < 0) { + Platform_DisplayHaltCode(code); + } + Platform_errln(); + Platform_exit(__VAL(INTEGER, code)); +} + +void Platform_AssertFail (LONGINT code) +{ + INTEGER e; + Platform_errstring((CHAR*)"Assertion failure.", (LONGINT)19); + if (code != 0) { + Platform_errstring((CHAR*)" ASSERT code ", (LONGINT)14); + Platform_errint(code); + Platform_errstring((CHAR*)".", (LONGINT)2); + } + Platform_errln(); + Platform_exit(__VAL(INTEGER, code)); +} + +void Platform_SetHalt (Platform_HaltProcedure p) +{ + Platform_HaltHandler = p; +} + +static void Platform_TestLittleEndian (void) +{ + INTEGER i; + i = 1; + __GET((LONGINT)(uintptr_t)&i, Platform_LittleEndian, BOOLEAN); +} + +__TDESC(Platform_FileIdentity, 1, 0) = {__TDFLDS("FileIdentity", 12), {-4}}; + +export void *Platform__init(void) +{ + __DEFMOD; + __REGMOD("Platform", 0); + __INITYP(Platform_FileIdentity, Platform_FileIdentity, 0); +/* BEGIN */ + Platform_TestLittleEndian(); + Platform_HaltCode = -128; + Platform_HaltHandler = NIL; + Platform_TimeStart = Platform_Time(); + Platform_CWD[0] = 0x00; + Platform_getcwd((void*)Platform_CWD, ((LONGINT)(256))); + Platform_PID = Platform_getpid(); + Platform_SeekSet = Platform_seekset(); + Platform_SeekCur = Platform_seekcur(); + Platform_SeekEnd = Platform_seekend(); + Platform_nl[0] = 0x0a; + Platform_nl[1] = 0x00; + __ENDMOD; +} diff --git a/bootstrap/unix-48/Platform.h b/bootstrap/unix-48/Platform.h new file mode 100644 index 00000000..8b47d1c9 --- /dev/null +++ b/bootstrap/unix-48/Platform.h @@ -0,0 +1,82 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Platform__h +#define Platform__h + +#include "SYSTEM.h" + +typedef + struct Platform_FileIdentity { + LONGINT volume, index, mtime; + } Platform_FileIdentity; + +typedef + void (*Platform_HaltProcedure)(LONGINT); + +typedef + void (*Platform_SignalHandler)(INTEGER); + + +import BOOLEAN Platform_LittleEndian; +import LONGINT Platform_MainStackFrame, Platform_HaltCode; +import INTEGER Platform_PID; +import CHAR Platform_CWD[256]; +import INTEGER Platform_ArgCount; +import LONGINT Platform_ArgVector; +import INTEGER Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd; +import CHAR Platform_nl[3]; + +import LONGINT *Platform_FileIdentity__typ; + +import BOOLEAN Platform_Absent (INTEGER e); +import INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len); +import void Platform_AssertFail (LONGINT code); +import INTEGER Platform_Chdir (CHAR *n, LONGINT n__len); +import INTEGER Platform_Close (LONGINT h); +import BOOLEAN Platform_ConnectionFailed (INTEGER e); +import void Platform_Delay (LONGINT ms); +import BOOLEAN Platform_DifferentFilesystems (INTEGER e); +import INTEGER Platform_Error (void); +import void Platform_Exit (INTEGER code); +import void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len); +import void Platform_GetClock (LONGINT *t, LONGINT *d); +import void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len); +import void Platform_GetIntArg (INTEGER n, LONGINT *val); +import void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec); +import void Platform_Halt (LONGINT code); +import INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ); +import INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ); +import BOOLEAN Platform_Inaccessible (INTEGER e); +import void Platform_Init (INTEGER argc, LONGINT argvadr); +import void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d); +import INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h); +import BOOLEAN Platform_NoSuchDirectory (INTEGER e); +import LONGINT Platform_OSAllocate (LONGINT size); +import void Platform_OSFree (LONGINT address); +import INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h); +import INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h); +import INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n); +import INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n); +import INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len); +import BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2); +import BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2); +import INTEGER Platform_Seek (LONGINT h, LONGINT offset, INTEGER whence); +import void Platform_SetBadInstructionHandler (Platform_SignalHandler handler); +import void Platform_SetHalt (Platform_HaltProcedure p); +import void Platform_SetInterruptHandler (Platform_SignalHandler handler); +import void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source); +import void Platform_SetQuitHandler (Platform_SignalHandler handler); +import INTEGER Platform_Size (LONGINT h, LONGINT *l); +import INTEGER Platform_Sync (LONGINT h); +import INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len); +import LONGINT Platform_Time (void); +import BOOLEAN Platform_TimedOut (INTEGER e); +import BOOLEAN Platform_TooManyFiles (INTEGER e); +import INTEGER Platform_Truncate (LONGINT h, LONGINT l); +import INTEGER Platform_Unlink (CHAR *n, LONGINT n__len); +import INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l); +import BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len); +import void *Platform__init(void); + + +#endif diff --git a/bootstrap/unix-48/Reals.c b/bootstrap/unix-48/Reals.c new file mode 100644 index 00000000..65dad750 --- /dev/null +++ b/bootstrap/unix-48/Reals.c @@ -0,0 +1,155 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" + + + + +export void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len); +export void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len); +export void Reals_ConvertHL (LONGREAL y, CHAR *d, LONGINT d__len); +export void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len); +export INTEGER Reals_Expo (REAL x); +export INTEGER Reals_ExpoL (LONGREAL x); +export REAL Reals_Ten (INTEGER e); +export LONGREAL Reals_TenL (INTEGER e); +static CHAR Reals_ToHex (INTEGER i); + + +REAL Reals_Ten (INTEGER e) +{ + REAL _o_result; + LONGREAL r, power; + r = (LONGREAL)1; + power = (LONGREAL)10; + while (e > 0) { + if (__ODD(e)) { + r = r * power; + } + power = power * power; + e = __ASHR(e, 1); + } + _o_result = r; + return _o_result; +} + +LONGREAL Reals_TenL (INTEGER e) +{ + LONGREAL _o_result; + LONGREAL r, power; + r = (LONGREAL)1; + power = (LONGREAL)10; + for (;;) { + if (__ODD(e)) { + r = r * power; + } + e = __ASHR(e, 1); + if (e <= 0) { + _o_result = r; + return _o_result; + } + power = power * power; + } + __RETCHK; +} + +INTEGER Reals_Expo (REAL x) +{ + INTEGER _o_result; + _o_result = (int)__MASK(__ASHR((LONGINT)(__VAL(INTEGER, x)), 23), -256); + return _o_result; +} + +INTEGER Reals_ExpoL (LONGREAL x) +{ + INTEGER _o_result; + INTEGER i; + LONGINT l; + __GET((LONGINT)(uintptr_t)&x + 4, l, LONGINT); + _o_result = (int)__MASK(__ASHR(l, 20), -2048); + return _o_result; +} + +void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len) +{ + LONGINT i, j, k; + if (x < (LONGREAL)0) { + x = -x; + } + k = 0; + if (n > 9) { + i = __ENTIER(x / (LONGREAL)(LONGREAL)1000000000); + j = __ENTIER(x - i * (LONGREAL)1000000000); + if (j < 0) { + j = 0; + } + while (k < 9) { + d[__X(k, d__len)] = (CHAR)(__MOD(j, 10) + 48); + j = __DIV(j, 10); + k += 1; + } + } else { + i = __ENTIER(x); + } + while (k < (LONGINT)n) { + d[__X(k, d__len)] = (CHAR)(__MOD(i, 10) + 48); + i = __DIV(i, 10); + k += 1; + } +} + +void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len) +{ + Reals_ConvertL(x, n, (void*)d, d__len); +} + +static CHAR Reals_ToHex (INTEGER i) +{ + CHAR _o_result; + if (i < 10) { + _o_result = (CHAR)(i + 48); + return _o_result; + } else { + _o_result = (CHAR)(i + 55); + return _o_result; + } + __RETCHK; +} + +typedef + CHAR (*pc4__3)[4]; + +void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len) +{ + pc4__3 p = NIL; + INTEGER i; + p = (pc4__3)(uintptr_t)((LONGINT)(uintptr_t)&y); + i = 0; + while (i < 4) { + d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((int)(*p)[__X(i, ((LONGINT)(4)))], 4)); + d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((int)(*p)[__X(i, ((LONGINT)(4)))], -16)); + } +} + +typedef + CHAR (*pc8__5)[8]; + +void Reals_ConvertHL (LONGREAL y, CHAR *d, LONGINT d__len) +{ + pc8__5 p = NIL; + INTEGER i; + p = (pc8__5)(uintptr_t)((LONGINT)(uintptr_t)&y); + i = 0; + while (i < 8) { + d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((int)(*p)[__X(i, ((LONGINT)(8)))], 4)); + d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((int)(*p)[__X(i, ((LONGINT)(8)))], -16)); + } +} + + +export void *Reals__init(void) +{ + __DEFMOD; + __REGMOD("Reals", 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-48/Reals.h b/bootstrap/unix-48/Reals.h new file mode 100644 index 00000000..166e977b --- /dev/null +++ b/bootstrap/unix-48/Reals.h @@ -0,0 +1,22 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Reals__h +#define Reals__h + +#include "SYSTEM.h" + + + + +import void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len); +import void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len); +import void Reals_ConvertHL (LONGREAL y, CHAR *d, LONGINT d__len); +import void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len); +import INTEGER Reals_Expo (REAL x); +import INTEGER Reals_ExpoL (LONGREAL x); +import REAL Reals_Ten (INTEGER e); +import LONGREAL Reals_TenL (INTEGER e); +import void *Reals__init(void); + + +#endif diff --git a/bootstrap/unix-48/SYSTEM.c b/bootstrap/unix-48/SYSTEM.c new file mode 100644 index 00000000..0fcc5ee2 --- /dev/null +++ b/bootstrap/unix-48/SYSTEM.c @@ -0,0 +1,207 @@ +/* +* The body prefix file of the voc(jet backend) runtime system, Version 1.0 +* +* Copyright (c) Software Templ, 1994, 1995 +* +* Module SYSTEM is subject to change any time without prior notification. +* Software Templ disclaims all warranties with regard to module SYSTEM, +* in particular shall Software Templ not be liable for any damage resulting +* from inappropriate use or modification of module SYSTEM. +* +* Version 1.1 jt, 24.11.95 fixes for correct pointer arithmetic on Cray computers +* jt 31.1.2007 ANSI prototypes for malloc and exit in order to avoid cc warnings +* +*/ + +#include "SYSTEM.h" +#include "stdarg.h" +#include + + +LONGINT SYSTEM_XCHK(LONGINT i, LONGINT ub) {return __X(i, ub);} +LONGINT SYSTEM_RCHK(LONGINT i, LONGINT ub) {return __R(i, ub);} +LONGINT SYSTEM_ASH (LONGINT i, LONGINT n) {return __ASH(i, n);} +LONGINT SYSTEM_ABS (LONGINT i) {return __ABS(i);} +double SYSTEM_ABSD(double i) {return __ABS(i);} + +void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0) +{ + t -= __TPROC0OFF; + t0 -= __TPROC0OFF; + while (*t0 != __EOM) {*t = *t0; t--; t0--;} +} + + +void SYSTEM_ENUMP(void *adr, LONGINT n, void (*P)()) +{ + while (n > 0) { + P((LONGINT)(uintptr_t)(*((void**)(adr)))); + adr = ((void**)adr) + 1; + n--; + } +} + +void SYSTEM_ENUMR(void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)()) +{ + LONGINT *t, off; + typ++; + while (n > 0) { + t = typ; + off = *t; + while (off >= 0) {P(*(LONGINT*)((char*)adr+off)); t++; off = *t;} + adr = ((char*)adr) + size; + n--; + } +} + +LONGINT SYSTEM_DIV(unsigned LONGINT x, unsigned LONGINT y) +{ if ((LONGINT) x >= 0) return (x / y); + else return -((y - 1 - x) / y); +} + +LONGINT SYSTEM_MOD(unsigned LONGINT x, unsigned LONGINT y) +{ unsigned LONGINT m; + if ((LONGINT) x >= 0) return (x % y); + else { m = (-x) % y; + if (m != 0) return (y - m); else return 0; + } +} + +LONGINT SYSTEM_ENTIER(double x) +{ + LONGINT y; + if (x >= 0) + return (LONGINT)x; + else { + y = (LONGINT)x; + if (y <= x) return y; else return y - 1; + } +} + +extern void Heap_Lock(); +extern void Heap_Unlock(); + +SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim, int nofdyn, ...) +{ + LONGINT nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off; + va_list ap; + va_start(ap, nofdyn); + nofelems = 1; + while (nofdim > 0) { + nofelems = nofelems * va_arg(ap, LONGINT); nofdim--; + if (nofelems <= 0) __HALT(-20); + } + va_end(ap); + dataoff = nofdyn * sizeof(LONGINT); + if (elemalgn > sizeof(LONGINT)) { + n = dataoff % elemalgn; + if (n != 0) dataoff += elemalgn - n; + } + size = dataoff + nofelems * elemsz; + Heap_Lock(); + if (typ == NIL) { + /* element typ does not contain pointers */ + x = Heap_NEWBLK(size); + } + else if (typ == (LONGINT*)POINTER__typ) { + /* element type is a pointer */ + x = Heap_NEWBLK(size + nofelems * sizeof(LONGINT)); + p = (LONGINT*)(uintptr_t)x[-1]; + p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ + p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */ + while (n <= nofelems) {*p = n*sizeof(LONGINT); p++; n++;} + *p = - (nofelems + 1) * sizeof(LONGINT); /* sentinel */ + x[-1] -= nofelems * sizeof(LONGINT); + } + else { + /* element type is a record that contains pointers */ + ptab = typ + 1; nofptrs = 0; + while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */ + nptr = nofelems * nofptrs; /* total number of pointers */ + x = Heap_NEWBLK(size + nptr * sizeof(LONGINT)); + p = (LONGINT*)(uintptr_t)x[- 1]; + p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ + p -= nptr - 1; n = 0; off = dataoff; + while (n < nofelems) {i = 0; + while (i < nofptrs) {*p = off + ptab[i]; p++; i++;} + off += elemsz; n++; + } + *p = - (nptr + 1) * sizeof(LONGINT); /* sentinel */ + x[-1] -= nptr * sizeof(LONGINT); + } + if (nofdyn != 0) { + /* setup len vector for index checks */ + va_start(ap, nofdyn); + p = x; + while (nofdyn > 0) {*p = va_arg(ap, LONGINT); p++, nofdyn--;} + va_end(ap); + } + Heap_Unlock(); + return x; +} + + + + +typedef void (*SystemSignalHandler)(INTEGER); // = Platform_SignalHandler + +#ifndef _WIN32 + + SystemSignalHandler handler[3] = {0}; + + // Provide signal handling for Unix based systems + void signalHandler(int s) { + if (s >= 2 && s <= 4) handler[s-2](s); + // (Ignore other signals) + } + + void SystemSetHandler(int s, uintptr_t h) { + if (s >= 2 && s <= 4) { + int needtosetsystemhandler = handler[s-2] == 0; + handler[s-2] = (SystemSignalHandler)h; + if (needtosetsystemhandler) {signal(s, signalHandler);} + } + } + +#else + + // Provides Windows callback handlers for signal-like scenarios + #include "WindowsWrapper.h" + + SystemSignalHandler SystemInterruptHandler = 0; + SystemSignalHandler SystemQuitHandler = 0; + BOOL ConsoleCtrlHandlerSet = FALSE; + + BOOL WINAPI SystemConsoleCtrlHandler(DWORD ctrlType) { + if ((ctrlType == CTRL_C_EVENT) || (ctrlType == CTRL_BREAK_EVENT)) { + if (SystemInterruptHandler) { + SystemInterruptHandler(2); // SIGINT + return TRUE; + } + } else { // Close, logoff or shutdown + if (SystemQuitHandler) { + SystemQuitHandler(3); // SIGQUIT + return TRUE; + } + } + return FALSE; + } + + void EnsureConsoleCtrlHandler() { + if (!ConsoleCtrlHandlerSet) { + SetConsoleCtrlHandler(SystemConsoleCtrlHandler, TRUE); + ConsoleCtrlHandlerSet = TRUE; + } + } + + void SystemSetInterruptHandler(uintptr_t h) { + EnsureConsoleCtrlHandler(); + SystemInterruptHandler = (SystemSignalHandler)h; + } + + void SystemSetQuitHandler(uintptr_t h) { + EnsureConsoleCtrlHandler(); + SystemQuitHandler = (SystemSignalHandler)h; + } + +#endif diff --git a/bootstrap/unix-48/SYSTEM.h b/bootstrap/unix-48/SYSTEM.h new file mode 100644 index 00000000..f9e2f930 --- /dev/null +++ b/bootstrap/unix-48/SYSTEM.h @@ -0,0 +1,275 @@ +#ifndef SYSTEM__h +#define SYSTEM__h + +#ifndef _WIN32 + + // Building for a Unix/Linux based system + #include // For memcpy ... + #include // For uintptr_t ... + +#else + + // Building for Windows platform with either mingw under cygwin, or the MS C compiler + #ifdef _WIN64 + typedef unsigned long long size_t; + typedef unsigned long long uintptr_t; + #else + typedef unsigned int size_t; + typedef unsigned int uintptr_t; + #endif /* _WIN64 */ + + typedef unsigned int uint32_t; + void * __cdecl memcpy(void * dest, const void * source, size_t size); + +#endif + + +// The compiler uses 'import' and 'export' which translate to 'extern' and +// nothing respectively. + +#define import extern +#define export + + + +// Known constants + +#define NIL ((void*)0) +#define __MAXEXT 16 +#define POINTER__typ ((LONGINT*)(1)) // not NIL and not a valid type + + +// Oberon types + +#define BOOLEAN char +#define SYSTEM_BYTE unsigned char +#define CHAR unsigned char +#define SHORTINT signed char +#define REAL float +#define LONGREAL double +#define SYSTEM_PTR void* + +// For 32 bit builds, the size of LONGINT depends on a make option: + +#if (__SIZEOF_POINTER__ == 8) || defined(LARGE) || defined(_WIN64) + #define INTEGER int // INTEGER is 32 bit. + #define LONGINT long long // LONGINT is 64 bit. (long long is always 64 bits, while long can be 32 bits e.g. under MSC/MingW) +#else + #define INTEGER short int // INTEGER is 16 bit. + #define LONGINT long // LONGINT is 32 bit. +#endif + +#define SET unsigned LONGINT + + +// OS Memory allocation interfaces are in PlatformXXX.Mod + +extern LONGINT Platform_OSAllocate (LONGINT size); +extern void Platform_OSFree (LONGINT addr); + + +// Run time system routines in SYSTEM.c + +extern LONGINT SYSTEM_XCHK (LONGINT i, LONGINT ub); +extern LONGINT SYSTEM_RCHK (LONGINT i, LONGINT ub); +extern LONGINT SYSTEM_ASH (LONGINT i, LONGINT n); +extern LONGINT SYSTEM_ABS (LONGINT i); +extern double SYSTEM_ABSD (double i); +extern void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0); +extern void SYSTEM_ENUMP (void *adr, LONGINT n, void (*P)()); +extern void SYSTEM_ENUMR (void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)()); +extern LONGINT SYSTEM_DIV (unsigned LONGINT x, unsigned LONGINT y); +extern LONGINT SYSTEM_MOD (unsigned LONGINT x, unsigned LONGINT y); +extern LONGINT SYSTEM_ENTIER (double x); + + +// Signal handling in SYSTEM.c + +#ifndef _WIN32 + extern void SystemSetHandler(int s, uintptr_t h); +#else + extern void SystemSetInterruptHandler(uintptr_t h); + extern void SystemSetQuitHandler (uintptr_t h); +#endif + + + +// String comparison + +static int __str_cmp(CHAR *x, CHAR *y){ + LONGINT i = 0; + CHAR ch1, ch2; + do {ch1 = x[i]; ch2 = y[i]; i++; + if (!ch1) return -(int)ch2; + } while (ch1==ch2); + return (int)ch1 - (int)ch2; +} +#define __STRCMP(a,b) __str_cmp((CHAR*)(a), (CHAR*)(b)) + + + +// Inline string, record and array copy + +#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d; LONGINT _i=0,_t=n-1; \ + while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;} +#define __DUP(x, l, t) x=(void*)memcpy((void*)(uintptr_t)Platform_OSAllocate(l*sizeof(t)),x,l*sizeof(t)) +#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t)) +#define __DEL(x) Platform_OSFree((LONGINT)(uintptr_t)x) + + + + +/* SYSTEM ops */ + +#define __VAL(t, x) ((t)(x)) +#define __VALP(t, x) ((t)(uintptr_t)(x)) + +#define __GET(a, x, t) x= *(t*)(uintptr_t)(a) +#define __PUT(a, x, t) *(t*)(uintptr_t)(a)=x +#define __LSHL(x, n, t) ((t)((unsigned t)(x)<<(n))) +#define __LSHR(x, n, t) ((t)((unsigned t)(x)>>(n))) +#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) +#define __ROTL(x, n, t) ((t)((unsigned t)(x)<<(n)|(unsigned t)(x)>>(8*sizeof(t)-(n)))) +#define __ROTR(x, n, t) ((t)((unsigned t)(x)>>(n)|(unsigned t)(x)<<(8*sizeof(t)-(n)))) +#define __LSHR(x, n, t) ((t)((unsigned t)(x)>>(n))) +#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) +#define __ROTL(x, n, t) ((t)((unsigned t)(x)<<(n)|(unsigned t)(x)>>(8*sizeof(t)-(n)))) +#define __ROTR(x, n, t) ((t)((unsigned t)(x)>>(n)|(unsigned t)(x)<<(8*sizeof(t)-(n)))) +#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t)) +#define __BIT(x, n) (*(unsigned LONGINT*)(x)>>(n)&1) +#define __MOVE(s, d, n) memcpy((char*)(uintptr_t)(d),(char*)(uintptr_t)(s),n) +#define __ASHL(x, n) ((LONGINT)(x)<<(n)) +#define __ASHR(x, n) ((LONGINT)(x)>>(n)) +#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n))) +#define __ASHF(x, n) SYSTEM_ASH((LONGINT)(x), (LONGINT)(n)) +#define __SHORT(x, y) ((int)((unsigned LONGINT)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0))) +#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y))) +#define __CHR(x) ((CHAR)__R(x, 256)) +#define __CHRF(x) ((CHAR)__RF(x, 256)) +#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y))) +#define __DIVF(x, y) SYSTEM_DIV((LONGINT)(x),(LONGINT)(y)) +#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y)) +#define __MODF(x, y) SYSTEM_MOD((LONGINT)(x),(LONGINT)(y)) +#define __ENTIER(x) SYSTEM_ENTIER(x) +#define __ABS(x) (((x)<0)?-(x):(x)) +#define __ABSF(x) SYSTEM_ABS((LONGINT)(x)) +#define __ABSFD(x) SYSTEM_ABSD((double)(x)) +#define __CAP(ch) ((CHAR)((ch)&0x5f)) +#define __ODD(x) ((x)&1) +#define __IN(x, s) (((s)>>(x))&1) +#define __SETOF(x) ((SET)1<<(x)) +#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h))) +#define __MASK(x, m) ((x)&~(m)) + + + +// Runtime checks + +#define __X(i, ub) (((unsigned LONGINT)(i)<(unsigned LONGINT)(ub))?i:(__HALT(-2),0)) +#define __XF(i, ub) SYSTEM_XCHK((LONGINT)(i), (LONGINT)(ub)) +#define __R(i, ub) (((unsigned LONGINT)(i)<(unsigned LONGINT)(ub))?i:(__HALT(-8),0)) +#define __RF(i, ub) SYSTEM_RCHK((LONGINT)(i),(LONGINT)(ub)) +#define __RETCHK __retchk: __HALT(-3); return 0; +#define __CASECHK __HALT(-4) +#define __WITHCHK __HALT(-7) + +#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p))) +#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r)))) +#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p))) +#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p) +#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p) + + + +// Module entry/registration/exit + +extern void Heap_REGCMD(); +extern SYSTEM_PTR Heap_REGMOD(); +extern void Heap_REGTYP(); +extern void Heap_INCREF(); + +#define __DEFMOD static void *m; if (m!=0) {return m;} +#define __REGCMD(name, cmd) Heap_REGCMD(m, (CHAR*)name, cmd) +#define __REGMOD(name, enum) if (m==0) {m = Heap_REGMOD((CHAR*)name,enum);} +#define __ENDMOD return m +#define __MODULE_IMPORT(name) Heap_INCREF(name##__init()) + + + +// Main module initialisation, registration and finalisation + +extern void Platform_Init(INTEGER argc, LONGINT argv); +extern void *Platform_MainModule; +extern void Heap_FINALL(); + +#define __INIT(argc, argv) static void *m; Platform_Init((INTEGER)argc, (LONGINT)(uintptr_t)&argv); +#define __REGMAIN(name, enum) m = Heap_REGMOD((CHAR*)name,enum) +#define __FINI Heap_FINALL(); return 0 + + +// Assertions and Halts + +extern void Platform_Halt(LONGINT x); +extern void Platform_AssertFail(LONGINT x); + +#define __HALT(x) Platform_Halt(x) +#define __ASSERT(cond, x) if (!(cond)) Platform_AssertFail((LONGINT)(x)) + + +// Memory allocation + +extern SYSTEM_PTR Heap_NEWBLK (LONGINT size); +extern SYSTEM_PTR Heap_NEWREC (LONGINT tag); +extern SYSTEM_PTR SYSTEM_NEWARR(LONGINT*, LONGINT, int, int, int, ...); + +#define __SYSNEW(p, len) p = Heap_NEWBLK((LONGINT)(len)) +#define __NEW(p, t) p = Heap_NEWREC((LONGINT)(uintptr_t)t##__typ) +#define __NEWARR SYSTEM_NEWARR + + + +/* Type handling */ + +#define __TDESC(t, m, n) \ + static struct t##__desc { \ + LONGINT tproc[m]; /* Proc for each ptr field */ \ + LONGINT tag; \ + LONGINT next; /* Module table type list points here */ \ + LONGINT level; \ + LONGINT module; \ + char name[24]; \ + LONGINT basep[__MAXEXT]; /* List of bases this extends */ \ + LONGINT reserved; \ + LONGINT blksz; /* xxx_typ points here */ \ + LONGINT ptr[n+1]; /* Offsets of ptrs up to -ve sentinel */ \ + } t##__desc + +#define __BASEOFF (__MAXEXT+1) // blksz as index to base. +#define __TPROC0OFF (__BASEOFF+24/sizeof(LONGINT)+5) // blksz as index to tproc IFF m=1. +#define __EOM 1 +#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size +#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (LONGINT)(n), P) +#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (LONGINT)(size), (LONGINT)(n), P) + +#define __INITYP(t, t0, level) \ + t##__typ = (LONGINT*)&t##__desc.blksz; \ + memcpy(t##__desc.basep, t0##__typ - __BASEOFF, level*sizeof(LONGINT)); \ + t##__desc.basep[level] = (LONGINT)(uintptr_t)t##__typ; \ + t##__desc.module = (LONGINT)(uintptr_t)m; \ + if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \ + t##__desc.blksz = (t##__desc.blksz+5*sizeof(LONGINT)-1)/(4*sizeof(LONGINT))*(4*sizeof(LONGINT)); \ + Heap_REGTYP(m, (LONGINT)(uintptr_t)&t##__desc.next); \ + SYSTEM_INHERIT(t##__typ, t0##__typ) + +#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(LONGINT)(uintptr_t)typ##__typ) +#define __TYPEOF(p) ((LONGINT*)(uintptr_t)(*(((LONGINT*)(p))-1))) +#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level) + +// Oberon-2 type bound procedures support +#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(LONGINT)(uintptr_t)proc +#define __SEND(typ, num, funtyp, parlist) ((funtyp)((uintptr_t)*(typ-(__TPROC0OFF+num))))parlist + + + + +#endif diff --git a/bootstrap/unix-48/Strings.c b/bootstrap/unix-48/Strings.c new file mode 100644 index 00000000..5038ca68 --- /dev/null +++ b/bootstrap/unix-48/Strings.c @@ -0,0 +1,243 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" + + + + +export void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len); +export void Strings_Cap (CHAR *s, LONGINT s__len); +export void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n); +export void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len); +export void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len); +export INTEGER Strings_Length (CHAR *s, LONGINT s__len); +export BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len); +export INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos); +export void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len); + + +INTEGER Strings_Length (CHAR *s, LONGINT s__len) +{ + INTEGER _o_result; + INTEGER i; + __DUP(s, s__len, CHAR); + i = 0; + while (((LONGINT)i < s__len && s[__X(i, s__len)] != 0x00)) { + i += 1; + } + _o_result = i; + __DEL(s); + return _o_result; +} + +void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len) +{ + INTEGER n1, n2, i; + __DUP(extra, extra__len, CHAR); + n1 = Strings_Length(dest, dest__len); + n2 = Strings_Length(extra, extra__len); + i = 0; + while ((i < n2 && (LONGINT)(i + n1) < dest__len)) { + dest[__X(i + n1, dest__len)] = extra[__X(i, extra__len)]; + i += 1; + } + if ((LONGINT)(i + n1) < dest__len) { + dest[__X(i + n1, dest__len)] = 0x00; + } + __DEL(extra); +} + +void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len) +{ + INTEGER n1, n2, i; + __DUP(source, source__len, CHAR); + n1 = Strings_Length(dest, dest__len); + n2 = Strings_Length(source, source__len); + if (pos < 0) { + pos = 0; + } + if (pos > n1) { + Strings_Append(dest, dest__len, (void*)source, source__len); + return; + } + if ((LONGINT)(pos + n2) < dest__len) { + i = n1; + while (i >= pos) { + if ((LONGINT)(i + n2) < dest__len) { + dest[__X(i + n2, dest__len)] = dest[__X(i, dest__len)]; + } + i -= 1; + } + } + i = 0; + while (i < n2) { + dest[__X(pos + i, dest__len)] = source[__X(i, source__len)]; + i += 1; + } + __DEL(source); +} + +void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n) +{ + INTEGER len, i; + len = Strings_Length(s, s__len); + if (pos < 0) { + pos = 0; + } else if (pos >= len) { + return; + } + if (pos + n < len) { + i = pos + n; + while (i < len) { + s[__X(i - n, s__len)] = s[__X(i, s__len)]; + i += 1; + } + if ((LONGINT)(i - n) < s__len) { + s[__X(i - n, s__len)] = 0x00; + } + } else { + s[__X(pos, s__len)] = 0x00; + } +} + +void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len) +{ + __DUP(source, source__len, CHAR); + Strings_Delete((void*)dest, dest__len, pos, pos + Strings_Length(source, source__len)); + Strings_Insert(source, source__len, pos, (void*)dest, dest__len); + __DEL(source); +} + +void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len) +{ + INTEGER len, destLen, i; + __DUP(source, source__len, CHAR); + len = Strings_Length(source, source__len); + destLen = (int)dest__len - 1; + if (pos < 0) { + pos = 0; + } + if (pos >= len) { + dest[0] = 0x00; + return; + } + i = 0; + while (((((LONGINT)(pos + i) <= source__len && source[__X(pos + i, source__len)] != 0x00)) && i < n)) { + if (i < destLen) { + dest[__X(i, dest__len)] = source[__X(pos + i, source__len)]; + } + i += 1; + } + dest[__X(i, dest__len)] = 0x00; + __DEL(source); +} + +INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos) +{ + INTEGER _o_result; + INTEGER n1, n2, i, j; + __DUP(pattern, pattern__len, CHAR); + __DUP(s, s__len, CHAR); + n1 = Strings_Length(s, s__len); + n2 = Strings_Length(pattern, pattern__len); + if (n2 == 0) { + _o_result = 0; + __DEL(pattern); + __DEL(s); + return _o_result; + } + i = pos; + while (i <= n1 - n2) { + if (s[__X(i, s__len)] == pattern[0]) { + j = 1; + while ((j < n2 && s[__X(i + j, s__len)] == pattern[__X(j, pattern__len)])) { + j += 1; + } + if (j == n2) { + _o_result = i; + __DEL(pattern); + __DEL(s); + return _o_result; + } + } + i += 1; + } + _o_result = -1; + __DEL(pattern); + __DEL(s); + return _o_result; +} + +void Strings_Cap (CHAR *s, LONGINT s__len) +{ + INTEGER i; + i = 0; + while (s[__X(i, s__len)] != 0x00) { + if (('a' <= s[__X(i, s__len)] && s[__X(i, s__len)] <= 'z')) { + s[__X(i, s__len)] = __CAP(s[__X(i, s__len)]); + } + i += 1; + } +} + +static struct Match__7 { + struct Match__7 *lnk; +} *Match__7_s; + +static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INTEGER n, INTEGER m); + +static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INTEGER n, INTEGER m) +{ + BOOLEAN _o_result; + while ((((n >= 0 && m >= 0)) && mask[__X(m, mask__len)] != '*')) { + if (name[__X(n, name__len)] != mask[__X(m, mask__len)]) { + _o_result = 0; + return _o_result; + } + n -= 1; + m -= 1; + } + if (m < 0) { + _o_result = n < 0; + return _o_result; + } + while ((m >= 0 && mask[__X(m, mask__len)] == '*')) { + m -= 1; + } + if (m < 0) { + _o_result = 1; + return _o_result; + } + while (n >= 0) { + if (M__8(name, name__len, mask, mask__len, n, m)) { + _o_result = 1; + return _o_result; + } + n -= 1; + } + _o_result = 0; + return _o_result; +} + +BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len) +{ + BOOLEAN _o_result; + struct Match__7 _s; + __DUP(string, string__len, CHAR); + __DUP(pattern, pattern__len, CHAR); + _s.lnk = Match__7_s; + Match__7_s = &_s; + _o_result = M__8((void*)string, string__len, (void*)pattern, pattern__len, Strings_Length(string, string__len) - 1, Strings_Length(pattern, pattern__len) - 1); + Match__7_s = _s.lnk; + __DEL(string); + __DEL(pattern); + return _o_result; +} + + +export void *Strings__init(void) +{ + __DEFMOD; + __REGMOD("Strings", 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-48/Strings.h b/bootstrap/unix-48/Strings.h new file mode 100644 index 00000000..a8d8d207 --- /dev/null +++ b/bootstrap/unix-48/Strings.h @@ -0,0 +1,23 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Strings__h +#define Strings__h + +#include "SYSTEM.h" + + + + +import void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len); +import void Strings_Cap (CHAR *s, LONGINT s__len); +import void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n); +import void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len); +import void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len); +import INTEGER Strings_Length (CHAR *s, LONGINT s__len); +import BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len); +import INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos); +import void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len); +import void *Strings__init(void); + + +#endif diff --git a/bootstrap/unix-48/Texts.c b/bootstrap/unix-48/Texts.c new file mode 100644 index 00000000..8c2cc3b2 --- /dev/null +++ b/bootstrap/unix-48/Texts.c @@ -0,0 +1,1838 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "Files.h" +#include "Modules.h" +#include "Reals.h" + +typedef + struct Texts_RunDesc *Texts_Run; + +typedef + struct Texts_FontDesc *Texts_FontsFont; + +typedef + struct Texts_RunDesc { + Texts_Run prev, next; + LONGINT len; + Texts_FontsFont fnt; + SHORTINT col, voff; + BOOLEAN ascii; + } Texts_RunDesc; + +typedef + struct Texts_ElemDesc *Texts_Elem; + +typedef + struct Texts_ElemMsg { + char _prvt0[1]; + } Texts_ElemMsg; + +typedef + void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, LONGINT *); + +typedef + struct Texts_TextDesc *Texts_Text; + +typedef + struct Texts_ElemDesc { + Texts_Run prev, next; + LONGINT len; + Texts_FontsFont fnt; + SHORTINT col, voff; + BOOLEAN ascii; + LONGINT W, H; + Texts_Handler handle; + Texts_Text base; + } Texts_ElemDesc; + +struct Texts__1 { /* Texts_ElemDesc */ + Texts_Run prev, next; + LONGINT len; + Texts_FontsFont fnt; + SHORTINT col, voff; + BOOLEAN ascii; + LONGINT W, H; + Texts_Handler handle; + Texts_Text base; + Files_File file; + LONGINT org, span; + CHAR mod[32], proc[32]; +}; + +typedef + struct Texts__1 *Texts_Alien; + +typedef + struct Texts_BufDesc { + LONGINT len; + Texts_Run head; + } Texts_BufDesc; + +typedef + Texts_BufDesc *Texts_Buffer; + +typedef + struct Texts_CopyMsg { /* Texts_ElemMsg */ + Texts_Elem e; + } Texts_CopyMsg; + +typedef + struct Texts_FileMsg { /* Texts_ElemMsg */ + INTEGER id; + LONGINT pos; + Files_Rider r; + } Texts_FileMsg; + +typedef + struct Texts_FontDesc { + CHAR name[32]; + } Texts_FontDesc; + +typedef + struct Texts_IdentifyMsg { /* Texts_ElemMsg */ + CHAR mod[32], proc[32]; + } Texts_IdentifyMsg; + +typedef + void (*Texts_Notifier)(Texts_Text, INTEGER, LONGINT, LONGINT); + +typedef + struct Texts_PieceDesc *Texts_Piece; + +typedef + struct Texts_PieceDesc { + Texts_Run prev, next; + LONGINT len; + Texts_FontsFont fnt; + SHORTINT col, voff; + BOOLEAN ascii; + Files_File file; + LONGINT org; + } Texts_PieceDesc; + +typedef + struct Texts_Reader { + BOOLEAN eot; + Texts_FontsFont fnt; + SHORTINT col, voff; + Texts_Elem elem; + Files_Rider rider; + Texts_Run run; + LONGINT org, off; + } Texts_Reader; + +typedef + struct Texts_Scanner { /* Texts_Reader */ + BOOLEAN eot; + Texts_FontsFont fnt; + SHORTINT col, voff; + Texts_Elem elem; + Files_Rider rider; + Texts_Run run; + LONGINT org, off; + CHAR nextCh; + INTEGER line, class; + LONGINT i; + REAL x; + LONGREAL y; + CHAR c; + SHORTINT len; + CHAR s[64]; + } Texts_Scanner; + +typedef + struct Texts_TextDesc { + LONGINT len; + Texts_Notifier notify; + Texts_Run head, cache; + LONGINT corg; + } Texts_TextDesc; + +typedef + struct Texts_Writer { + Texts_Buffer buf; + Texts_FontsFont fnt; + SHORTINT col, voff; + Files_Rider rider; + Files_File file; + } Texts_Writer; + + +export Texts_Elem Texts_new; +static Texts_Buffer Texts_del; +static Texts_FontsFont Texts_FontsDefault; + +export LONGINT *Texts_FontDesc__typ; +export LONGINT *Texts_RunDesc__typ; +export LONGINT *Texts_PieceDesc__typ; +export LONGINT *Texts_ElemMsg__typ; +export LONGINT *Texts_ElemDesc__typ; +export LONGINT *Texts_FileMsg__typ; +export LONGINT *Texts_CopyMsg__typ; +export LONGINT *Texts_IdentifyMsg__typ; +export LONGINT *Texts_BufDesc__typ; +export LONGINT *Texts_TextDesc__typ; +export LONGINT *Texts_Reader__typ; +export LONGINT *Texts_Scanner__typ; +export LONGINT *Texts_Writer__typ; +export LONGINT *Texts__1__typ; + +export void Texts_Append (Texts_Text T, Texts_Buffer B); +export void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff); +static Texts_Elem Texts_CloneElem (Texts_Elem e); +static Texts_Piece Texts_ClonePiece (Texts_Piece p); +export void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len); +export void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB); +export void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE); +export void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end); +export Texts_Text Texts_ElemBase (Texts_Elem E); +export LONGINT Texts_ElemPos (Texts_Elem E); +static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org, LONGINT *off); +static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len); +static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__typ); +export void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B); +export void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v); +export void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len); +export void Texts_OpenBuf (Texts_Buffer B); +export void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos); +export void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos); +export void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ); +export LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ); +export void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch); +export void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ); +export void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ); +export void Texts_Recall (Texts_Buffer *B); +export void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B); +export void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ); +export void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col); +export void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt); +export void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff); +static void Texts_Splice (Texts_Run un, Texts_Run v, Texts_Run w, Texts_Text base); +static void Texts_Split (LONGINT off, Texts_Run *u, Texts_Run *un); +export void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +export void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch); +export void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d); +export void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e); +export void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x); +export void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n); +export void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ); +export void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n); +export void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x); +export void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n); +export void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k); +export void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x); +export void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len); + + +static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len) +{ + Texts_FontsFont _o_result; + Texts_FontsFont F = NIL; + __NEW(F, Texts_FontDesc); + __COPY(name, F->name, ((LONGINT)(32))); + _o_result = F; + return _o_result; +} + +static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org, LONGINT *off) +{ + Texts_Run v = NIL; + LONGINT m; + if (*pos >= T->len) { + *pos = T->len; + *u = T->head; + *org = T->len; + *off = 0; + T->cache = T->head; + T->corg = 0; + } else { + v = T->cache->next; + m = *pos - T->corg; + if (*pos >= T->corg) { + while (m >= v->len) { + m -= v->len; + v = v->next; + } + } else { + while (m < 0) { + v = v->prev; + m += v->len; + } + } + *u = v; + *org = *pos - m; + *off = m; + T->cache = v->prev; + T->corg = *org; + } +} + +static void Texts_Split (LONGINT off, Texts_Run *u, Texts_Run *un) +{ + Texts_Piece p = NIL, U = NIL; + if (off == 0) { + *un = *u; + *u = (*un)->prev; + } else if (off >= (*u)->len) { + *un = (*u)->next; + } else { + __NEW(p, Texts_PieceDesc); + *un = (Texts_Run)p; + U = __GUARDP(*u, Texts_PieceDesc, 1); + __GUARDEQP(p, Texts_PieceDesc) = *U; + p->org += off; + p->len -= off; + U->len -= p->len; + p->ascii = (*u)->ascii; + p->prev = (Texts_Run)U; + p->next = U->next; + p->next->prev = (Texts_Run)p; + U->next = (Texts_Run)p; + } +} + +static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v) +{ + Texts_Piece p = NIL, q = NIL; + if ((((((((((__ISP(u, Texts_PieceDesc, 1) && __ISP(*v, Texts_PieceDesc, 1))) && __STRCMP(u->fnt->name, (*v)->fnt->name) == 0)) && u->col == (*v)->col)) && u->voff == (*v)->voff)) && __GUARDP(u, Texts_PieceDesc, 1)->ascii == __GUARDP(*v, Texts_PieceDesc, 1)->ascii)) { + p = __GUARDP(u, Texts_PieceDesc, 1); + q = __GUARDP(*v, Texts_PieceDesc, 1); + if ((p->file == q->file && p->org + p->len == q->org)) { + if (T->cache == u) { + T->corg += q->len; + } else if (T->cache == *v) { + T->cache = T->head; + T->corg = 0; + } + p->len += q->len; + *v = (*v)->next; + } + } +} + +static void Texts_Splice (Texts_Run un, Texts_Run v, Texts_Run w, Texts_Text base) +{ + Texts_Run u = NIL; + if (v != w->next) { + u = un->prev; + u->next = v; + v->prev = u; + un->prev = w; + w->next = un; + do { + if (__ISP(v, Texts_ElemDesc, 1)) { + __GUARDP(v, Texts_ElemDesc, 1)->base = base; + } + v = v->next; + } while (!(v == un)); + } +} + +static Texts_Piece Texts_ClonePiece (Texts_Piece p) +{ + Texts_Piece _o_result; + Texts_Piece q = NIL; + __NEW(q, Texts_PieceDesc); + __GUARDEQP(q, Texts_PieceDesc) = *p; + _o_result = q; + return _o_result; +} + +static Texts_Elem Texts_CloneElem (Texts_Elem e) +{ + Texts_Elem _o_result; + Texts_CopyMsg msg; + msg.e = NIL; + (*e->handle)(e, (void*)&msg, Texts_CopyMsg__typ); + _o_result = msg.e; + return _o_result; +} + +void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE) +{ + DE->len = SE->len; + DE->fnt = SE->fnt; + DE->col = SE->col; + DE->voff = SE->voff; + DE->W = SE->W; + DE->H = SE->H; + DE->handle = SE->handle; +} + +Texts_Text Texts_ElemBase (Texts_Elem E) +{ + Texts_Text _o_result; + _o_result = E->base; + return _o_result; +} + +LONGINT Texts_ElemPos (Texts_Elem E) +{ + LONGINT _o_result; + Texts_Run u = NIL; + LONGINT pos; + u = E->base->head->next; + pos = 0; + while (u != (void *) E) { + pos = pos + u->len; + u = u->next; + } + _o_result = pos; + return _o_result; +} + +static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__typ) +{ + Texts_Alien e = NIL; + Files_Rider r; + LONGINT i; + CHAR ch; + if (__ISP(E, Texts__1, 2)) { + if (__IS(msg__typ, Texts_CopyMsg, 1)) { + if (__IS(msg__typ, Texts_CopyMsg, 1)) { + Texts_CopyMsg *msg__ = (void*)msg; + __NEW(e, Texts__1); + Texts_CopyElem((void*)((Texts_Alien)E), (void*)e); + e->file = ((Texts_Alien)E)->file; + e->org = ((Texts_Alien)E)->org; + e->span = ((Texts_Alien)E)->span; + __COPY(((Texts_Alien)E)->mod, e->mod, ((LONGINT)(32))); + __COPY(((Texts_Alien)E)->proc, e->proc, ((LONGINT)(32))); + (*msg__).e = (Texts_Elem)e; + } else __WITHCHK; + } else if (__IS(msg__typ, Texts_IdentifyMsg, 1)) { + if (__IS(msg__typ, Texts_IdentifyMsg, 1)) { + Texts_IdentifyMsg *msg__ = (void*)msg; + __COPY(((Texts_Alien)E)->mod, (*msg__).mod, ((LONGINT)(32))); + __COPY(((Texts_Alien)E)->proc, (*msg__).proc, ((LONGINT)(32))); + (*msg__).mod[31] = 0x01; + } else __WITHCHK; + } else if (__IS(msg__typ, Texts_FileMsg, 1)) { + if (__IS(msg__typ, Texts_FileMsg, 1)) { + Texts_FileMsg *msg__ = (void*)msg; + if ((*msg__).id == 1) { + Files_Set(&r, Files_Rider__typ, ((Texts_Alien)E)->file, ((Texts_Alien)E)->org); + i = ((Texts_Alien)E)->span; + while (i > 0) { + Files_Read(&r, Files_Rider__typ, (void*)&ch); + Files_Write(&(*msg__).r, Files_Rider__typ, ch); + i -= 1; + } + } + } else __WITHCHK; + } + } else __WITHCHK; +} + +void Texts_OpenBuf (Texts_Buffer B) +{ + Texts_Run u = NIL; + __NEW(u, Texts_RunDesc); + u->next = u; + u->prev = u; + B->head = u; + B->len = 0; +} + +void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB) +{ + Texts_Run u = NIL, v = NIL, vn = NIL; + u = SB->head->next; + v = DB->head->prev; + while (u != SB->head) { + if (__ISP(u, Texts_PieceDesc, 1)) { + vn = (Texts_Run)Texts_ClonePiece(__GUARDP(u, Texts_PieceDesc, 1)); + } else { + vn = (Texts_Run)Texts_CloneElem(__GUARDP(u, Texts_ElemDesc, 1)); + } + v->next = vn; + vn->prev = v; + v = vn; + u = u->next; + } + v->next = DB->head; + DB->head->prev = v; + DB->len += SB->len; +} + +void Texts_Recall (Texts_Buffer *B) +{ + *B = Texts_del; + Texts_del = NIL; +} + +void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B) +{ + Texts_Run u = NIL, v = NIL, w = NIL, wn = NIL; + LONGINT uo, ud, vo, vd; + Texts_Find(T, &beg, &u, &uo, &ud); + Texts_Find(T, &end, &v, &vo, &vd); + w = B->head->prev; + while (u != v) { + if (__ISP(u, Texts_PieceDesc, 1)) { + wn = (Texts_Run)Texts_ClonePiece(__GUARDP(u, Texts_PieceDesc, 1)); + wn->len -= ud; + __GUARDP(wn, Texts_PieceDesc, 1)->org += ud; + } else { + wn = (Texts_Run)Texts_CloneElem(__GUARDP(u, Texts_ElemDesc, 1)); + } + w->next = wn; + wn->prev = w; + w = wn; + u = u->next; + ud = 0; + } + if (vd > 0) { + wn = (Texts_Run)Texts_ClonePiece(__GUARDP(v, Texts_PieceDesc, 1)); + wn->len = vd - ud; + __GUARDP(wn, Texts_PieceDesc, 1)->org += ud; + w->next = wn; + wn->prev = w; + w = wn; + } + w->next = B->head; + B->head->prev = w; + B->len += end - beg; +} + +void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B) +{ + Texts_Run u = NIL, un = NIL, v = NIL; + Texts_Piece p = NIL, q = NIL; + LONGINT uo, ud, len; + Texts_Find(T, &pos, &u, &uo, &ud); + Texts_Split(ud, &u, &un); + len = B->len; + v = B->head->next; + Texts_Merge(T, u, &v); + Texts_Splice(un, v, B->head->prev, T); + T->len += len; + B->head->next = B->head; + B->head->prev = B->head; + B->len = 0; + if (T->notify != NIL) { + (*T->notify)(T, 1, pos, pos + len); + } +} + +void Texts_Append (Texts_Text T, Texts_Buffer B) +{ + Texts_Run v = NIL; + LONGINT pos, len; + pos = T->len; + len = B->len; + v = B->head->next; + Texts_Merge(T, T->head->prev, &v); + Texts_Splice(T->head, v, B->head->prev, T); + T->len += len; + B->head->next = B->head; + B->head->prev = B->head; + B->len = 0; + if (T->notify != NIL) { + (*T->notify)(T, 1, pos, pos + len); + } +} + +void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end) +{ + Texts_Run c = NIL, u = NIL, un = NIL, v = NIL, vn = NIL; + LONGINT co, uo, ud, vo, vd; + Texts_Find(T, &beg, &u, &uo, &ud); + Texts_Split(ud, &u, &un); + c = T->cache; + co = T->corg; + Texts_Find(T, &end, &v, &vo, &vd); + Texts_Split(vd, &v, &vn); + T->cache = c; + T->corg = co; + __NEW(Texts_del, Texts_BufDesc); + Texts_OpenBuf(Texts_del); + Texts_del->len = end - beg; + Texts_Splice(Texts_del->head, un, v, NIL); + Texts_Merge(T, u, &vn); + u->next = vn; + vn->prev = u; + T->len -= end - beg; + if (T->notify != NIL) { + (*T->notify)(T, 2, beg, end); + } +} + +void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff) +{ + Texts_Run c = NIL, u = NIL, un = NIL, v = NIL, vn = NIL; + LONGINT co, uo, ud, vo, vd; + Texts_Find(T, &beg, &u, &uo, &ud); + Texts_Split(ud, &u, &un); + c = T->cache; + co = T->corg; + Texts_Find(T, &end, &v, &vo, &vd); + Texts_Split(vd, &v, &vn); + T->cache = c; + T->corg = co; + while (un != vn) { + if ((__IN(0, sel) && fnt != NIL)) { + un->fnt = fnt; + } + if (__IN(1, sel)) { + un->col = col; + } + if (__IN(2, sel)) { + un->voff = voff; + } + Texts_Merge(T, u, &un); + if (u->next == un) { + u = un; + un = un->next; + } else { + u->next = un; + un->prev = u; + } + } + Texts_Merge(T, u, &un); + u->next = un; + un->prev = u; + if (T->notify != NIL) { + (*T->notify)(T, 0, beg, end); + } +} + +void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos) +{ + Texts_Run u = NIL; + if (pos >= T->len) { + pos = T->len; + } + Texts_Find(T, &pos, &u, &(*R).org, &(*R).off); + (*R).run = u; + (*R).eot = 0; + if (__ISP(u, Texts_PieceDesc, 1)) { + Files_Set(&(*R).rider, Files_Rider__typ, __GUARDP(u, Texts_PieceDesc, 1)->file, __GUARDP(u, Texts_PieceDesc, 1)->org + (*R).off); + } +} + +void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch) +{ + Texts_Run u = NIL; + LONGINT pos; + CHAR nextch; + u = (*R).run; + (*R).fnt = u->fnt; + (*R).col = u->col; + (*R).voff = u->voff; + (*R).off += 1; + if (__ISP(u, Texts_PieceDesc, 1)) { + Files_Read(&(*R).rider, Files_Rider__typ, (void*)&*ch); + (*R).elem = NIL; + if ((*ch == 0x0a && __GUARDP(u, Texts_PieceDesc, 1)->ascii)) { + *ch = 0x0d; + } else if ((*ch == 0x0d && __GUARDP(u, Texts_PieceDesc, 1)->ascii)) { + pos = Files_Pos(&(*R).rider, Files_Rider__typ); + Files_Read(&(*R).rider, Files_Rider__typ, (void*)&nextch); + if (nextch == 0x0a) { + (*R).off += 1; + } else { + Files_Set(&(*R).rider, Files_Rider__typ, __GUARDP(u, Texts_PieceDesc, 1)->file, pos); + } + } + } else if (__ISP(u, Texts_ElemDesc, 1)) { + *ch = 0x1c; + (*R).elem = __GUARDP(u, Texts_ElemDesc, 1); + } else { + *ch = 0x00; + (*R).elem = NIL; + (*R).eot = 1; + } + if ((*R).off == u->len) { + (*R).org += u->len; + u = u->next; + if (__ISP(u, Texts_PieceDesc, 1)) { + if (__ISP(u, Texts_PieceDesc, 1)) { + Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org); + } else __WITHCHK; + } + (*R).run = u; + (*R).off = 0; + } +} + +void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ) +{ + Texts_Run u = NIL, un = NIL; + u = (*R).run; + while (__ISP(u, Texts_PieceDesc, 1)) { + (*R).org += u->len; + u = u->next; + } + if (__ISP(u, Texts_ElemDesc, 1)) { + un = u->next; + (*R).run = un; + (*R).org += 1; + (*R).off = 0; + (*R).fnt = u->fnt; + (*R).col = u->col; + (*R).voff = u->voff; + (*R).elem = __GUARDP(u, Texts_ElemDesc, 1); + if (__ISP(un, Texts_PieceDesc, 1)) { + if (__ISP(un, Texts_PieceDesc, 1)) { + Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)un)->file, ((Texts_Piece)un)->org); + } else __WITHCHK; + } + } else { + (*R).eot = 1; + (*R).elem = NIL; + } +} + +void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ) +{ + Texts_Run u = NIL; + u = (*R).run->prev; + while (__ISP(u, Texts_PieceDesc, 1)) { + (*R).org -= u->len; + u = u->prev; + } + if (__ISP(u, Texts_ElemDesc, 1)) { + (*R).run = u; + (*R).org -= 1; + (*R).off = 0; + (*R).fnt = u->fnt; + (*R).col = u->col; + (*R).voff = u->voff; + (*R).elem = __GUARDP(u, Texts_ElemDesc, 1); + } else { + (*R).eot = 1; + (*R).elem = NIL; + } +} + +LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ) +{ + LONGINT _o_result; + _o_result = (*R).org + (*R).off; + return _o_result; +} + +void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos) +{ + Texts_OpenReader((void*)&*S, S__typ, T, pos); + (*S).line = 0; + (*S).nextCh = ' '; +} + +static struct Scan__31 { + Texts_Scanner *S; + LONGINT *S__typ; + CHAR *ch; + BOOLEAN *negE; + INTEGER *e; + struct Scan__31 *lnk; +} *Scan__31_s; + +static void ReadScaleFactor__32 (void); + +static void ReadScaleFactor__32 (void) +{ + Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch); + if (*Scan__31_s->ch == '-') { + *Scan__31_s->negE = 1; + Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch); + } else { + *Scan__31_s->negE = 0; + if (*Scan__31_s->ch == '+') { + Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch); + } + } + while (('0' <= *Scan__31_s->ch && *Scan__31_s->ch <= '9')) { + *Scan__31_s->e = (*Scan__31_s->e * 10 + (int)*Scan__31_s->ch) - 48; + Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch); + } +} + +void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ) +{ + CHAR ch, term; + BOOLEAN neg, negE, hex; + SHORTINT i, j, h; + INTEGER e; + LONGINT k; + REAL x, f; + LONGREAL y, g; + CHAR d[32]; + struct Scan__31 _s; + _s.S = S; _s.S__typ = S__typ; + _s.ch = &ch; + _s.negE = &negE; + _s.e = &e; + _s.lnk = Scan__31_s; + Scan__31_s = &_s; + ch = (*S).nextCh; + i = 0; + for (;;) { + if (ch == 0x0d) { + (*S).line += 1; + } else if ((ch != ' ' && ch != 0x09)) { + break; + } + Texts_Read((void*)&*S, S__typ, &ch); + } + if ((('A' <= __CAP(ch) && __CAP(ch) <= 'Z') || ch == '/') || ch == '.') { + do { + (*S).s[__X(i, ((LONGINT)(64)))] = ch; + i += 1; + Texts_Read((void*)&*S, S__typ, &ch); + } while (!((((__CAP(ch) > 'Z' && ch != '_') || ('A' > __CAP(ch) && ch > '9')) || ((('0' > ch && ch != '.')) && ch != '/')) || i == 63)); + (*S).s[__X(i, ((LONGINT)(64)))] = 0x00; + (*S).len = i; + (*S).class = 1; + } else if (ch == '\"') { + Texts_Read((void*)&*S, S__typ, &ch); + while ((((ch != '\"' && ch >= ' ')) && i != 63)) { + (*S).s[__X(i, ((LONGINT)(64)))] = ch; + i += 1; + Texts_Read((void*)&*S, S__typ, &ch); + } + (*S).s[__X(i, ((LONGINT)(64)))] = 0x00; + (*S).len = i + 1; + Texts_Read((void*)&*S, S__typ, &ch); + (*S).class = 2; + } else { + if (ch == '-') { + neg = 1; + Texts_Read((void*)&*S, S__typ, &ch); + } else { + neg = 0; + } + if (('0' <= ch && ch <= '9')) { + hex = 0; + j = 0; + for (;;) { + d[__X(i, ((LONGINT)(32)))] = ch; + i += 1; + Texts_Read((void*)&*S, S__typ, &ch); + if (ch < '0') { + break; + } + if ('9' < ch) { + if (('A' <= ch && ch <= 'F')) { + hex = 1; + ch = (CHAR)((int)ch - 7); + } else if (('a' <= ch && ch <= 'f')) { + hex = 1; + ch = (CHAR)((int)ch - 39); + } else { + break; + } + } + } + if (ch == 'H') { + Texts_Read((void*)&*S, S__typ, &ch); + (*S).class = 3; + if (i - j > 8) { + j = i - 8; + } + k = (int)d[__X(j, ((LONGINT)(32)))] - 48; + j += 1; + if ((i - j == 7 && k >= 8)) { + k -= 16; + } + while (j < i) { + k = __ASHL(k, 4) + (LONGINT)((int)d[__X(j, ((LONGINT)(32)))] - 48); + j += 1; + } + if (neg) { + (*S).i = -k; + } else { + (*S).i = k; + } + } else if (ch == '.') { + Texts_Read((void*)&*S, S__typ, &ch); + h = i; + while (('0' <= ch && ch <= '9')) { + d[__X(i, ((LONGINT)(32)))] = ch; + i += 1; + Texts_Read((void*)&*S, S__typ, &ch); + } + if (ch == 'D') { + e = 0; + y = (LONGREAL)0; + g = (LONGREAL)1; + do { + y = y * (LONGREAL)10 + ((int)d[__X(j, ((LONGINT)(32)))] - 48); + j += 1; + } while (!(j == h)); + while (j < i) { + g = g / (LONGREAL)(LONGREAL)10; + y = ((int)d[__X(j, ((LONGINT)(32)))] - 48) * g + y; + j += 1; + } + ReadScaleFactor__32(); + if (negE) { + if (e <= 308) { + y = y / (LONGREAL)Reals_TenL(e); + } else { + y = (LONGREAL)0; + } + } else if (e > 0) { + if (e <= 308) { + y = Reals_TenL(e) * y; + } else { + __HALT(40); + } + } + if (neg) { + y = -y; + } + (*S).class = 5; + (*S).y = y; + } else { + e = 0; + x = (REAL)0; + f = (REAL)1; + do { + x = x * (REAL)10 + ((int)d[__X(j, ((LONGINT)(32)))] - 48); + j += 1; + } while (!(j == h)); + while (j < i) { + f = f / (REAL)(REAL)10; + x = ((int)d[__X(j, ((LONGINT)(32)))] - 48) * f + x; + j += 1; + } + if (ch == 'E') { + ReadScaleFactor__32(); + } + if (negE) { + if (e <= 38) { + x = x / (REAL)Reals_Ten(e); + } else { + x = (REAL)0; + } + } else if (e > 0) { + if (e <= 38) { + x = Reals_Ten(e) * x; + } else { + __HALT(40); + } + } + if (neg) { + x = -x; + } + (*S).class = 4; + (*S).x = x; + } + if (hex) { + (*S).class = 0; + } + } else { + (*S).class = 3; + k = 0; + do { + k = k * 10 + (LONGINT)((int)d[__X(j, ((LONGINT)(32)))] - 48); + j += 1; + } while (!(j == i)); + if (neg) { + (*S).i = -k; + } else { + (*S).i = k; + } + if (hex) { + (*S).class = 0; + } else { + (*S).class = 3; + } + } + } else { + (*S).class = 6; + if (neg) { + (*S).c = '-'; + } else { + (*S).c = ch; + Texts_Read((void*)&*S, S__typ, &ch); + } + } + } + (*S).nextCh = ch; + Scan__31_s = _s.lnk; +} + +void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ) +{ + __NEW((*W).buf, Texts_BufDesc); + Texts_OpenBuf((*W).buf); + (*W).fnt = Texts_FontsDefault; + (*W).col = 15; + (*W).voff = 0; + (*W).file = Files_New((CHAR*)"", (LONGINT)1); + Files_Set(&(*W).rider, Files_Rider__typ, (*W).file, ((LONGINT)(0))); +} + +void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt) +{ + (*W).fnt = fnt; +} + +void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col) +{ + (*W).col = col; +} + +void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff) +{ + (*W).voff = voff; +} + +void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch) +{ + Texts_Run u = NIL, un = NIL; + Texts_Piece p = NIL; + Files_Write(&(*W).rider, Files_Rider__typ, ch); + (*W).buf->len += 1; + un = (*W).buf->head; + u = un->prev; + if ((((((((((__ISP(u, Texts_PieceDesc, 1) && __GUARDP(u, Texts_PieceDesc, 1)->file == (*W).file)) && __STRCMP(u->fnt->name, (*W).fnt->name) == 0)) && u->col == (*W).col)) && u->voff == (*W).voff)) && !__GUARDP(u, Texts_PieceDesc, 1)->ascii)) { + u->len += 1; + } else { + __NEW(p, Texts_PieceDesc); + u->next = (Texts_Run)p; + p->prev = u; + p->next = un; + un->prev = (Texts_Run)p; + p->len = 1; + p->fnt = (*W).fnt; + p->col = (*W).col; + p->voff = (*W).voff; + p->file = (*W).file; + p->org = Files_Length((*W).file) - 1; + p->ascii = 0; + } +} + +void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e) +{ + Texts_Run u = NIL, un = NIL; + if (e->base != NIL) { + __HALT(99); + } + (*W).buf->len += 1; + e->len = 1; + e->fnt = (*W).fnt; + e->col = (*W).col; + e->voff = (*W).voff; + un = (*W).buf->head; + u = un->prev; + u->next = (Texts_Run)e; + e->prev = u; + e->next = un; + un->prev = (Texts_Run)e; +} + +void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ) +{ + Texts_Write(&*W, W__typ, 0x0d); +} + +void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len) +{ + INTEGER i; + __DUP(s, s__len, CHAR); + i = 0; + while (s[__X(i, s__len)] >= ' ') { + Texts_Write(&*W, W__typ, s[__X(i, s__len)]); + i += 1; + } + __DEL(s); +} + +void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n) +{ + INTEGER i; + LONGINT x0; + CHAR a[22]; + i = 0; + if (x < 0) { + if (x == (-2147483647-1)) { + Texts_WriteString(&*W, W__typ, (CHAR*)" -2147483648", (LONGINT)13); + return; + } else { + n -= 1; + x0 = -x; + } + } else { + x0 = x; + } + do { + a[__X(i, ((LONGINT)(22)))] = (CHAR)(__MOD(x0, 10) + 48); + x0 = __DIV(x0, 10); + i += 1; + } while (!(x0 == 0)); + while (n > (LONGINT)i) { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } + if (x < 0) { + Texts_Write(&*W, W__typ, '-'); + } + do { + i -= 1; + Texts_Write(&*W, W__typ, a[__X(i, ((LONGINT)(22)))]); + } while (!(i == 0)); +} + +void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x) +{ + INTEGER i; + LONGINT y; + CHAR a[20]; + i = 0; + Texts_Write(&*W, W__typ, ' '); + do { + y = __MASK(x, -16); + if (y < 10) { + a[__X(i, ((LONGINT)(20)))] = (CHAR)(y + 48); + } else { + a[__X(i, ((LONGINT)(20)))] = (CHAR)(y + 55); + } + x = __ASHR(x, 4); + i += 1; + } while (!(i == 8)); + do { + i -= 1; + Texts_Write(&*W, W__typ, a[__X(i, ((LONGINT)(20)))]); + } while (!(i == 0)); +} + +void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n) +{ + INTEGER e; + REAL x0; + CHAR d[9]; + e = Reals_Expo(x); + if (e == 0) { + Texts_WriteString(&*W, W__typ, (CHAR*)" 0", (LONGINT)4); + do { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } while (!(n <= 3)); + } else if (e == 255) { + Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5); + while (n > 4) { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } + } else { + if (n <= 9) { + n = 3; + } else { + n -= 6; + } + do { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } while (!(n <= 8)); + if (x < (REAL)0) { + Texts_Write(&*W, W__typ, '-'); + x = -x; + } else { + Texts_Write(&*W, W__typ, ' '); + } + e = __ASHR((e - 127) * 77, 8); + if (e >= 0) { + x = x / (REAL)Reals_Ten(e); + } else { + x = Reals_Ten(-e) * x; + } + if (x >= (REAL)10) { + x = 1.0000000e-001 * x; + e += 1; + } + x0 = Reals_Ten(n - 1); + x = x0 * x + 5.0000000e-001; + if (x >= (REAL)10 * x0) { + x = x * 1.0000000e-001; + e += 1; + } + Reals_Convert(x, n, (void*)d, ((LONGINT)(9))); + n -= 1; + Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(9)))]); + Texts_Write(&*W, W__typ, '.'); + do { + n -= 1; + Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(9)))]); + } while (!(n == 0)); + Texts_Write(&*W, W__typ, 'E'); + if (e < 0) { + Texts_Write(&*W, W__typ, '-'); + e = -e; + } else { + Texts_Write(&*W, W__typ, '+'); + } + Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48)); + Texts_Write(&*W, W__typ, (CHAR)((int)__MOD(e, 10) + 48)); + } +} + +static struct WriteRealFix__53 { + Texts_Writer *W; + LONGINT *W__typ; + INTEGER *i; + CHAR (*d)[9]; + struct WriteRealFix__53 *lnk; +} *WriteRealFix__53_s; + +static void dig__54 (INTEGER n); +static void seq__56 (CHAR ch, INTEGER n); + +static void seq__56 (CHAR ch, INTEGER n) +{ + while (n > 0) { + Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, ch); + n -= 1; + } +} + +static void dig__54 (INTEGER n) +{ + while (n > 0) { + *WriteRealFix__53_s->i -= 1; + Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, (*WriteRealFix__53_s->d)[__X(*WriteRealFix__53_s->i, ((LONGINT)(9)))]); + n -= 1; + } +} + +void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k) +{ + INTEGER e, i; + CHAR sign; + REAL x0; + CHAR d[9]; + struct WriteRealFix__53 _s; + _s.W = W; _s.W__typ = W__typ; + _s.i = &i; + _s.d = (void*)d; + _s.lnk = WriteRealFix__53_s; + WriteRealFix__53_s = &_s; + e = Reals_Expo(x); + if (k < 0) { + k = 0; + } + if (e == 0) { + seq__56(' ', (n - k) - 2); + Texts_Write(&*W, W__typ, '0'); + seq__56(' ', k + 1); + } else if (e == 255) { + Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5); + seq__56(' ', n - 4); + } else { + e = __ASHR((e - 127) * 77, 8); + if (x < (REAL)0) { + sign = '-'; + x = -x; + } else { + sign = ' '; + } + if (e >= 0) { + x = x / (REAL)Reals_Ten(e); + } else { + x = Reals_Ten(-e) * x; + } + if (x >= (REAL)10) { + x = 1.0000000e-001 * x; + e += 1; + } + if (k + e >= 8) { + k = 8 - e; + } else if (k + e < 0) { + k = -e; + x = (REAL)0; + } + x0 = Reals_Ten(k + e); + x = x0 * x + 5.0000000e-001; + if (x >= (REAL)10 * x0) { + e += 1; + } + e += 1; + i = k + e; + Reals_Convert(x, i, (void*)d, ((LONGINT)(9))); + if (e > 0) { + seq__56(' ', ((n - e) - k) - 2); + Texts_Write(&*W, W__typ, sign); + dig__54(e); + Texts_Write(&*W, W__typ, '.'); + dig__54(k); + } else { + seq__56(' ', (n - k) - 3); + Texts_Write(&*W, W__typ, sign); + Texts_Write(&*W, W__typ, '0'); + Texts_Write(&*W, W__typ, '.'); + seq__56('0', -e); + dig__54(k + e); + } + } + WriteRealFix__53_s = _s.lnk; +} + +void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x) +{ + INTEGER i; + CHAR d[8]; + Reals_ConvertH(x, (void*)d, ((LONGINT)(8))); + i = 0; + do { + Texts_Write(&*W, W__typ, d[__X(i, ((LONGINT)(8)))]); + i += 1; + } while (!(i == 8)); +} + +void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n) +{ + INTEGER e; + LONGREAL x0; + CHAR d[16]; + e = Reals_ExpoL(x); + if (e == 0) { + Texts_WriteString(&*W, W__typ, (CHAR*)" 0", (LONGINT)4); + do { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } while (!(n <= 3)); + } else if (e == 2047) { + Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5); + while (n > 4) { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } + } else { + if (n <= 10) { + n = 3; + } else { + n -= 7; + } + do { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } while (!(n <= 16)); + if (x < (LONGREAL)0) { + Texts_Write(&*W, W__typ, '-'); + x = -x; + } else { + Texts_Write(&*W, W__typ, ' '); + } + e = (int)__ASHR((LONGINT)(e - 1023) * 77, 8); + if (e >= 0) { + x = x / (LONGREAL)Reals_TenL(e); + } else { + x = Reals_TenL(-e) * x; + } + if (x >= (LONGREAL)10) { + x = 1.00000000000000e-001 * x; + e += 1; + } + x0 = Reals_TenL(n - 1); + x = x0 * x + 5.00000000000000e-001; + if (x >= (LONGREAL)10 * x0) { + x = 1.00000000000000e-001 * x; + e += 1; + } + Reals_ConvertL(x, n, (void*)d, ((LONGINT)(16))); + n -= 1; + Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(16)))]); + Texts_Write(&*W, W__typ, '.'); + do { + n -= 1; + Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(16)))]); + } while (!(n == 0)); + Texts_Write(&*W, W__typ, 'D'); + if (e < 0) { + Texts_Write(&*W, W__typ, '-'); + e = -e; + } else { + Texts_Write(&*W, W__typ, '+'); + } + Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 100) + 48)); + e = (int)__MOD(e, 100); + Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48)); + Texts_Write(&*W, W__typ, (CHAR)((int)__MOD(e, 10) + 48)); + } +} + +void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x) +{ + INTEGER i; + CHAR d[16]; + Reals_ConvertHL(x, (void*)d, ((LONGINT)(16))); + i = 0; + do { + Texts_Write(&*W, W__typ, d[__X(i, ((LONGINT)(16)))]); + i += 1; + } while (!(i == 16)); +} + +static struct WriteDate__43 { + Texts_Writer *W; + LONGINT *W__typ; + struct WriteDate__43 *lnk; +} *WriteDate__43_s; + +static void WritePair__44 (CHAR ch, LONGINT x); + +static void WritePair__44 (CHAR ch, LONGINT x) +{ + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, ch); + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__DIV(x, 10) + 48)); + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__MOD(x, 10) + 48)); +} + +void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d) +{ + struct WriteDate__43 _s; + _s.W = W; _s.W__typ = W__typ; + _s.lnk = WriteDate__43_s; + WriteDate__43_s = &_s; + WritePair__44(' ', __MASK(d, -32)); + WritePair__44('.', __MASK(__ASHR(d, 5), -16)); + WritePair__44('.', __MASK(__ASHR(d, 9), -128)); + WritePair__44(' ', __MASK(__ASHR(t, 12), -32)); + WritePair__44(':', __MASK(__ASHR(t, 6), -64)); + WritePair__44(':', __MASK(t, -64)); + WriteDate__43_s = _s.lnk; +} + +static struct Load0__16 { + Texts_Text *T; + SHORTINT *ecnt; + Files_File *f; + Texts_FileMsg *msg; + CHAR (*mods)[64][32], (*procs)[64][32]; + struct Load0__16 *lnk; +} *Load0__16_s; + +static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT span, Texts_Elem *e); + +static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT span, Texts_Elem *e) +{ + Modules_Module M = NIL; + Modules_Command Cmd; + Texts_Alien a = NIL; + LONGINT org, ew, eh; + SHORTINT eno; + Texts_new = NIL; + Files_ReadLInt(&*r, r__typ, &ew); + Files_ReadLInt(&*r, r__typ, &eh); + Files_Read(&*r, r__typ, (void*)&eno); + if (eno > *Load0__16_s->ecnt) { + *Load0__16_s->ecnt = eno; + Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32))); + Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32))); + } + org = Files_Pos(&*r, r__typ); + M = Modules_ThisMod((*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32))); + if (M != NIL) { + Cmd = Modules_ThisCommand(M, (*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32))); + if (Cmd != NIL) { + (*Cmd)(); + } + } + *e = Texts_new; + if (*e != NIL) { + (*e)->W = ew; + (*e)->H = eh; + (*e)->base = *Load0__16_s->T; + (*Load0__16_s->msg).pos = pos; + (*(*e)->handle)(*e, (void*)&*Load0__16_s->msg, Texts_FileMsg__typ); + if (Files_Pos(&*r, r__typ) != org + span) { + *e = NIL; + } + } + if (*e == NIL) { + Files_Set(&*r, r__typ, *Load0__16_s->f, org + span); + __NEW(a, Texts__1); + a->W = ew; + a->H = eh; + a->handle = Texts_HandleAlien; + a->base = *Load0__16_s->T; + a->file = *Load0__16_s->f; + a->org = org; + a->span = span; + __COPY((*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], a->mod, ((LONGINT)(32))); + __COPY((*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], a->proc, ((LONGINT)(32))); + *e = (Texts_Elem)a; + } +} + +static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T) +{ + Texts_Run u = NIL, un = NIL; + Texts_Piece p = NIL; + Texts_Elem e = NIL; + LONGINT org, pos, hlen, plen; + SHORTINT ecnt, fno, fcnt, col, voff; + Files_File f = NIL; + Texts_FileMsg msg; + CHAR mods[64][32], procs[64][32]; + CHAR name[32]; + Texts_FontsFont fnts[32]; + struct Load0__16 _s; + _s.T = &T; + _s.ecnt = &ecnt; + _s.f = &f; + _s.msg = &msg; + _s.mods = (void*)mods; + _s.procs = (void*)procs; + _s.lnk = Load0__16_s; + Load0__16_s = &_s; + pos = Files_Pos(&*r, r__typ); + f = Files_Base(&*r, r__typ); + __NEW(u, Texts_RunDesc); + u->len = 2147483647; + u->fnt = NIL; + u->col = 15; + T->head = u; + ecnt = 0; + fcnt = 0; + msg.id = 0; + msg.r = *r; + Files_ReadLInt(&msg.r, Files_Rider__typ, &hlen); + org = (pos - 2) + hlen; + pos = org; + Files_Read(&msg.r, Files_Rider__typ, (void*)&fno); + while (fno != 0) { + if (fno > fcnt) { + fcnt = fno; + Files_ReadString(&msg.r, Files_Rider__typ, (void*)name, ((LONGINT)(32))); + fnts[__X(fno, ((LONGINT)(32)))] = Texts_FontsThis((void*)name, ((LONGINT)(32))); + } + Files_Read(&msg.r, Files_Rider__typ, (void*)&col); + Files_Read(&msg.r, Files_Rider__typ, (void*)&voff); + Files_ReadLInt(&msg.r, Files_Rider__typ, &plen); + if (plen > 0) { + __NEW(p, Texts_PieceDesc); + p->file = f; + p->org = pos; + p->ascii = 0; + un = (Texts_Run)p; + un->len = plen; + } else { + LoadElem__17(&msg.r, Files_Rider__typ, pos - org, -plen, &e); + un = (Texts_Run)e; + un->len = 1; + } + un->col = col; + un->voff = voff; + pos += un->len; + u->next = un; + un->prev = u; + u = un; + Files_Read(&msg.r, Files_Rider__typ, (void*)&fno); + } + u->next = T->head; + T->head->prev = u; + T->cache = T->head; + T->corg = 0; + Files_ReadLInt(&msg.r, Files_Rider__typ, &T->len); + Files_Set(&*r, r__typ, f, Files_Pos(&msg.r, Files_Rider__typ) + T->len); + Load0__16_s = _s.lnk; +} + +void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T) +{ + INTEGER tag; + Files_ReadInt(&*r, r__typ, &tag); + if (tag != -4095) { + Files_Set(&*r, r__typ, Files_Base(&*r, r__typ), Files_Pos(&*r, r__typ) - 2); + } + Texts_Load0(&*r, r__typ, T); +} + +void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len) +{ + Files_File f = NIL; + Files_Rider r; + Texts_Run u = NIL; + Texts_Piece p = NIL; + CHAR tag, version; + LONGINT hlen; + __DUP(name, name__len, CHAR); + f = Files_Old(name, name__len); + if (f == NIL) { + f = Files_New((CHAR*)"", (LONGINT)1); + } + Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(0))); + Files_Read(&r, Files_Rider__typ, (void*)&tag); + Files_Read(&r, Files_Rider__typ, (void*)&version); + if (tag == 0xf0 || (tag == 0x01 && version == 0xf0)) { + Texts_Load0(&r, Files_Rider__typ, T); + } else { + __NEW(u, Texts_RunDesc); + u->len = 2147483647; + u->fnt = NIL; + u->col = 15; + __NEW(p, Texts_PieceDesc); + if ((tag == 0xf7 && version == 0x07)) { + Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(28))); + Files_ReadLInt(&r, Files_Rider__typ, &hlen); + Files_Set(&r, Files_Rider__typ, f, 22 + hlen); + Files_ReadLInt(&r, Files_Rider__typ, &T->len); + p->org = 26 + hlen; + } else { + T->len = Files_Length(f); + p->org = 0; + } + if (T->len > 0) { + p->len = T->len; + p->fnt = Texts_FontsDefault; + p->col = 15; + p->voff = 0; + p->file = f; + p->ascii = 1; + u->next = (Texts_Run)p; + u->prev = (Texts_Run)p; + p->next = u; + p->prev = u; + } else { + u->next = u; + u->prev = u; + } + T->head = u; + T->cache = T->head; + T->corg = 0; + } + __DEL(name); +} + +static struct Store__39 { + SHORTINT *ecnt; + Texts_FileMsg *msg; + Texts_IdentifyMsg *iden; + CHAR (*mods)[64][32], (*procs)[64][32]; + struct Store__39 *lnk; +} *Store__39_s; + +static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_Elem e); + +static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_Elem e) +{ + Files_Rider r1; + LONGINT org, span; + SHORTINT eno; + __COPY((*Store__39_s->iden).mod, (*Store__39_s->mods)[__X(*Store__39_s->ecnt, ((LONGINT)(64)))], ((LONGINT)(32))); + __COPY((*Store__39_s->iden).proc, (*Store__39_s->procs)[__X(*Store__39_s->ecnt, ((LONGINT)(64)))], ((LONGINT)(32))); + eno = 1; + while (__STRCMP((*Store__39_s->mods)[__X(eno, ((LONGINT)(64)))], (*Store__39_s->iden).mod) != 0 || __STRCMP((*Store__39_s->procs)[__X(eno, ((LONGINT)(64)))], (*Store__39_s->iden).proc) != 0) { + eno += 1; + } + Files_Set(&r1, Files_Rider__typ, Files_Base(&*r, r__typ), Files_Pos(&*r, r__typ)); + Files_WriteLInt(&*r, r__typ, ((LONGINT)(0))); + Files_WriteLInt(&*r, r__typ, ((LONGINT)(0))); + Files_WriteLInt(&*r, r__typ, ((LONGINT)(0))); + Files_Write(&*r, r__typ, eno); + if (eno == *Store__39_s->ecnt) { + *Store__39_s->ecnt += 1; + Files_WriteString(&*r, r__typ, (*Store__39_s->iden).mod, ((LONGINT)(32))); + Files_WriteString(&*r, r__typ, (*Store__39_s->iden).proc, ((LONGINT)(32))); + } + (*Store__39_s->msg).pos = pos; + org = Files_Pos(&*r, r__typ); + (*e->handle)(e, (void*)&*Store__39_s->msg, Texts_FileMsg__typ); + span = Files_Pos(&*r, r__typ) - org; + Files_WriteLInt(&r1, Files_Rider__typ, -span); + Files_WriteLInt(&r1, Files_Rider__typ, e->W); + Files_WriteLInt(&r1, Files_Rider__typ, e->H); +} + +void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T) +{ + Files_Rider r1; + Texts_Run u = NIL, un = NIL; + Texts_Elem e = NIL; + LONGINT org, pos, delta, hlen, rlen; + SHORTINT ecnt, fno, fcnt; + CHAR ch; + Texts_FileMsg msg; + Texts_IdentifyMsg iden; + CHAR mods[64][32], procs[64][32]; + Texts_FontsFont fnts[32]; + CHAR block[1024]; + struct Store__39 _s; + _s.ecnt = &ecnt; + _s.msg = &msg; + _s.iden = &iden; + _s.mods = (void*)mods; + _s.procs = (void*)procs; + _s.lnk = Store__39_s; + Store__39_s = &_s; + org = Files_Pos(&*r, r__typ); + msg.id = 1; + msg.r = *r; + Files_WriteLInt(&msg.r, Files_Rider__typ, ((LONGINT)(0))); + u = T->head->next; + pos = 0; + delta = 0; + fcnt = 1; + ecnt = 1; + while (u != T->head) { + if (__ISP(u, Texts_ElemDesc, 1)) { + iden.mod[0] = 0x00; + (*__GUARDP(u, Texts_ElemDesc, 1)->handle)(__GUARDP(u, Texts_ElemDesc, 1), (void*)&iden, Texts_IdentifyMsg__typ); + } else { + iden.mod[0] = 0x01; + } + if (iden.mod[0] != 0x00) { + fnts[__X(fcnt, ((LONGINT)(32)))] = u->fnt; + fno = 1; + while (__STRCMP(fnts[__X(fno, ((LONGINT)(32)))]->name, u->fnt->name) != 0) { + fno += 1; + } + Files_Write(&msg.r, Files_Rider__typ, fno); + if (fno == fcnt) { + fcnt += 1; + Files_WriteString(&msg.r, Files_Rider__typ, u->fnt->name, ((LONGINT)(32))); + } + Files_Write(&msg.r, Files_Rider__typ, u->col); + Files_Write(&msg.r, Files_Rider__typ, u->voff); + } + if (__ISP(u, Texts_PieceDesc, 1)) { + rlen = u->len; + un = u->next; + while ((((((__ISP(un, Texts_PieceDesc, 1) && un->fnt == u->fnt)) && un->col == u->col)) && un->voff == u->voff)) { + rlen += un->len; + un = un->next; + } + Files_WriteLInt(&msg.r, Files_Rider__typ, rlen); + pos += rlen; + u = un; + } else if (iden.mod[0] != 0x00) { + StoreElem__40(&msg.r, Files_Rider__typ, pos, __GUARDP(u, Texts_ElemDesc, 1)); + pos += 1; + u = u->next; + } else { + delta += 1; + u = u->next; + } + } + Files_Write(&msg.r, Files_Rider__typ, 0); + Files_WriteLInt(&msg.r, Files_Rider__typ, T->len - delta); + hlen = (Files_Pos(&msg.r, Files_Rider__typ) - org) + 2; + Files_Set(&r1, Files_Rider__typ, Files_Base(&msg.r, Files_Rider__typ), org); + Files_WriteLInt(&r1, Files_Rider__typ, hlen); + u = T->head->next; + while (u != T->head) { + if (__ISP(u, Texts_PieceDesc, 1)) { + if (__ISP(u, Texts_PieceDesc, 1)) { + if (((Texts_Piece)u)->ascii) { + Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org); + delta = ((Texts_Piece)u)->len; + while (delta > 0) { + Files_Read(&r1, Files_Rider__typ, (void*)&ch); + delta -= 1; + if (ch == 0x0a) { + Files_Write(&msg.r, Files_Rider__typ, 0x0d); + } else { + Files_Write(&msg.r, Files_Rider__typ, ch); + } + } + } else { + Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org); + delta = ((Texts_Piece)u)->len; + while (delta > 1024) { + Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), ((LONGINT)(1024))); + Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), ((LONGINT)(1024))); + delta -= 1024; + } + Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), delta); + Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), delta); + } + } else __WITHCHK; + } else { + iden.mod[0] = 0x00; + (*__GUARDP(u, Texts_ElemDesc, 1)->handle)(__GUARDP(u, Texts_ElemDesc, 1), (void*)&iden, Texts_IdentifyMsg__typ); + if (iden.mod[0] != 0x00) { + Files_Write(&msg.r, Files_Rider__typ, 0x1c); + } + } + u = u->next; + } + __GUARDEQR(r, r__typ, Files_Rider) = msg.r; + if (T->notify != NIL) { + (*T->notify)(T, 3, ((LONGINT)(0)), ((LONGINT)(0))); + } + Store__39_s = _s.lnk; +} + +void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len) +{ + Files_File f = NIL; + Files_Rider r; + INTEGER i, res; + CHAR bak[64]; + __DUP(name, name__len, CHAR); + f = Files_New(name, name__len); + Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(0))); + Files_Write(&r, Files_Rider__typ, 0xf0); + Files_Write(&r, Files_Rider__typ, 0x01); + Texts_Store(&r, Files_Rider__typ, T); + i = 0; + while (name[__X(i, name__len)] != 0x00) { + i += 1; + } + __COPY(name, bak, ((LONGINT)(64))); + bak[__X(i, ((LONGINT)(64)))] = '.'; + bak[__X(i + 1, ((LONGINT)(64)))] = 'B'; + bak[__X(i + 2, ((LONGINT)(64)))] = 'a'; + bak[__X(i + 3, ((LONGINT)(64)))] = 'k'; + bak[__X(i + 4, ((LONGINT)(64)))] = 0x00; + Files_Rename(name, name__len, bak, ((LONGINT)(64)), &res); + Files_Register(f); + __DEL(name); +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(Texts_new); + P(Texts_del); + P(Texts_FontsDefault); +} + +__TDESC(Texts_FontDesc, 1, 0) = {__TDFLDS("FontDesc", 32), {-4}}; +__TDESC(Texts_RunDesc, 1, 3) = {__TDFLDS("RunDesc", 20), {0, 4, 12, -16}}; +__TDESC(Texts_PieceDesc, 1, 4) = {__TDFLDS("PieceDesc", 28), {0, 4, 12, 20, -20}}; +__TDESC(Texts_ElemMsg, 1, 0) = {__TDFLDS("ElemMsg", 1), {-4}}; +__TDESC(Texts_ElemDesc, 1, 4) = {__TDFLDS("ElemDesc", 36), {0, 4, 12, 32, -20}}; +__TDESC(Texts_FileMsg, 1, 1) = {__TDFLDS("FileMsg", 28), {16, -8}}; +__TDESC(Texts_CopyMsg, 1, 1) = {__TDFLDS("CopyMsg", 4), {0, -8}}; +__TDESC(Texts_IdentifyMsg, 1, 0) = {__TDFLDS("IdentifyMsg", 64), {-4}}; +__TDESC(Texts_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 8), {4, -8}}; +__TDESC(Texts_TextDesc, 1, 2) = {__TDFLDS("TextDesc", 20), {8, 12, -12}}; +__TDESC(Texts_Reader, 1, 4) = {__TDFLDS("Reader", 48), {4, 12, 24, 36, -20}}; +__TDESC(Texts_Scanner, 1, 4) = {__TDFLDS("Scanner", 144), {4, 12, 24, 36, -20}}; +__TDESC(Texts_Writer, 1, 4) = {__TDFLDS("Writer", 36), {0, 4, 20, 32, -20}}; +__TDESC(Texts__1, 1, 5) = {__TDFLDS("", 112), {0, 4, 12, 32, 36, -24}}; + +export void *Texts__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Files); + __MODULE_IMPORT(Modules); + __MODULE_IMPORT(Reals); + __REGMOD("Texts", EnumPtrs); + __INITYP(Texts_FontDesc, Texts_FontDesc, 0); + __INITYP(Texts_RunDesc, Texts_RunDesc, 0); + __INITYP(Texts_PieceDesc, Texts_RunDesc, 1); + __INITYP(Texts_ElemMsg, Texts_ElemMsg, 0); + __INITYP(Texts_ElemDesc, Texts_RunDesc, 1); + __INITYP(Texts_FileMsg, Texts_ElemMsg, 1); + __INITYP(Texts_CopyMsg, Texts_ElemMsg, 1); + __INITYP(Texts_IdentifyMsg, Texts_ElemMsg, 1); + __INITYP(Texts_BufDesc, Texts_BufDesc, 0); + __INITYP(Texts_TextDesc, Texts_TextDesc, 0); + __INITYP(Texts_Reader, Texts_Reader, 0); + __INITYP(Texts_Scanner, Texts_Reader, 1); + __INITYP(Texts_Writer, Texts_Writer, 0); + __INITYP(Texts__1, Texts_ElemDesc, 2); +/* BEGIN */ + Texts_del = NIL; + __NEW(Texts_FontsDefault, Texts_FontDesc); + __MOVE("Syntax10.Scn.Fnt", Texts_FontsDefault->name, 17); + __ENDMOD; +} diff --git a/bootstrap/unix-48/Texts.h b/bootstrap/unix-48/Texts.h new file mode 100644 index 00000000..7b66d3ce --- /dev/null +++ b/bootstrap/unix-48/Texts.h @@ -0,0 +1,173 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Texts__h +#define Texts__h + +#include "SYSTEM.h" +#include "Files.h" + +typedef + struct Texts_BufDesc { + LONGINT len; + char _prvt0[4]; + } Texts_BufDesc; + +typedef + Texts_BufDesc *Texts_Buffer; + +typedef + struct Texts_ElemMsg { + char _prvt0[1]; + } Texts_ElemMsg; + +typedef + struct Texts_ElemDesc *Texts_Elem; + +typedef + struct Texts_CopyMsg { /* Texts_ElemMsg */ + Texts_Elem e; + } Texts_CopyMsg; + +typedef + struct Texts_RunDesc { + LONGINT _prvt0; + char _prvt1[15]; + } Texts_RunDesc; + +typedef + void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, LONGINT *); + +typedef + struct Texts_ElemDesc { + char _prvt0[20]; + LONGINT W, H; + Texts_Handler handle; + char _prvt1[4]; + } Texts_ElemDesc; + +typedef + struct Texts_FileMsg { /* Texts_ElemMsg */ + INTEGER id; + LONGINT pos; + Files_Rider r; + } Texts_FileMsg; + +typedef + struct Texts_FontDesc { + char _prvt0[32]; + } Texts_FontDesc; + +typedef + Texts_FontDesc *Texts_FontsFont; + +typedef + struct Texts_IdentifyMsg { /* Texts_ElemMsg */ + CHAR mod[32], proc[32]; + } Texts_IdentifyMsg; + +typedef + struct Texts_TextDesc *Texts_Text; + +typedef + void (*Texts_Notifier)(Texts_Text, INTEGER, LONGINT, LONGINT); + +typedef + struct Texts_Reader { + BOOLEAN eot; + Texts_FontsFont fnt; + SHORTINT col, voff; + Texts_Elem elem; + char _prvt0[32]; + } Texts_Reader; + +typedef + struct Texts_Scanner { /* Texts_Reader */ + BOOLEAN eot; + Texts_FontsFont fnt; + SHORTINT col, voff; + Texts_Elem elem; + LONGREAL _prvt0; + char _prvt1[24]; + CHAR nextCh; + INTEGER line, class; + LONGINT i; + REAL x; + LONGREAL y; + CHAR c; + SHORTINT len; + CHAR s[64]; + } Texts_Scanner; + +typedef + struct Texts_TextDesc { + LONGINT len; + Texts_Notifier notify; + char _prvt0[12]; + } Texts_TextDesc; + +typedef + struct Texts_Writer { + Texts_Buffer buf; + Texts_FontsFont fnt; + SHORTINT col, voff; + char _prvt0[26]; + } Texts_Writer; + + +import Texts_Elem Texts_new; + +import LONGINT *Texts_FontDesc__typ; +import LONGINT *Texts_RunDesc__typ; +import LONGINT *Texts_ElemMsg__typ; +import LONGINT *Texts_ElemDesc__typ; +import LONGINT *Texts_FileMsg__typ; +import LONGINT *Texts_CopyMsg__typ; +import LONGINT *Texts_IdentifyMsg__typ; +import LONGINT *Texts_BufDesc__typ; +import LONGINT *Texts_TextDesc__typ; +import LONGINT *Texts_Reader__typ; +import LONGINT *Texts_Scanner__typ; +import LONGINT *Texts_Writer__typ; + +import void Texts_Append (Texts_Text T, Texts_Buffer B); +import void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff); +import void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len); +import void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB); +import void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE); +import void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end); +import Texts_Text Texts_ElemBase (Texts_Elem E); +import LONGINT Texts_ElemPos (Texts_Elem E); +import void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B); +import void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +import void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len); +import void Texts_OpenBuf (Texts_Buffer B); +import void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos); +import void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos); +import void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ); +import LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ); +import void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch); +import void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ); +import void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ); +import void Texts_Recall (Texts_Buffer *B); +import void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B); +import void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ); +import void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col); +import void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt); +import void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff); +import void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +import void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch); +import void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d); +import void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e); +import void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x); +import void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n); +import void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ); +import void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n); +import void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x); +import void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n); +import void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k); +import void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x); +import void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len); +import void *Texts__init(void); + + +#endif diff --git a/bootstrap/unix-48/Vishap.c b/bootstrap/unix-48/Vishap.c new file mode 100644 index 00000000..2b9c3901 --- /dev/null +++ b/bootstrap/unix-48/Vishap.c @@ -0,0 +1,168 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkamSf */ +#include "SYSTEM.h" +#include "Configuration.h" +#include "Heap.h" +#include "OPB.h" +#include "OPC.h" +#include "OPM.h" +#include "OPP.h" +#include "OPT.h" +#include "OPV.h" +#include "Platform.h" +#include "Strings.h" +#include "extTools.h" +#include "vt100.h" + + +static CHAR Vishap_mname[256]; + + +export void Vishap_Module (BOOLEAN *done); +static void Vishap_PropagateElementaryTypeSizes (void); +export void Vishap_Translate (void); +static void Vishap_Trap (INTEGER sig); + + +void Vishap_Module (BOOLEAN *done) +{ + BOOLEAN ext, new; + OPT_Node p = NIL; + OPP_Module(&p, OPM_opt); + if (OPM_noerr) { + OPV_Init(); + OPV_AdrAndSize(OPT_topScope); + OPT_Export(&ext, &new); + if (OPM_noerr) { + OPM_OpenFiles((void*)OPT_SelfName, ((LONGINT)(256))); + OPC_Init(); + OPV_Module(p); + if (OPM_noerr) { + if (((OPM_mainProg || OPM_mainLinkStat) && __STRCMP(OPM_modName, "SYSTEM") != 0)) { + OPM_DeleteNewSym(); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"32m", (LONGINT)4); + } + OPM_LogWStr((CHAR*)" Main program.", (LONGINT)16); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + } else { + if (new) { + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"32m", (LONGINT)4); + } + OPM_LogWStr((CHAR*)" New symbol file.", (LONGINT)19); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + OPM_RegisterNewSym(); + } else if (ext) { + OPM_LogWStr((CHAR*)" Extended symbol file.", (LONGINT)24); + OPM_RegisterNewSym(); + } + } + } else { + OPM_DeleteNewSym(); + } + } + } + OPM_CloseFiles(); + OPT_Close(); + OPM_LogWLn(); + *done = OPM_noerr; +} + +static void Vishap_PropagateElementaryTypeSizes (void) +{ + OPT_bytetyp->size = OPM_ByteSize; + OPT_sysptrtyp->size = OPM_PointerSize; + OPT_chartyp->size = OPM_CharSize; + OPT_settyp->size = OPM_SetSize; + OPT_realtyp->size = OPM_RealSize; + OPT_inttyp->size = OPM_IntSize; + OPT_linttyp->size = OPM_LIntSize; + OPT_lrltyp->size = OPM_LRealSize; + OPT_sinttyp->size = OPM_SIntSize; + OPT_booltyp->size = OPM_BoolSize; +} + +void Vishap_Translate (void) +{ + BOOLEAN done; + CHAR modulesobj[2048]; + modulesobj[0] = 0x00; + if (OPM_OpenPar()) { + for (;;) { + OPM_Init(&done, (void*)Vishap_mname, ((LONGINT)(256))); + if (!done) { + return; + } + OPM_InitOptions(); + Vishap_PropagateElementaryTypeSizes(); + Heap_GC(0); + Vishap_Module(&done); + if (!done) { + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Module compilation failed.", (LONGINT)27); + OPM_LogWLn(); + Platform_Exit(1); + } + if (!OPM_dontAsm) { + if (OPM_dontLink) { + extTools_Assemble(OPM_modName, ((LONGINT)(32))); + } else { + if (!(OPM_mainProg || OPM_mainLinkStat)) { + extTools_Assemble(OPM_modName, ((LONGINT)(32))); + Strings_Append((CHAR*)" ", (LONGINT)2, (void*)modulesobj, ((LONGINT)(2048))); + Strings_Append(OPM_modName, ((LONGINT)(32)), (void*)modulesobj, ((LONGINT)(2048))); + Strings_Append((CHAR*)".o", (LONGINT)3, (void*)modulesobj, ((LONGINT)(2048))); + } else { + extTools_LinkMain((void*)OPM_modName, ((LONGINT)(32)), OPM_mainLinkStat, modulesobj, ((LONGINT)(2048))); + } + } + } + } + } +} + +static void Vishap_Trap (INTEGER sig) +{ + Heap_FINALL(); + if (sig == 3) { + Platform_Exit(0); + } else { + if ((sig == 4 && Platform_HaltCode == -15)) { + OPM_LogWStr((CHAR*)" --- Vishap Oberon: internal error", (LONGINT)35); + OPM_LogWLn(); + } + Platform_Exit(2); + } +} + + +export int main(int argc, char **argv) +{ + __INIT(argc, argv); + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Heap); + __MODULE_IMPORT(OPB); + __MODULE_IMPORT(OPC); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPP); + __MODULE_IMPORT(OPT); + __MODULE_IMPORT(OPV); + __MODULE_IMPORT(Platform); + __MODULE_IMPORT(Strings); + __MODULE_IMPORT(extTools); + __MODULE_IMPORT(vt100); + __REGMAIN("Vishap", 0); + __REGCMD("Translate", Vishap_Translate); +/* BEGIN */ + Platform_SetInterruptHandler(Vishap_Trap); + Platform_SetQuitHandler(Vishap_Trap); + Platform_SetBadInstructionHandler(Vishap_Trap); + OPB_typSize = OPV_TypSize; + OPT_typSize = OPV_TypSize; + Vishap_Translate(); + __FINI; +} diff --git a/bootstrap/unix-48/WindowsWrapper.h b/bootstrap/unix-48/WindowsWrapper.h new file mode 100644 index 00000000..cdb8714c --- /dev/null +++ b/bootstrap/unix-48/WindowsWrapper.h @@ -0,0 +1,9 @@ +// WindowsWrapper.h +// +// Includes Windows.h while avoiding conflicts with Oberon types. + +#undef BOOLEAN +#undef CHAR +#include +#define BOOLEAN char +#define CHAR unsigned char diff --git a/bootstrap/unix-48/errors.c b/bootstrap/unix-48/errors.c new file mode 100644 index 00000000..25a074a9 --- /dev/null +++ b/bootstrap/unix-48/errors.c @@ -0,0 +1,198 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" + +typedef + CHAR errors_string[128]; + + +export errors_string errors_errors[350]; + + + + + +export void *errors__init(void) +{ + __DEFMOD; + __REGMOD("errors", 0); +/* BEGIN */ + __MOVE("undeclared identifier", errors_errors[0], 22); + __MOVE("multiply defined identifier", errors_errors[1], 28); + __MOVE("illegal character in number", errors_errors[2], 28); + __MOVE("illegal character in string", errors_errors[3], 28); + __MOVE("identifier does not match procedure name", errors_errors[4], 41); + __MOVE("comment not closed", errors_errors[5], 19); + errors_errors[6][0] = 0x00; + errors_errors[7][0] = 0x00; + errors_errors[8][0] = 0x00; + __MOVE("\'=\' expected", errors_errors[9], 13); + errors_errors[10][0] = 0x00; + errors_errors[11][0] = 0x00; + __MOVE("type definition starts with incorrect symbol", errors_errors[12], 45); + __MOVE("factor starts with incorrect symbol", errors_errors[13], 36); + __MOVE("statement starts with incorrect symbol", errors_errors[14], 39); + __MOVE("declaration followed by incorrect symbol", errors_errors[15], 41); + __MOVE("MODULE expected", errors_errors[16], 16); + errors_errors[17][0] = 0x00; + __MOVE("\'.\' missing", errors_errors[18], 12); + __MOVE("\',\' missing", errors_errors[19], 12); + __MOVE("\':\' missing", errors_errors[20], 12); + errors_errors[21][0] = 0x00; + __MOVE("\')\' missing", errors_errors[22], 12); + __MOVE("\']\' missing", errors_errors[23], 12); + __MOVE("\'}\' missing", errors_errors[24], 12); + __MOVE("OF missing", errors_errors[25], 11); + __MOVE("THEN missing", errors_errors[26], 13); + __MOVE("DO missing", errors_errors[27], 11); + __MOVE("TO missing", errors_errors[28], 11); + errors_errors[29][0] = 0x00; + __MOVE("\'(\' missing", errors_errors[30], 12); + errors_errors[31][0] = 0x00; + errors_errors[32][0] = 0x00; + errors_errors[33][0] = 0x00; + __MOVE("\':=\' missing", errors_errors[34], 13); + __MOVE("\',\' or OF expected", errors_errors[35], 19); + errors_errors[36][0] = 0x00; + errors_errors[37][0] = 0x00; + __MOVE("identifier expected", errors_errors[38], 20); + __MOVE("\';\' missing", errors_errors[39], 12); + errors_errors[40][0] = 0x00; + __MOVE("END missing", errors_errors[41], 12); + errors_errors[42][0] = 0x00; + errors_errors[43][0] = 0x00; + __MOVE("UNTIL missing", errors_errors[44], 14); + errors_errors[45][0] = 0x00; + __MOVE("EXIT not within loop statement", errors_errors[46], 31); + __MOVE("illegally marked identifier", errors_errors[47], 28); + errors_errors[48][0] = 0x00; + errors_errors[49][0] = 0x00; + __MOVE("expression should be constant", errors_errors[50], 30); + __MOVE("constant not an integer", errors_errors[51], 24); + __MOVE("identifier does not denote a type", errors_errors[52], 34); + __MOVE("identifier does not denote a record type", errors_errors[53], 41); + __MOVE("result type of procedure is not a basic type", errors_errors[54], 45); + __MOVE("procedure call of a function", errors_errors[55], 29); + __MOVE("assignment to non-variable", errors_errors[56], 27); + __MOVE("pointer not bound to record or array type", errors_errors[57], 42); + __MOVE("recursive type definition", errors_errors[58], 26); + __MOVE("illegal open array parameter", errors_errors[59], 29); + __MOVE("wrong type of case label", errors_errors[60], 25); + __MOVE("inadmissible type of case label", errors_errors[61], 32); + __MOVE("case label defined more than once", errors_errors[62], 34); + __MOVE("illegal value of constant", errors_errors[63], 26); + __MOVE("more actual than formal parameters", errors_errors[64], 35); + __MOVE("fewer actual than formal parameters", errors_errors[65], 36); + __MOVE("element types of actual array and formal open array differ", errors_errors[66], 59); + __MOVE("actual parameter corresponding to open array is not an array", errors_errors[67], 61); + __MOVE("control variable must be integer", errors_errors[68], 33); + __MOVE("parameter must be an integer constant", errors_errors[69], 38); + __MOVE("pointer or VAR record required as formal receiver", errors_errors[70], 50); + __MOVE("pointer expected as actual receiver", errors_errors[71], 36); + __MOVE("procedure must be bound to a record of the same scope", errors_errors[72], 54); + __MOVE("procedure must have level 0", errors_errors[73], 28); + __MOVE("procedure unknown in base type", errors_errors[74], 31); + __MOVE("invalid call of base procedure", errors_errors[75], 31); + __MOVE("this variable (field) is read only", errors_errors[76], 35); + __MOVE("object is not a record", errors_errors[77], 23); + __MOVE("dereferenced object is not a variable", errors_errors[78], 38); + __MOVE("indexed object is not a variable", errors_errors[79], 33); + __MOVE("index expression is not an integer", errors_errors[80], 35); + __MOVE("index out of specified bounds", errors_errors[81], 30); + __MOVE("indexed variable is not an array", errors_errors[82], 33); + __MOVE("undefined record field", errors_errors[83], 23); + __MOVE("dereferenced variable is not a pointer", errors_errors[84], 39); + __MOVE("guard or test type is not an extension of variable type", errors_errors[85], 56); + __MOVE("guard or testtype is not a pointer", errors_errors[86], 35); + __MOVE("guarded or tested variable is neither a pointer nor a VAR-parameter record", errors_errors[87], 75); + __MOVE("open array not allowed as variable, record field or array element", errors_errors[88], 66); + errors_errors[89][0] = 0x00; + errors_errors[90][0] = 0x00; + errors_errors[91][0] = 0x00; + __MOVE("operand of IN not an integer, or not a set", errors_errors[92], 43); + __MOVE("set element type is not an integer", errors_errors[93], 35); + __MOVE("operand of & is not of type BOOLEAN", errors_errors[94], 36); + __MOVE("operand of OR is not of type BOOLEAN", errors_errors[95], 37); + __MOVE("operand not applicable to (unary) +", errors_errors[96], 36); + __MOVE("operand not applicable to (unary) -", errors_errors[97], 36); + __MOVE("operand of ~ is not of type BOOLEAN", errors_errors[98], 36); + __MOVE("ASSERT fault", errors_errors[99], 13); + __MOVE("incompatible operands of dyadic operator", errors_errors[100], 41); + __MOVE("operand type inapplicable to *", errors_errors[101], 31); + __MOVE("operand type inapplicable to /", errors_errors[102], 31); + __MOVE("operand type inapplicable to DIV", errors_errors[103], 33); + __MOVE("operand type inapplicable to MOD", errors_errors[104], 33); + __MOVE("operand type inapplicable to +", errors_errors[105], 31); + __MOVE("operand type inapplicable to -", errors_errors[106], 31); + __MOVE("operand type inapplicable to = or #", errors_errors[107], 36); + __MOVE("operand type inapplicable to relation", errors_errors[108], 38); + __MOVE("overriding method must be exported", errors_errors[109], 35); + __MOVE("operand is not a type", errors_errors[110], 22); + __MOVE("operand inapplicable to (this) function", errors_errors[111], 40); + __MOVE("operand is not a variable", errors_errors[112], 26); + __MOVE("incompatible assignment", errors_errors[113], 24); + __MOVE("string too long to be assigned", errors_errors[114], 31); + __MOVE("parameter doesn\'t match", errors_errors[115], 24); + __MOVE("number of parameters doesn\'t match", errors_errors[116], 35); + __MOVE("result type doesn\'t match", errors_errors[117], 26); + __MOVE("export mark doesn\'t match with forward declaration", errors_errors[118], 51); + __MOVE("redefinition textually precedes procedure bound to base type", errors_errors[119], 61); + __MOVE("type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN", errors_errors[120], 71); + __MOVE("called object is not a procedure (or is an interrupt procedure)", errors_errors[121], 64); + __MOVE("actual VAR-parameter is not a variable", errors_errors[122], 39); + __MOVE("type of actual parameter is not identical with that of formal VAR-parameter", errors_errors[123], 76); + __MOVE("type of result expression differs from that of procedure", errors_errors[124], 57); + __MOVE("type of case expression is neither INTEGER nor CHAR", errors_errors[125], 52); + __MOVE("this expression cannot be a type or a procedure", errors_errors[126], 48); + __MOVE("illegal use of object", errors_errors[127], 22); + __MOVE("unsatisfied forward reference", errors_errors[128], 30); + __MOVE("unsatisfied forward procedure", errors_errors[129], 30); + __MOVE("WITH clause does not specify a variable", errors_errors[130], 40); + __MOVE("LEN not applied to array", errors_errors[131], 25); + __MOVE("dimension in LEN too large or negative", errors_errors[132], 39); + __MOVE("SYSTEM not imported", errors_errors[135], 20); + __MOVE("key inconsistency of imported module", errors_errors[150], 37); + __MOVE("incorrect symbol file", errors_errors[151], 22); + __MOVE("symbol file of imported module not found", errors_errors[152], 41); + __MOVE("object or symbol file not opened (disk full\?)", errors_errors[153], 46); + __MOVE("recursive import not allowed", errors_errors[154], 29); + __MOVE("generation of new symbol file not allowed", errors_errors[155], 42); + __MOVE("parameter file not found", errors_errors[156], 25); + __MOVE("syntax error in parameter file", errors_errors[157], 31); + __MOVE("not yet implemented", errors_errors[200], 20); + __MOVE("lower bound of set range greater than higher bound", errors_errors[201], 51); + __MOVE("set element greater than MAX(SET) or less than 0", errors_errors[202], 49); + __MOVE("number too large", errors_errors[203], 17); + __MOVE("product too large", errors_errors[204], 18); + __MOVE("division by zero", errors_errors[205], 17); + __MOVE("sum too large", errors_errors[206], 14); + __MOVE("difference too large", errors_errors[207], 21); + __MOVE("overflow in arithmetic shift", errors_errors[208], 29); + __MOVE("case range too large", errors_errors[209], 21); + __MOVE("too many cases in case statement", errors_errors[213], 33); + __MOVE("illegal value of parameter (0 <= p < 256)", errors_errors[218], 42); + __MOVE("machine registers cannot be accessed", errors_errors[219], 37); + __MOVE("illegal value of parameter", errors_errors[220], 27); + __MOVE("too many pointers in a record", errors_errors[221], 30); + __MOVE("too many global pointers", errors_errors[222], 25); + __MOVE("too many record types", errors_errors[223], 22); + __MOVE("too many pointer types", errors_errors[224], 23); + __MOVE("address of pointer variable too large (move forward in text)", errors_errors[225], 61); + __MOVE("too many exported procedures", errors_errors[226], 29); + __MOVE("too many imported modules", errors_errors[227], 26); + __MOVE("too many exported structures", errors_errors[228], 29); + __MOVE("too many nested records for import", errors_errors[229], 35); + __MOVE("too many constants (strings) in module", errors_errors[230], 39); + __MOVE("too many link table entries (external procedures)", errors_errors[231], 50); + __MOVE("too many commands in module", errors_errors[232], 28); + __MOVE("record extension hierarchy too high", errors_errors[233], 36); + __MOVE("export of recursive type not allowed", errors_errors[234], 37); + __MOVE("identifier too long", errors_errors[240], 20); + __MOVE("string too long", errors_errors[241], 16); + __MOVE("address overflow", errors_errors[242], 17); + __MOVE("cyclic type definition not allowed", errors_errors[244], 35); + __MOVE("guarded pointer variable may be manipulated by non-local operations; use auxiliary pointer variable", errors_errors[245], 100); + __MOVE("implicit type cast", errors_errors[301], 19); + __MOVE("inappropriate symbol file ignored", errors_errors[306], 34); + __MOVE("no ELSE symbol after CASE statement sequence may lead to trap", errors_errors[307], 62); + __ENDMOD; +} diff --git a/bootstrap/unix-48/errors.h b/bootstrap/unix-48/errors.h new file mode 100644 index 00000000..c4fe8850 --- /dev/null +++ b/bootstrap/unix-48/errors.h @@ -0,0 +1,18 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef errors__h +#define errors__h + +#include "SYSTEM.h" + +typedef + CHAR errors_string[128]; + + +import errors_string errors_errors[350]; + + +import void *errors__init(void); + + +#endif diff --git a/bootstrap/unix-48/extTools.c b/bootstrap/unix-48/extTools.c new file mode 100644 index 00000000..6f1a6654 --- /dev/null +++ b/bootstrap/unix-48/extTools.c @@ -0,0 +1,112 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "Configuration.h" +#include "Console.h" +#include "OPM.h" +#include "Platform.h" +#include "Strings.h" + + +static CHAR extTools_compilationOptions[1023], extTools_CFLAGS[1023]; + + +export void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len); +export void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len); +static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len); + + +static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len) +{ + INTEGER r, status, exitcode; + __DUP(title, title__len, CHAR); + __DUP(cmd, cmd__len, CHAR); + if (OPM_Verbose) { + Console_String(title, title__len); + Console_String(cmd, cmd__len); + Console_Ln(); + } + r = Platform_System(cmd, cmd__len); + status = __MASK(r, -128); + exitcode = __ASHR(r, 8); + if (exitcode > 127) { + exitcode = exitcode - 256; + } + if (r != 0) { + Console_String(title, title__len); + Console_String(cmd, cmd__len); + Console_Ln(); + Console_String((CHAR*)"-- failed: status ", (LONGINT)19); + Console_Int(status, ((LONGINT)(1))); + Console_String((CHAR*)", exitcode ", (LONGINT)12); + Console_Int(exitcode, ((LONGINT)(1))); + Console_String((CHAR*)".", (LONGINT)2); + Console_Ln(); + if ((status == 0 && exitcode == 127)) { + Console_String((CHAR*)"Is the C compiler in the current command path\?", (LONGINT)47); + Console_Ln(); + } + if (status != 0) { + Platform_Halt(status); + } else { + Platform_Halt(exitcode); + } + } + __DEL(title); + __DEL(cmd); +} + +void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len) +{ + CHAR cmd[1023]; + __DUP(moduleName, moduleName__len, CHAR); + __MOVE("gcc -g", cmd, 7); + Strings_Append(extTools_compilationOptions, ((LONGINT)(1023)), (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)"-c ", (LONGINT)4, (void*)cmd, ((LONGINT)(1023))); + Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)".c", (LONGINT)3, (void*)cmd, ((LONGINT)(1023))); + extTools_execute((CHAR*)"Assemble: ", (LONGINT)11, cmd, ((LONGINT)(1023))); + __DEL(moduleName); +} + +void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len) +{ + CHAR cmd[1023]; + __DUP(additionalopts, additionalopts__len, CHAR); + __MOVE("gcc -g", cmd, 7); + Strings_Append((CHAR*)" ", (LONGINT)2, (void*)cmd, ((LONGINT)(1023))); + Strings_Append(extTools_compilationOptions, ((LONGINT)(1023)), (void*)cmd, ((LONGINT)(1023))); + Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)".c ", (LONGINT)4, (void*)cmd, ((LONGINT)(1023))); + Strings_Append(additionalopts, additionalopts__len, (void*)cmd, ((LONGINT)(1023))); + if (statically) { + Strings_Append((CHAR*)"-static", (LONGINT)8, (void*)cmd, ((LONGINT)(1023))); + } + Strings_Append((CHAR*)" -o ", (LONGINT)5, (void*)cmd, ((LONGINT)(1023))); + Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)" -L\"", (LONGINT)5, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)"/lib\"", (LONGINT)6, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)" -l voc", (LONGINT)8, (void*)cmd, ((LONGINT)(1023))); + extTools_execute((CHAR*)"Assemble and link: ", (LONGINT)20, cmd, ((LONGINT)(1023))); + __DEL(additionalopts); +} + + +export void *extTools__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Console); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(Platform); + __MODULE_IMPORT(Strings); + __REGMOD("extTools", 0); +/* BEGIN */ + Strings_Append((CHAR*)" -I \"", (LONGINT)6, (void*)extTools_compilationOptions, ((LONGINT)(1023))); + Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)extTools_compilationOptions, ((LONGINT)(1023))); + Strings_Append((CHAR*)"/include\" ", (LONGINT)11, (void*)extTools_compilationOptions, ((LONGINT)(1023))); + Platform_GetEnv((CHAR*)"CFLAGS", (LONGINT)7, (void*)extTools_CFLAGS, ((LONGINT)(1023))); + Strings_Append(extTools_CFLAGS, ((LONGINT)(1023)), (void*)extTools_compilationOptions, ((LONGINT)(1023))); + Strings_Append((CHAR*)" ", (LONGINT)2, (void*)extTools_compilationOptions, ((LONGINT)(1023))); + __ENDMOD; +} diff --git a/bootstrap/unix-48/extTools.h b/bootstrap/unix-48/extTools.h new file mode 100644 index 00000000..95d07ddd --- /dev/null +++ b/bootstrap/unix-48/extTools.h @@ -0,0 +1,16 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef extTools__h +#define extTools__h + +#include "SYSTEM.h" + + + + +import void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len); +import void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len); +import void *extTools__init(void); + + +#endif diff --git a/bootstrap/unix-48/vt100.c b/bootstrap/unix-48/vt100.c new file mode 100644 index 00000000..649ea068 --- /dev/null +++ b/bootstrap/unix-48/vt100.c @@ -0,0 +1,258 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "Console.h" +#include "Strings.h" + + +export CHAR vt100_CSI[5]; +static CHAR vt100_tmpstr[32]; + + +export void vt100_CHA (INTEGER n); +export void vt100_CNL (INTEGER n); +export void vt100_CPL (INTEGER n); +export void vt100_CUB (INTEGER n); +export void vt100_CUD (INTEGER n); +export void vt100_CUF (INTEGER n); +export void vt100_CUP (INTEGER n, INTEGER m); +export void vt100_CUU (INTEGER n); +export void vt100_DECTCEMh (void); +export void vt100_DECTCEMl (void); +export void vt100_DSR (INTEGER n); +export void vt100_ED (INTEGER n); +export void vt100_EL (INTEGER n); +static void vt100_EscSeq (INTEGER n, CHAR *letter, LONGINT letter__len); +static void vt100_EscSeq0 (CHAR *letter, LONGINT letter__len); +static void vt100_EscSeq2 (INTEGER n, INTEGER m, CHAR *letter, LONGINT letter__len); +static void vt100_EscSeqSwapped (INTEGER n, CHAR *letter, LONGINT letter__len); +export void vt100_HVP (INTEGER n, INTEGER m); +export void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len); +export void vt100_RCP (void); +static void vt100_Reverse0 (CHAR *str, LONGINT str__len, INTEGER start, INTEGER end); +export void vt100_SCP (void); +export void vt100_SD (INTEGER n); +export void vt100_SGR (INTEGER n); +export void vt100_SGR2 (INTEGER n, INTEGER m); +export void vt100_SU (INTEGER n); +export void vt100_SetAttr (CHAR *attr, LONGINT attr__len); + + +static void vt100_Reverse0 (CHAR *str, LONGINT str__len, INTEGER start, INTEGER end) +{ + CHAR h; + while (start < end) { + h = str[__X(start, str__len)]; + str[__X(start, str__len)] = str[__X(end, str__len)]; + str[__X(end, str__len)] = h; + start += 1; + end -= 1; + } +} + +void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len) +{ + CHAR b[21]; + INTEGER s, e; + SHORTINT maxLength; + maxLength = 11; + if (int_ == (-2147483647-1)) { + __MOVE("-2147483648", b, 12); + e = 11; + } else { + if (int_ < 0) { + b[0] = '-'; + int_ = -int_; + s = 1; + } else { + s = 0; + } + e = s; + do { + b[__X(e, ((LONGINT)(21)))] = (CHAR)(__MOD(int_, 10) + 48); + int_ = __DIV(int_, 10); + e += 1; + } while (!(int_ == 0)); + b[__X(e, ((LONGINT)(21)))] = 0x00; + vt100_Reverse0((void*)b, ((LONGINT)(21)), s, e - 1); + } + __COPY(b, str, str__len); +} + +static void vt100_EscSeq0 (CHAR *letter, LONGINT letter__len) +{ + CHAR cmd[9]; + __DUP(letter, letter__len, CHAR); + __COPY(vt100_CSI, cmd, ((LONGINT)(9))); + Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(9))); + Console_String(cmd, ((LONGINT)(9))); + __DEL(letter); +} + +static void vt100_EscSeq (INTEGER n, CHAR *letter, LONGINT letter__len) +{ + CHAR nstr[2]; + CHAR cmd[7]; + __DUP(letter, letter__len, CHAR); + vt100_IntToStr(n, (void*)nstr, ((LONGINT)(2))); + __COPY(vt100_CSI, cmd, ((LONGINT)(7))); + Strings_Append(nstr, ((LONGINT)(2)), (void*)cmd, ((LONGINT)(7))); + Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(7))); + Console_String(cmd, ((LONGINT)(7))); + __DEL(letter); +} + +static void vt100_EscSeqSwapped (INTEGER n, CHAR *letter, LONGINT letter__len) +{ + CHAR nstr[2]; + CHAR cmd[7]; + __DUP(letter, letter__len, CHAR); + vt100_IntToStr(n, (void*)nstr, ((LONGINT)(2))); + __COPY(vt100_CSI, cmd, ((LONGINT)(7))); + Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(7))); + Strings_Append(nstr, ((LONGINT)(2)), (void*)cmd, ((LONGINT)(7))); + Console_String(cmd, ((LONGINT)(7))); + __DEL(letter); +} + +static void vt100_EscSeq2 (INTEGER n, INTEGER m, CHAR *letter, LONGINT letter__len) +{ + CHAR nstr[5], mstr[5]; + CHAR cmd[12]; + __DUP(letter, letter__len, CHAR); + vt100_IntToStr(n, (void*)nstr, ((LONGINT)(5))); + vt100_IntToStr(m, (void*)mstr, ((LONGINT)(5))); + __COPY(vt100_CSI, cmd, ((LONGINT)(12))); + Strings_Append(nstr, ((LONGINT)(5)), (void*)cmd, ((LONGINT)(12))); + Strings_Append((CHAR*)";", (LONGINT)2, (void*)cmd, ((LONGINT)(12))); + Strings_Append(mstr, ((LONGINT)(5)), (void*)cmd, ((LONGINT)(12))); + Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(12))); + Console_String(cmd, ((LONGINT)(12))); + __DEL(letter); +} + +void vt100_CUU (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"A", (LONGINT)2); +} + +void vt100_CUD (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"B", (LONGINT)2); +} + +void vt100_CUF (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"C", (LONGINT)2); +} + +void vt100_CUB (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"D", (LONGINT)2); +} + +void vt100_CNL (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"E", (LONGINT)2); +} + +void vt100_CPL (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"F", (LONGINT)2); +} + +void vt100_CHA (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"G", (LONGINT)2); +} + +void vt100_CUP (INTEGER n, INTEGER m) +{ + vt100_EscSeq2(n, m, (CHAR*)"H", (LONGINT)2); +} + +void vt100_ED (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"J", (LONGINT)2); +} + +void vt100_EL (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"K", (LONGINT)2); +} + +void vt100_SU (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"S", (LONGINT)2); +} + +void vt100_SD (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"T", (LONGINT)2); +} + +void vt100_HVP (INTEGER n, INTEGER m) +{ + vt100_EscSeq2(n, m, (CHAR*)"f", (LONGINT)2); +} + +void vt100_SGR (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"m", (LONGINT)2); +} + +void vt100_SGR2 (INTEGER n, INTEGER m) +{ + vt100_EscSeq2(n, m, (CHAR*)"m", (LONGINT)2); +} + +void vt100_DSR (INTEGER n) +{ + vt100_EscSeq(6, (CHAR*)"n", (LONGINT)2); +} + +void vt100_SCP (void) +{ + vt100_EscSeq0((CHAR*)"s", (LONGINT)2); +} + +void vt100_RCP (void) +{ + vt100_EscSeq0((CHAR*)"u", (LONGINT)2); +} + +void vt100_DECTCEMl (void) +{ + vt100_EscSeq0((CHAR*)"\?25l", (LONGINT)5); +} + +void vt100_DECTCEMh (void) +{ + vt100_EscSeq0((CHAR*)"\?25h", (LONGINT)5); +} + +void vt100_SetAttr (CHAR *attr, LONGINT attr__len) +{ + CHAR tmpstr[16]; + __DUP(attr, attr__len, CHAR); + __COPY(vt100_CSI, tmpstr, ((LONGINT)(16))); + Strings_Append(attr, attr__len, (void*)tmpstr, ((LONGINT)(16))); + Console_String(tmpstr, ((LONGINT)(16))); + __DEL(attr); +} + + +export void *vt100__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Console); + __MODULE_IMPORT(Strings); + __REGMOD("vt100", 0); + __REGCMD("DECTCEMh", vt100_DECTCEMh); + __REGCMD("DECTCEMl", vt100_DECTCEMl); + __REGCMD("RCP", vt100_RCP); + __REGCMD("SCP", vt100_SCP); +/* BEGIN */ + __COPY("", vt100_CSI, ((LONGINT)(5))); + Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5))); + __ENDMOD; +} diff --git a/bootstrap/unix-48/vt100.h b/bootstrap/unix-48/vt100.h new file mode 100644 index 00000000..6d210ec9 --- /dev/null +++ b/bootstrap/unix-48/vt100.h @@ -0,0 +1,37 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef vt100__h +#define vt100__h + +#include "SYSTEM.h" + + +import CHAR vt100_CSI[5]; + + +import void vt100_CHA (INTEGER n); +import void vt100_CNL (INTEGER n); +import void vt100_CPL (INTEGER n); +import void vt100_CUB (INTEGER n); +import void vt100_CUD (INTEGER n); +import void vt100_CUF (INTEGER n); +import void vt100_CUP (INTEGER n, INTEGER m); +import void vt100_CUU (INTEGER n); +import void vt100_DECTCEMh (void); +import void vt100_DECTCEMl (void); +import void vt100_DSR (INTEGER n); +import void vt100_ED (INTEGER n); +import void vt100_EL (INTEGER n); +import void vt100_HVP (INTEGER n, INTEGER m); +import void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len); +import void vt100_RCP (void); +import void vt100_SCP (void); +import void vt100_SD (INTEGER n); +import void vt100_SGR (INTEGER n); +import void vt100_SGR2 (INTEGER n, INTEGER m); +import void vt100_SU (INTEGER n); +import void vt100_SetAttr (CHAR *attr, LONGINT attr__len); +import void *vt100__init(void); + + +#endif diff --git a/bootstrap/unix-88/Configuration.c b/bootstrap/unix-88/Configuration.c new file mode 100644 index 00000000..c4d62d40 --- /dev/null +++ b/bootstrap/unix-88/Configuration.c @@ -0,0 +1,17 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" + + + + + + + +export void *Configuration__init(void) +{ + __DEFMOD; + __REGMOD("Configuration", 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-88/Configuration.h b/bootstrap/unix-88/Configuration.h new file mode 100644 index 00000000..b076eaee --- /dev/null +++ b/bootstrap/unix-88/Configuration.h @@ -0,0 +1,15 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Configuration__h +#define Configuration__h + +#define LARGE +#include "SYSTEM.h" + + + + +import void *Configuration__init(void); + + +#endif diff --git a/bootstrap/unix-88/Console.c b/bootstrap/unix-88/Console.c new file mode 100644 index 00000000..5946cb5d --- /dev/null +++ b/bootstrap/unix-88/Console.c @@ -0,0 +1,151 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "Platform.h" + + +static CHAR Console_line[128]; +static INTEGER Console_pos; + + +export void Console_Bool (BOOLEAN b); +export void Console_Char (CHAR ch); +export void Console_Flush (void); +export void Console_Hex (LONGINT i); +export void Console_Int (LONGINT i, LONGINT n); +export void Console_Ln (void); +export void Console_Read (CHAR *ch); +export void Console_ReadLine (CHAR *line, LONGINT line__len); +export void Console_String (CHAR *s, LONGINT s__len); + + +void Console_Flush (void) +{ + INTEGER error; + error = Platform_Write(((LONGINT)(1)), (LONGINT)(uintptr_t)Console_line, Console_pos); + Console_pos = 0; +} + +void Console_Char (CHAR ch) +{ + if (Console_pos == 128) { + Console_Flush(); + } + Console_line[__X(Console_pos, ((LONGINT)(128)))] = ch; + Console_pos += 1; + if (ch == 0x0a) { + Console_Flush(); + } +} + +void Console_String (CHAR *s, LONGINT s__len) +{ + INTEGER i; + __DUP(s, s__len, CHAR); + i = 0; + while (s[__X(i, s__len)] != 0x00) { + Console_Char(s[__X(i, s__len)]); + i += 1; + } + __DEL(s); +} + +void Console_Int (LONGINT i, LONGINT n) +{ + CHAR s[32]; + LONGINT i1, k; + if (i == __LSHL(1, 63, LONGINT)) { + __MOVE("8085774586302733229", s, 20); + k = 19; + } else { + i1 = __ABS(i); + s[0] = (CHAR)(__MOD(i1, 10) + 48); + i1 = __DIV(i1, 10); + k = 1; + while (i1 > 0) { + s[__X(k, ((LONGINT)(32)))] = (CHAR)(__MOD(i1, 10) + 48); + i1 = __DIV(i1, 10); + k += 1; + } + } + if (i < 0) { + s[__X(k, ((LONGINT)(32)))] = '-'; + k += 1; + } + while (n > k) { + Console_Char(' '); + n -= 1; + } + while (k > 0) { + k -= 1; + Console_Char(s[__X(k, ((LONGINT)(32)))]); + } +} + +void Console_Ln (void) +{ + Console_Char(0x0a); +} + +void Console_Bool (BOOLEAN b) +{ + if (b) { + Console_String((CHAR*)"TRUE", (LONGINT)5); + } else { + Console_String((CHAR*)"FALSE", (LONGINT)6); + } +} + +void Console_Hex (LONGINT i) +{ + LONGINT k, n; + k = -28; + while (k <= 0) { + n = __MASK(__ASH(i, k), -16); + if (n <= 9) { + Console_Char((CHAR)(48 + n)); + } else { + Console_Char((CHAR)(55 + n)); + } + k += 4; + } +} + +void Console_Read (CHAR *ch) +{ + LONGINT n; + INTEGER error; + Console_Flush(); + error = Platform_ReadBuf(((LONGINT)(0)), (void*)&*ch, ((LONGINT)(1)), &n); + if (n != 1) { + *ch = 0x00; + } +} + +void Console_ReadLine (CHAR *line, LONGINT line__len) +{ + LONGINT i; + CHAR ch; + Console_Flush(); + i = 0; + Console_Read(&ch); + while ((((i < line__len - 1 && ch != 0x0a)) && ch != 0x00)) { + line[__X(i, line__len)] = ch; + i += 1; + Console_Read(&ch); + } + line[__X(i, line__len)] = 0x00; +} + + +export void *Console__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Platform); + __REGMOD("Console", 0); + __REGCMD("Flush", Console_Flush); + __REGCMD("Ln", Console_Ln); +/* BEGIN */ + Console_pos = 0; + __ENDMOD; +} diff --git a/bootstrap/unix-88/Console.h b/bootstrap/unix-88/Console.h new file mode 100644 index 00000000..d8a9b11e --- /dev/null +++ b/bootstrap/unix-88/Console.h @@ -0,0 +1,24 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Console__h +#define Console__h + +#define LARGE +#include "SYSTEM.h" + + + + +import void Console_Bool (BOOLEAN b); +import void Console_Char (CHAR ch); +import void Console_Flush (void); +import void Console_Hex (LONGINT i); +import void Console_Int (LONGINT i, LONGINT n); +import void Console_Ln (void); +import void Console_Read (CHAR *ch); +import void Console_ReadLine (CHAR *line, LONGINT line__len); +import void Console_String (CHAR *s, LONGINT s__len); +import void *Console__init(void); + + +#endif diff --git a/bootstrap/unix-88/Files.c b/bootstrap/unix-88/Files.c new file mode 100644 index 00000000..b48620b0 --- /dev/null +++ b/bootstrap/unix-88/Files.c @@ -0,0 +1,1079 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "Configuration.h" +#include "Console.h" +#include "Heap.h" +#include "Platform.h" +#include "Strings.h" + +typedef + struct Files_Handle *Files_File; + +typedef + struct Files_BufDesc { + Files_File f; + BOOLEAN chg; + LONGINT org, size; + SYSTEM_BYTE data[4096]; + } Files_BufDesc; + +typedef + Files_BufDesc *Files_Buffer; + +typedef + CHAR Files_FileName[101]; + +typedef + struct Files_Handle { + Files_FileName workName, registerName; + BOOLEAN tempFile; + Platform_FileIdentity identity; + LONGINT fd, len, pos; + Files_Buffer bufs[4]; + INTEGER swapper, state; + } Files_Handle; + +typedef + struct Files_Rider { + LONGINT res; + BOOLEAN eof; + Files_Buffer buf; + LONGINT org, offset; + } Files_Rider; + + +static LONGINT Files_fileTab[256]; +static INTEGER Files_tempno; +static CHAR Files_HOME[1024]; +static struct { + LONGINT len[1]; + CHAR data[1]; +} *Files_SearchPath; + +export LONGINT *Files_Handle__typ; +export LONGINT *Files_BufDesc__typ; +export LONGINT *Files_Rider__typ; + +export Files_File Files_Base (Files_Rider *r, LONGINT *r__typ); +static Files_File Files_CacheEntry (Platform_FileIdentity identity); +export void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res); +export void Files_Close (Files_File f); +static void Files_Create (Files_File f); +export void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res); +static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INTEGER errcode); +static void Files_Finalize (SYSTEM_PTR o); +static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len); +static void Files_Flush (Files_Buffer buf); +export void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d); +export void Files_GetName (Files_File f, CHAR *name, LONGINT name__len); +static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len); +static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len); +static void Files_Init (void); +export LONGINT Files_Length (Files_File f); +static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len); +export Files_File Files_New (CHAR *name, LONGINT name__len); +export Files_File Files_Old (CHAR *name, LONGINT name__len); +export LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ); +export void Files_Purge (Files_File f); +export void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x); +export void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x); +export void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len); +export void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n); +export void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x); +export void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x); +export void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x); +export void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +export void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x); +export void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x); +export void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x); +export void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +export void Files_Register (Files_File f); +export void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res); +static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len); +export void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos); +export void Files_SetSearchPath (CHAR *path, LONGINT path__len); +export void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x); +export void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x); +export void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n); +export void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x); +export void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x); +export void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x); +export void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x); +export void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x); +export void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x); +export void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); + +#define Files_IdxTrap() __HALT(-1) + +static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INTEGER errcode) +{ + __DUP(s, s__len, CHAR); + Console_Ln(); + Console_String((CHAR*)"-- ", (LONGINT)4); + Console_String(s, s__len); + Console_String((CHAR*)": ", (LONGINT)3); + if (f != NIL) { + if (f->registerName[0] != 0x00) { + Console_String(f->registerName, ((LONGINT)(101))); + } else { + Console_String(f->workName, ((LONGINT)(101))); + } + if (f->fd != 0) { + Console_String((CHAR*)"f.fd = ", (LONGINT)8); + Console_Int(f->fd, ((LONGINT)(1))); + } + } + if (errcode != 0) { + Console_String((CHAR*)" errcode = ", (LONGINT)12); + Console_Int(errcode, ((LONGINT)(1))); + } + Console_Ln(); + __HALT(99); + __DEL(s); +} + +static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len) +{ + INTEGER i, j; + __DUP(dir, dir__len, CHAR); + __DUP(name, name__len, CHAR); + i = 0; + j = 0; + while (dir[i] != 0x00) { + dest[i] = dir[i]; + i += 1; + } + if (dest[i - 1] != '/') { + dest[i] = '/'; + i += 1; + } + while (name[j] != 0x00) { + dest[i] = name[j]; + i += 1; + j += 1; + } + dest[i] = 0x00; + __DEL(dir); + __DEL(name); +} + +static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len) +{ + LONGINT n, i, j; + __DUP(finalName, finalName__len, CHAR); + Files_tempno += 1; + n = Files_tempno; + i = 0; + if (finalName[0] != '/') { + while (Platform_CWD[i] != 0x00) { + name[i] = Platform_CWD[i]; + i += 1; + } + if (Platform_CWD[i - 1] != '/') { + name[i] = '/'; + i += 1; + } + } + j = 0; + while (finalName[j] != 0x00) { + name[i] = finalName[j]; + i += 1; + j += 1; + } + i -= 1; + while (name[i] != '/') { + i -= 1; + } + name[i + 1] = '.'; + name[i + 2] = 't'; + name[i + 3] = 'm'; + name[i + 4] = 'p'; + name[i + 5] = '.'; + i += 6; + while (n > 0) { + name[i] = (CHAR)(__MOD(n, 10) + 48); + n = __DIV(n, 10); + i += 1; + } + name[i] = '.'; + i += 1; + n = Platform_PID; + while (n > 0) { + name[i] = (CHAR)(__MOD(n, 10) + 48); + n = __DIV(n, 10); + i += 1; + } + name[i] = 0x00; + __DEL(finalName); +} + +static void Files_Create (Files_File f) +{ + Platform_FileIdentity identity; + BOOLEAN done; + INTEGER error; + CHAR err[32]; + if (f->fd == -1) { + if (f->state == 1) { + Files_GetTempName(f->registerName, ((LONGINT)(101)), (void*)f->workName, ((LONGINT)(101))); + f->tempFile = 1; + } else if (f->state == 2) { + __COPY(f->registerName, f->workName, ((LONGINT)(101))); + f->registerName[0] = 0x00; + f->tempFile = 0; + } + error = Platform_Unlink((void*)f->workName, ((LONGINT)(101))); + error = Platform_New((void*)f->workName, ((LONGINT)(101)), &f->fd); + done = error == 0; + if ((!done && Platform_TooManyFiles(error)) || (done && f->fd >= 256)) { + if ((done && f->fd >= 256)) { + error = Platform_Close(f->fd); + } + Heap_GC(1); + error = Platform_New((void*)f->workName, ((LONGINT)(101)), &f->fd); + done = f->fd == 0; + } + if (done) { + if (f->fd >= 256) { + error = Platform_Close(f->fd); + Files_Err((CHAR*)"too many files open", (LONGINT)20, f, 0); + } else { + Files_fileTab[f->fd] = (LONGINT)(uintptr_t)f; + Heap_FileCount += 1; + Heap_RegisterFinalizer((void*)f, Files_Finalize); + f->state = 0; + f->pos = 0; + error = Platform_Identify(f->fd, &f->identity, Platform_FileIdentity__typ); + } + } else { + if (Platform_NoSuchDirectory(error)) { + __MOVE("no such directory", err, 18); + } else if (Platform_TooManyFiles(error)) { + __MOVE("too many files open", err, 20); + } else { + __MOVE("file not created", err, 17); + } + Files_Err(err, ((LONGINT)(32)), f, error); + } + } +} + +static void Files_Flush (Files_Buffer buf) +{ + INTEGER error; + Files_File f = NIL; + if (buf->chg) { + f = buf->f; + Files_Create(f); + if (buf->org != f->pos) { + error = Platform_Seek(f->fd, buf->org, Platform_SeekSet); + } + error = Platform_Write(f->fd, (LONGINT)(uintptr_t)buf->data, buf->size); + if (error != 0) { + Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error); + } + f->pos = buf->org + buf->size; + buf->chg = 0; + error = Platform_Identify(f->fd, &f->identity, Platform_FileIdentity__typ); + if (error != 0) { + Files_Err((CHAR*)"error identifying file", (LONGINT)23, f, error); + } + } +} + +void Files_Close (Files_File f) +{ + LONGINT i; + INTEGER error; + if (f->state != 1 || f->registerName[0] != 0x00) { + Files_Create(f); + i = 0; + while ((i < 4 && f->bufs[i] != NIL)) { + Files_Flush(f->bufs[i]); + i += 1; + } + error = Platform_Sync(f->fd); + if (error != 0) { + Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error); + } + Files_fileTab[f->fd] = 0; + error = Platform_Close(f->fd); + f->fd = -1; + f->state = 1; + Heap_FileCount -= 1; + } +} + +LONGINT Files_Length (Files_File f) +{ + LONGINT _o_result; + _o_result = f->len; + return _o_result; +} + +Files_File Files_New (CHAR *name, LONGINT name__len) +{ + Files_File _o_result; + Files_File f = NIL; + __DUP(name, name__len, CHAR); + __NEW(f, Files_Handle); + f->workName[0] = 0x00; + __COPY(name, f->registerName, ((LONGINT)(101))); + f->fd = -1; + f->state = 1; + f->len = 0; + f->pos = 0; + f->swapper = -1; + _o_result = f; + __DEL(name); + return _o_result; +} + +static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len) +{ + INTEGER i; + CHAR ch; + i = 0; + if (Files_SearchPath == NIL) { + if (*pos == 0) { + dir[0] = '.'; + i = 1; + *pos += 1; + } + } else { + ch = (Files_SearchPath->data)[*pos]; + while (ch == ' ' || ch == ';') { + *pos += 1; + ch = (Files_SearchPath->data)[*pos]; + } + if (ch == '~') { + *pos += 1; + ch = (Files_SearchPath->data)[*pos]; + while (Files_HOME[i] != 0x00) { + dir[i] = Files_HOME[i]; + i += 1; + } + if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) { + while ((i > 0 && dir[i - 1] != '/')) { + i -= 1; + } + } + } + while ((ch != 0x00 && ch != ';')) { + dir[i] = ch; + i += 1; + *pos += 1; + ch = (Files_SearchPath->data)[*pos]; + } + while ((i > 0 && dir[i - 1] == ' ')) { + i -= 1; + } + } + dir[i] = 0x00; +} + +static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len) +{ + BOOLEAN _o_result; + INTEGER i; + CHAR ch; + i = 0; + ch = name[0]; + while ((ch != 0x00 && ch != '/')) { + i += 1; + ch = name[i]; + } + _o_result = ch == '/'; + return _o_result; +} + +static Files_File Files_CacheEntry (Platform_FileIdentity identity) +{ + Files_File _o_result; + Files_File f = NIL; + INTEGER i, error; + i = 0; + while (i < 256) { + f = (Files_File)(uintptr_t)Files_fileTab[i]; + if ((f != NIL && Platform_SameFile(identity, f->identity))) { + if (!Platform_SameFileTime(identity, f->identity)) { + i = 0; + while (i < 4) { + if (f->bufs[i] != NIL) { + f->bufs[i]->org = -1; + f->bufs[i] = NIL; + } + i += 1; + } + f->swapper = -1; + f->identity = identity; + error = Platform_Size(f->fd, &f->len); + } + _o_result = f; + return _o_result; + } + i += 1; + } + _o_result = NIL; + return _o_result; +} + +Files_File Files_Old (CHAR *name, LONGINT name__len) +{ + Files_File _o_result; + Files_File f = NIL; + LONGINT fd; + INTEGER pos; + BOOLEAN done; + CHAR dir[256], path[256]; + INTEGER error; + Platform_FileIdentity identity; + __DUP(name, name__len, CHAR); + if (name[0] != 0x00) { + if (Files_HasDir((void*)name, name__len)) { + dir[0] = 0x00; + __COPY(name, path, ((LONGINT)(256))); + } else { + pos = 0; + Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256))); + Files_MakeFileName(dir, ((LONGINT)(256)), name, name__len, (void*)path, ((LONGINT)(256))); + Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256))); + } + for (;;) { + error = Platform_OldRW((void*)path, ((LONGINT)(256)), &fd); + done = error == 0; + if ((!done && Platform_TooManyFiles(error)) || (done && fd >= 256)) { + if ((done && fd >= 256)) { + error = Platform_Close(fd); + } + Heap_GC(1); + error = Platform_OldRW((void*)path, ((LONGINT)(256)), &fd); + done = error == 0; + if ((!done && Platform_TooManyFiles(error))) { + Files_Err((CHAR*)"too many files open", (LONGINT)20, f, error); + } + } + if ((!done && Platform_Inaccessible(error))) { + error = Platform_OldRO((void*)path, ((LONGINT)(256)), &fd); + done = error == 0; + } + if ((!done && !Platform_Absent(error))) { + Console_String((CHAR*)"Warning: Files.Old ", (LONGINT)20); + Console_String(name, name__len); + Console_String((CHAR*)" error = ", (LONGINT)10); + Console_Int(error, ((LONGINT)(0))); + Console_Ln(); + } + if (done) { + error = Platform_Identify(fd, &identity, Platform_FileIdentity__typ); + f = Files_CacheEntry(identity); + if (f != NIL) { + error = Platform_Close(fd); + _o_result = f; + __DEL(name); + return _o_result; + } else if (fd >= 256) { + error = Platform_Close(fd); + Files_Err((CHAR*)"too many files open", (LONGINT)20, f, 0); + } else { + __NEW(f, Files_Handle); + Files_fileTab[fd] = (LONGINT)(uintptr_t)f; + Heap_FileCount += 1; + Heap_RegisterFinalizer((void*)f, Files_Finalize); + f->fd = fd; + f->state = 0; + f->pos = 0; + f->swapper = -1; + error = Platform_Size(fd, &f->len); + __COPY(name, f->workName, ((LONGINT)(101))); + f->registerName[0] = 0x00; + f->tempFile = 0; + f->identity = identity; + _o_result = f; + __DEL(name); + return _o_result; + } + } else if (dir[0] == 0x00) { + _o_result = NIL; + __DEL(name); + return _o_result; + } else { + Files_MakeFileName(dir, ((LONGINT)(256)), name, name__len, (void*)path, ((LONGINT)(256))); + Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256))); + } + } + } else { + _o_result = NIL; + __DEL(name); + return _o_result; + } + __RETCHK; +} + +void Files_Purge (Files_File f) +{ + INTEGER i; + Platform_FileIdentity identity; + INTEGER error; + i = 0; + while (i < 4) { + if (f->bufs[i] != NIL) { + f->bufs[i]->org = -1; + f->bufs[i] = NIL; + } + i += 1; + } + if (f->fd != -1) { + error = Platform_Truncate(f->fd, ((LONGINT)(0))); + error = Platform_Seek(f->fd, ((LONGINT)(0)), Platform_SeekSet); + } + f->pos = 0; + f->len = 0; + f->swapper = -1; + error = Platform_Identify(f->fd, &identity, Platform_FileIdentity__typ); + Platform_SetMTime(&f->identity, Platform_FileIdentity__typ, identity); +} + +void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d) +{ + Platform_FileIdentity identity; + INTEGER error; + Files_Create(f); + error = Platform_Identify(f->fd, &identity, Platform_FileIdentity__typ); + Platform_MTimeAsClock(identity, &*t, &*d); +} + +LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ) +{ + LONGINT _o_result; + _o_result = (*r).org + (*r).offset; + return _o_result; +} + +void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos) +{ + LONGINT org, offset, i, n; + Files_Buffer buf = NIL; + INTEGER error; + if (f != NIL) { + if (pos > f->len) { + pos = f->len; + } else if (pos < 0) { + pos = 0; + } + offset = __MASK(pos, -4096); + org = pos - offset; + i = 0; + while ((((i < 4 && f->bufs[i] != NIL)) && org != f->bufs[i]->org)) { + i += 1; + } + if (i < 4) { + if (f->bufs[i] == NIL) { + __NEW(buf, Files_BufDesc); + buf->chg = 0; + buf->org = -1; + buf->f = f; + f->bufs[i] = buf; + } else { + buf = f->bufs[i]; + } + } else { + f->swapper = __MASK(f->swapper + 1, -4); + buf = f->bufs[f->swapper]; + Files_Flush(buf); + } + if (buf->org != org) { + if (org == f->len) { + buf->size = 0; + } else { + Files_Create(f); + if (f->pos != org) { + error = Platform_Seek(f->fd, org, Platform_SeekSet); + } + error = Platform_ReadBuf(f->fd, (void*)buf->data, ((LONGINT)(4096)), &n); + if (error != 0) { + Files_Err((CHAR*)"read from file not done", (LONGINT)24, f, error); + } + f->pos = org + n; + buf->size = n; + } + buf->org = org; + buf->chg = 0; + } + } else { + buf = NIL; + org = 0; + offset = 0; + } + (*r).buf = buf; + (*r).org = org; + (*r).offset = offset; + (*r).eof = 0; + (*r).res = 0; +} + +void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x) +{ + LONGINT offset; + Files_Buffer buf = NIL; + buf = (*r).buf; + offset = (*r).offset; + if ((*r).org != buf->org) { + Files_Set(&*r, r__typ, buf->f, (*r).org + offset); + buf = (*r).buf; + offset = (*r).offset; + } + if (offset < buf->size) { + *x = buf->data[offset]; + (*r).offset = offset + 1; + } else if ((*r).org + offset < buf->f->len) { + Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset); + *x = (*r).buf->data[0]; + (*r).offset = 1; + } else { + *x = 0x00; + (*r).eof = 1; + } +} + +void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n) +{ + LONGINT xpos, min, restInBuf, offset; + Files_Buffer buf = NIL; + if (n > x__len) { + Files_IdxTrap(); + } + xpos = 0; + buf = (*r).buf; + offset = (*r).offset; + while (n > 0) { + if ((*r).org != buf->org || offset >= 4096) { + Files_Set(&*r, r__typ, buf->f, (*r).org + offset); + buf = (*r).buf; + offset = (*r).offset; + } + restInBuf = buf->size - offset; + if (restInBuf == 0) { + (*r).res = n; + (*r).eof = 1; + return; + } else if (n > restInBuf) { + min = restInBuf; + } else { + min = n; + } + __MOVE((LONGINT)(uintptr_t)buf->data + offset, (LONGINT)(uintptr_t)x + xpos, min); + offset += min; + (*r).offset = offset; + xpos += min; + n -= min; + } + (*r).res = 0; + (*r).eof = 0; +} + +void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len) +{ + Files_ReadBytes(&*r, r__typ, (void*)x, x__len * ((LONGINT)(1)), ((LONGINT)(1))); +} + +Files_File Files_Base (Files_Rider *r, LONGINT *r__typ) +{ + Files_File _o_result; + _o_result = (*r).buf->f; + return _o_result; +} + +void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x) +{ + Files_Buffer buf = NIL; + LONGINT offset; + buf = (*r).buf; + offset = (*r).offset; + if ((*r).org != buf->org || offset >= 4096) { + Files_Set(&*r, r__typ, buf->f, (*r).org + offset); + buf = (*r).buf; + offset = (*r).offset; + } + buf->data[offset] = x; + buf->chg = 1; + if (offset == buf->size) { + buf->size += 1; + buf->f->len += 1; + } + (*r).offset = offset + 1; + (*r).res = 0; +} + +void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n) +{ + LONGINT xpos, min, restInBuf, offset; + Files_Buffer buf = NIL; + if (n > x__len) { + Files_IdxTrap(); + } + xpos = 0; + buf = (*r).buf; + offset = (*r).offset; + while (n > 0) { + if ((*r).org != buf->org || offset >= 4096) { + Files_Set(&*r, r__typ, buf->f, (*r).org + offset); + buf = (*r).buf; + offset = (*r).offset; + } + restInBuf = 4096 - offset; + if (n > restInBuf) { + min = restInBuf; + } else { + min = n; + } + __MOVE((LONGINT)(uintptr_t)x + xpos, (LONGINT)(uintptr_t)buf->data + offset, min); + offset += min; + (*r).offset = offset; + if (offset > buf->size) { + buf->f->len += offset - buf->size; + buf->size = offset; + } + xpos += min; + n -= min; + buf->chg = 1; + } + (*r).res = 0; +} + +void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res) +{ + __DUP(name, name__len, CHAR); + *res = Platform_Unlink((void*)name, name__len); + __DEL(name); +} + +void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res) +{ + LONGINT fdold, fdnew, n; + INTEGER error, ignore; + Platform_FileIdentity oldidentity, newidentity; + CHAR buf[4096]; + __DUP(old, old__len, CHAR); + __DUP(new, new__len, CHAR); + error = Platform_IdentifyByName(old, old__len, &oldidentity, Platform_FileIdentity__typ); + if (error == 0) { + error = Platform_IdentifyByName(new, new__len, &newidentity, Platform_FileIdentity__typ); + if ((error != 0 && !Platform_SameFile(oldidentity, newidentity))) { + Files_Delete(new, new__len, &error); + } + error = Platform_Rename((void*)old, old__len, (void*)new, new__len); + if (!Platform_DifferentFilesystems(error)) { + *res = error; + return; + } else { + error = Platform_OldRO((void*)old, old__len, &fdold); + if (error != 0) { + *res = 2; + return; + } + error = Platform_New((void*)new, new__len, &fdnew); + if (error != 0) { + error = Platform_Close(fdold); + *res = 3; + return; + } + error = Platform_Read(fdold, (LONGINT)(uintptr_t)buf, ((LONGINT)(4096)), &n); + while (n > 0) { + error = Platform_Write(fdnew, (LONGINT)(uintptr_t)buf, n); + if (error != 0) { + ignore = Platform_Close(fdold); + ignore = Platform_Close(fdnew); + Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error); + } + error = Platform_Read(fdold, (LONGINT)(uintptr_t)buf, ((LONGINT)(4096)), &n); + } + ignore = Platform_Close(fdold); + ignore = Platform_Close(fdnew); + if (n == 0) { + error = Platform_Unlink((void*)old, old__len); + *res = 0; + } else { + Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error); + } + } + } else { + *res = 2; + } + __DEL(old); + __DEL(new); +} + +void Files_Register (Files_File f) +{ + INTEGER idx, errcode; + Files_File f1 = NIL; + CHAR file[104]; + if ((f->state == 1 && f->registerName[0] != 0x00)) { + f->state = 2; + } + Files_Close(f); + if (f->registerName[0] != 0x00) { + Files_Rename(f->workName, ((LONGINT)(101)), f->registerName, ((LONGINT)(101)), &errcode); + if (errcode != 0) { + __COPY(f->registerName, file, ((LONGINT)(104))); + __HALT(99); + } + __COPY(f->registerName, f->workName, ((LONGINT)(101))); + f->registerName[0] = 0x00; + f->tempFile = 0; + } +} + +void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res) +{ + __DUP(path, path__len, CHAR); + *res = Platform_Chdir((void*)path, path__len); + __DEL(path); +} + +static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len) +{ + LONGINT i, j; + if (!Platform_LittleEndian) { + i = src__len; + j = 0; + while (i > 0) { + i -= 1; + dest[j] = src[i]; + j += 1; + } + } else { + __MOVE((LONGINT)(uintptr_t)src, (LONGINT)(uintptr_t)dest, src__len); + } +} + +void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x) +{ + Files_Read(&*R, R__typ, (CHAR*)(void*)&*x); +} + +void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x) +{ + CHAR b[2]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(2)), ((LONGINT)(2))); + *x = (int)b[0] + __ASHL((int)b[1], 8); +} + +void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x) +{ + CHAR b[4]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); + *x = (((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((int)b[2], 16)) + __ASHL((int)b[3], 24); +} + +void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x) +{ + CHAR b[4]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); + *x = (SET)((((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((int)b[2], 16)) + __ASHL((int)b[3], 24)); +} + +void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x) +{ + CHAR b[4]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); + Files_FlipBytes((void*)b, ((LONGINT)(4)), (void*)&*x, ((LONGINT)(4))); +} + +void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x) +{ + CHAR b[8]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(8)), ((LONGINT)(8))); + Files_FlipBytes((void*)b, ((LONGINT)(8)), (void*)&*x, ((LONGINT)(8))); +} + +void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len) +{ + INTEGER i; + CHAR ch; + i = 0; + do { + Files_Read(&*R, R__typ, (void*)&ch); + x[i] = ch; + i += 1; + } while (!(ch == 0x00)); +} + +void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len) +{ + INTEGER i; + CHAR ch; + BOOLEAN b; + i = 0; + b = 0; + do { + Files_Read(&*R, R__typ, (void*)&ch); + if ((ch == 0x00 || ch == 0x0a) || ch == 0x0d) { + b = 1; + } else { + x[i] = ch; + i += 1; + } + } while (!b); +} + +void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x) +{ + SHORTINT s; + CHAR ch; + LONGINT n; + s = 0; + n = 0; + Files_Read(&*R, R__typ, (void*)&ch); + while ((int)ch >= 128) { + n += __ASH((LONGINT)((int)ch - 128), s); + s += 7; + Files_Read(&*R, R__typ, (void*)&ch); + } + n += __ASH((LONGINT)(__MASK((int)ch, -64) - __ASHL(__ASHR((int)ch, 6), 6)), s); + *x = n; +} + +void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x) +{ + Files_Write(&*R, R__typ, __VAL(CHAR, x)); +} + +void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x) +{ + CHAR b[2]; + b[0] = (CHAR)x; + b[1] = (CHAR)__ASHR(x, 8); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(2)), ((LONGINT)(2))); +} + +void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x) +{ + CHAR b[4]; + b[0] = (CHAR)x; + b[1] = (CHAR)__ASHR(x, 8); + b[2] = (CHAR)__ASHR(x, 16); + b[3] = (CHAR)__ASHR(x, 24); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); +} + +void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x) +{ + CHAR b[4]; + LONGINT i; + i = (LONGINT)x; + b[0] = (CHAR)i; + b[1] = (CHAR)__ASHR(i, 8); + b[2] = (CHAR)__ASHR(i, 16); + b[3] = (CHAR)__ASHR(i, 24); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); +} + +void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x) +{ + CHAR b[4]; + Files_FlipBytes((void*)&x, ((LONGINT)(4)), (void*)b, ((LONGINT)(4))); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); +} + +void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x) +{ + CHAR b[8]; + Files_FlipBytes((void*)&x, ((LONGINT)(8)), (void*)b, ((LONGINT)(8))); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(8)), ((LONGINT)(8))); +} + +void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len) +{ + INTEGER i; + i = 0; + while (x[i] != 0x00) { + i += 1; + } + Files_WriteBytes(&*R, R__typ, (void*)x, x__len * ((LONGINT)(1)), i + 1); +} + +void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x) +{ + while (x < -64 || x > 63) { + Files_Write(&*R, R__typ, (CHAR)(__MASK(x, -128) + 128)); + x = __ASHR(x, 7); + } + Files_Write(&*R, R__typ, (CHAR)__MASK(x, -128)); +} + +void Files_GetName (Files_File f, CHAR *name, LONGINT name__len) +{ + __COPY(f->workName, name, name__len); +} + +static void Files_Finalize (SYSTEM_PTR o) +{ + Files_File f = NIL; + LONGINT res; + f = (Files_File)(uintptr_t)o; + if (f->fd >= 0) { + Files_fileTab[f->fd] = 0; + res = Platform_Close(f->fd); + f->fd = -1; + Heap_FileCount -= 1; + if (f->tempFile) { + res = Platform_Unlink((void*)f->workName, ((LONGINT)(101))); + } + } +} + +void Files_SetSearchPath (CHAR *path, LONGINT path__len) +{ + __DUP(path, path__len, CHAR); + if (Strings_Length(path, path__len) != 0) { + Files_SearchPath = __NEWARR(NIL, ((LONGINT)(1)), 1, 1, 1, (LONGINT)(Strings_Length(path, path__len) + 1)); + __COPY(path, Files_SearchPath->data, Files_SearchPath->len[0]); + } else { + Files_SearchPath = NIL; + } + __DEL(path); +} + +static void Files_Init (void) +{ + LONGINT i; + i = 0; + while (i < 256) { + Files_fileTab[i] = 0; + i += 1; + } + Files_tempno = -1; + Heap_FileCount = 0; + Files_SearchPath = NIL; + Files_HOME[0] = 0x00; + Platform_GetEnv((CHAR*)"HOME", (LONGINT)5, (void*)Files_HOME, ((LONGINT)(1024))); +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(Files_SearchPath); +} + +__TDESC(Files_Handle, 1, 4) = {__TDFLDS("Handle", 296), {256, 264, 272, 280, -40}}; +__TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4128), {0, -16}}; +__TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 40), {16, -16}}; + +export void *Files__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Console); + __MODULE_IMPORT(Heap); + __MODULE_IMPORT(Platform); + __MODULE_IMPORT(Strings); + __REGMOD("Files", EnumPtrs); + __INITYP(Files_Handle, Files_Handle, 0); + __INITYP(Files_BufDesc, Files_BufDesc, 0); + __INITYP(Files_Rider, Files_Rider, 0); +/* BEGIN */ + Files_Init(); + __ENDMOD; +} diff --git a/bootstrap/unix-88/Files.h b/bootstrap/unix-88/Files.h new file mode 100644 index 00000000..01c37212 --- /dev/null +++ b/bootstrap/unix-88/Files.h @@ -0,0 +1,71 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tspkaSfF */ + +#ifndef Files__h +#define Files__h + +#define LARGE +#include "SYSTEM.h" + +typedef + struct Files_Handle *Files_File; + +typedef + struct Files_Handle { + char _prvt0[232]; + LONGINT fd; + char _prvt1[56]; + } Files_Handle; + +typedef + struct Files_Rider { + LONGINT res; + BOOLEAN eof; + char _prvt0[31]; + } Files_Rider; + + + +import LONGINT *Files_Handle__typ; +import LONGINT *Files_Rider__typ; + +import Files_File Files_Base (Files_Rider *r, LONGINT *r__typ); +import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res); +import void Files_Close (Files_File f); +import void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res); +import void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d); +import void Files_GetName (Files_File f, CHAR *name, LONGINT name__len); +import LONGINT Files_Length (Files_File f); +import Files_File Files_New (CHAR *name, LONGINT name__len); +import Files_File Files_Old (CHAR *name, LONGINT name__len); +import LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ); +import void Files_Purge (Files_File f); +import void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x); +import void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x); +import void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len); +import void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n); +import void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x); +import void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x); +import void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x); +import void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +import void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x); +import void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x); +import void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x); +import void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +import void Files_Register (Files_File f); +import void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res); +import void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos); +import void Files_SetSearchPath (CHAR *path, LONGINT path__len); +import void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x); +import void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x); +import void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n); +import void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x); +import void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x); +import void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x); +import void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x); +import void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x); +import void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x); +import void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +import void *Files__init(void); + + +#endif diff --git a/bootstrap/unix-88/Heap.c b/bootstrap/unix-88/Heap.c new file mode 100644 index 00000000..929a8283 --- /dev/null +++ b/bootstrap/unix-88/Heap.c @@ -0,0 +1,753 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tskSfF */ +#define LARGE +#include "SYSTEM.h" + +struct Heap__1 { + CHAR ch; + SYSTEM_PTR p; +}; + +typedef + struct Heap_CmdDesc *Heap_Cmd; + +typedef + CHAR Heap_CmdName[24]; + +typedef + void (*Heap_Command)(void); + +typedef + struct Heap_CmdDesc { + Heap_Cmd next; + Heap_CmdName name; + Heap_Command cmd; + } Heap_CmdDesc; + +typedef + void (*Heap_EnumProc)(void(*)(SYSTEM_PTR)); + +typedef + struct Heap_FinDesc *Heap_FinNode; + +typedef + void (*Heap_Finalizer)(SYSTEM_PTR); + +typedef + struct Heap_FinDesc { + Heap_FinNode next; + LONGINT obj; + BOOLEAN marked; + Heap_Finalizer finalize; + } Heap_FinDesc; + +typedef + struct Heap_ModuleDesc *Heap_Module; + +typedef + CHAR Heap_ModuleName[20]; + +typedef + struct Heap_ModuleDesc { + Heap_Module next; + Heap_ModuleName name; + LONGINT refcnt; + Heap_Cmd cmds; + LONGINT types; + Heap_EnumProc enumPtrs; + LONGINT reserved1, reserved2; + } Heap_ModuleDesc; + + +export SYSTEM_PTR Heap_modules; +static LONGINT Heap_freeList[10]; +static LONGINT Heap_bigBlocks; +export LONGINT Heap_allocated; +static BOOLEAN Heap_firstTry; +static LONGINT Heap_heap, Heap_heapend; +export LONGINT Heap_heapsize; +static Heap_FinNode Heap_fin; +static INTEGER Heap_lockdepth; +static BOOLEAN Heap_interrupted; +export INTEGER Heap_FileCount; + +export LONGINT *Heap_ModuleDesc__typ; +export LONGINT *Heap_CmdDesc__typ; +export LONGINT *Heap_FinDesc__typ; +export LONGINT *Heap__1__typ; + +static void Heap_CheckFin (void); +static void Heap_ExtendHeap (LONGINT blksz); +export void Heap_FINALL (void); +static void Heap_Finalize (void); +export void Heap_GC (BOOLEAN markStack); +static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len); +export void Heap_INCREF (Heap_Module m); +export void Heap_InitHeap (void); +export void Heap_Lock (void); +static void Heap_Mark (LONGINT q); +static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len); +static void Heap_MarkP (SYSTEM_PTR p); +static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len); +export SYSTEM_PTR Heap_NEWBLK (LONGINT size); +export SYSTEM_PTR Heap_NEWREC (LONGINT tag); +static LONGINT Heap_NewChunk (LONGINT blksz); +export void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd); +export SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs); +export void Heap_REGTYP (Heap_Module m, LONGINT typ); +export void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize); +static void Heap_Scan (void); +static void Heap_Sift (LONGINT l, LONGINT r, LONGINT *a, LONGINT a__len); +export void Heap_Unlock (void); + +extern void *Heap__init(); +extern LONGINT Platform_MainStackFrame; +extern LONGINT Platform_OSAllocate(LONGINT size); +#define Heap_FetchAddress(pointer) (LONGINT)(uintptr_t)(*((void**)((uintptr_t)pointer))) +#define Heap_HeapModuleInit() Heap__init() +#define Heap_OSAllocate(size) Platform_OSAllocate(size) +#define Heap_PlatformHalt(code) Platform_Halt(code) +#define Heap_PlatformMainStackFrame() Platform_MainStackFrame + +void Heap_Lock (void) +{ + Heap_lockdepth += 1; +} + +void Heap_Unlock (void) +{ + Heap_lockdepth -= 1; + if ((Heap_interrupted && Heap_lockdepth == 0)) { + Heap_PlatformHalt(((LONGINT)(-9))); + } +} + +SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs) +{ + SYSTEM_PTR _o_result; + Heap_Module m; + if (__STRCMP(name, "Heap") == 0) { + __SYSNEW(m, 80); + } else { + __NEW(m, Heap_ModuleDesc); + } + m->types = 0; + m->cmds = NIL; + __COPY(name, m->name, ((LONGINT)(20))); + m->refcnt = 0; + m->enumPtrs = enumPtrs; + m->next = (Heap_Module)(uintptr_t)Heap_modules; + Heap_modules = (SYSTEM_PTR)m; + _o_result = (void*)m; + return _o_result; +} + +void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd) +{ + Heap_Cmd c; + if (__STRCMP(m->name, "Heap") == 0) { + __SYSNEW(c, 40); + } else { + __NEW(c, Heap_CmdDesc); + } + __COPY(name, c->name, ((LONGINT)(24))); + c->cmd = cmd; + c->next = m->cmds; + m->cmds = c; +} + +void Heap_REGTYP (Heap_Module m, LONGINT typ) +{ + __PUT(typ, m->types, LONGINT); + m->types = typ; +} + +void Heap_INCREF (Heap_Module m) +{ + m->refcnt += 1; +} + +static LONGINT Heap_NewChunk (LONGINT blksz) +{ + LONGINT _o_result; + LONGINT chnk; + chnk = Heap_OSAllocate(blksz + 24); + if (chnk != 0) { + __PUT(chnk + 8, chnk + (24 + blksz), LONGINT); + __PUT(chnk + 24, chnk + 32, LONGINT); + __PUT(chnk + 32, blksz, LONGINT); + __PUT(chnk + 40, -8, LONGINT); + __PUT(chnk + 48, Heap_bigBlocks, LONGINT); + Heap_bigBlocks = chnk + 24; + Heap_heapsize += blksz; + } + _o_result = chnk; + return _o_result; +} + +static void Heap_ExtendHeap (LONGINT blksz) +{ + LONGINT size, chnk, j, next; + if (blksz > 320000) { + size = blksz; + } else { + size = 320000; + } + chnk = Heap_NewChunk(size); + if (chnk != 0) { + if (chnk < Heap_heap) { + __PUT(chnk, Heap_heap, LONGINT); + Heap_heap = chnk; + } else { + j = Heap_heap; + next = Heap_FetchAddress(j); + while ((next != 0 && chnk > next)) { + j = next; + next = Heap_FetchAddress(j); + } + __PUT(chnk, next, LONGINT); + __PUT(j, chnk, LONGINT); + } + if (next == 0) { + Heap_heapend = Heap_FetchAddress(chnk + 8); + } + } +} + +SYSTEM_PTR Heap_NEWREC (LONGINT tag) +{ + SYSTEM_PTR _o_result; + LONGINT i, i0, di, blksz, restsize, t, adr, end, next, prev; + SYSTEM_PTR new; + Heap_Lock(); + blksz = Heap_FetchAddress(tag); + i0 = __ASHR(blksz, 5); + i = i0; + if (i < 9) { + adr = Heap_freeList[i]; + while (adr == 0) { + i += 1; + adr = Heap_freeList[i]; + } + } + if (i < 9) { + next = Heap_FetchAddress(adr + 24); + Heap_freeList[i] = next; + if (i != i0) { + di = i - i0; + restsize = __ASHL(di, 5); + end = adr + restsize; + __PUT(end + 8, blksz, LONGINT); + __PUT(end + 16, -8, LONGINT); + __PUT(end, end + 8, LONGINT); + __PUT(adr + 8, restsize, LONGINT); + __PUT(adr + 24, Heap_freeList[di], LONGINT); + Heap_freeList[di] = adr; + adr += restsize; + } + } else { + adr = Heap_bigBlocks; + prev = 0; + for (;;) { + if (adr == 0) { + if (Heap_firstTry) { + Heap_GC(1); + blksz += 32; + if (__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2) < Heap_heapsize) { + Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 96), 7) - Heap_heapsize); + } + Heap_firstTry = 0; + new = Heap_NEWREC(tag); + Heap_firstTry = 1; + if (new == NIL) { + Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 96), 7) - Heap_heapsize); + new = Heap_NEWREC(tag); + } + Heap_Unlock(); + _o_result = new; + return _o_result; + } else { + Heap_Unlock(); + _o_result = NIL; + return _o_result; + } + } + t = Heap_FetchAddress(adr + 8); + if (t >= blksz) { + break; + } + prev = adr; + adr = Heap_FetchAddress(adr + 24); + } + restsize = t - blksz; + end = adr + restsize; + __PUT(end + 8, blksz, LONGINT); + __PUT(end + 16, -8, LONGINT); + __PUT(end, end + 8, LONGINT); + if (restsize > 288) { + __PUT(adr + 8, restsize, LONGINT); + } else { + next = Heap_FetchAddress(adr + 24); + if (prev == 0) { + Heap_bigBlocks = next; + } else { + __PUT(prev + 24, next, LONGINT); + } + if (restsize > 0) { + di = __ASHR(restsize, 5); + __PUT(adr + 8, restsize, LONGINT); + __PUT(adr + 24, Heap_freeList[di], LONGINT); + Heap_freeList[di] = adr; + } + } + adr += restsize; + } + i = adr + 32; + end = adr + blksz; + while (i < end) { + __PUT(i, 0, LONGINT); + __PUT(i + 8, 0, LONGINT); + __PUT(i + 16, 0, LONGINT); + __PUT(i + 24, 0, LONGINT); + i += 32; + } + __PUT(adr + 24, 0, LONGINT); + __PUT(adr, tag, LONGINT); + __PUT(adr + 8, 0, LONGINT); + __PUT(adr + 16, 0, LONGINT); + Heap_allocated += blksz; + Heap_Unlock(); + _o_result = (SYSTEM_PTR)(uintptr_t)(adr + 8); + return _o_result; +} + +SYSTEM_PTR Heap_NEWBLK (LONGINT size) +{ + SYSTEM_PTR _o_result; + LONGINT blksz, tag; + SYSTEM_PTR new; + Heap_Lock(); + blksz = __ASHL(__ASHR(size + 63, 5), 5); + new = Heap_NEWREC((LONGINT)(uintptr_t)&blksz); + tag = ((LONGINT)(uintptr_t)new + blksz) - 24; + __PUT(tag - 8, 0, LONGINT); + __PUT(tag, blksz, LONGINT); + __PUT(tag + 8, -8, LONGINT); + __PUT((LONGINT)(uintptr_t)new - 8, tag, LONGINT); + Heap_Unlock(); + _o_result = new; + return _o_result; +} + +static void Heap_Mark (LONGINT q) +{ + LONGINT p, tag, fld, n, offset, tagbits; + if (q != 0) { + tagbits = Heap_FetchAddress(q - 8); + if (!__ODD(tagbits)) { + __PUT(q - 8, tagbits + 1, LONGINT); + p = 0; + tag = tagbits + 8; + for (;;) { + __GET(tag, offset, LONGINT); + if (offset < 0) { + __PUT(q - 8, (tag + offset) + 1, LONGINT); + if (p == 0) { + break; + } + n = q; + q = p; + tag = Heap_FetchAddress(q - 8); + tag -= 1; + __GET(tag, offset, LONGINT); + fld = q + offset; + p = Heap_FetchAddress(fld); + __PUT(fld, (SYSTEM_PTR)(uintptr_t)n, SYSTEM_PTR); + } else { + fld = q + offset; + n = Heap_FetchAddress(fld); + if (n != 0) { + tagbits = Heap_FetchAddress(n - 8); + if (!__ODD(tagbits)) { + __PUT(n - 8, tagbits + 1, LONGINT); + __PUT(q - 8, tag + 1, LONGINT); + __PUT(fld, (SYSTEM_PTR)(uintptr_t)p, SYSTEM_PTR); + p = q; + q = n; + tag = tagbits; + } + } + } + tag += 8; + } + } + } +} + +static void Heap_MarkP (SYSTEM_PTR p) +{ + Heap_Mark((LONGINT)(uintptr_t)p); +} + +static void Heap_Scan (void) +{ + LONGINT chnk, adr, end, start, tag, i, size, freesize; + Heap_bigBlocks = 0; + i = 1; + while (i < 9) { + Heap_freeList[i] = 0; + i += 1; + } + freesize = 0; + Heap_allocated = 0; + chnk = Heap_heap; + while (chnk != 0) { + adr = chnk + 24; + end = Heap_FetchAddress(chnk + 8); + while (adr < end) { + tag = Heap_FetchAddress(adr); + if (__ODD(tag)) { + if (freesize > 0) { + start = adr - freesize; + __PUT(start, start + 8, LONGINT); + __PUT(start + 8, freesize, LONGINT); + __PUT(start + 16, -8, LONGINT); + i = __ASHR(freesize, 5); + freesize = 0; + if (i < 9) { + __PUT(start + 24, Heap_freeList[i], LONGINT); + Heap_freeList[i] = start; + } else { + __PUT(start + 24, Heap_bigBlocks, LONGINT); + Heap_bigBlocks = start; + } + } + tag -= 1; + __PUT(adr, tag, LONGINT); + size = Heap_FetchAddress(tag); + Heap_allocated += size; + adr += size; + } else { + size = Heap_FetchAddress(tag); + freesize += size; + adr += size; + } + } + if (freesize > 0) { + start = adr - freesize; + __PUT(start, start + 8, LONGINT); + __PUT(start + 8, freesize, LONGINT); + __PUT(start + 16, -8, LONGINT); + i = __ASHR(freesize, 5); + freesize = 0; + if (i < 9) { + __PUT(start + 24, Heap_freeList[i], LONGINT); + Heap_freeList[i] = start; + } else { + __PUT(start + 24, Heap_bigBlocks, LONGINT); + Heap_bigBlocks = start; + } + } + chnk = Heap_FetchAddress(chnk); + } +} + +static void Heap_Sift (LONGINT l, LONGINT r, LONGINT *a, LONGINT a__len) +{ + LONGINT i, j, x; + j = l; + x = a[j]; + for (;;) { + i = j; + j = __ASHL(j, 1) + 1; + if ((j < r && a[j] < a[j + 1])) { + j += 1; + } + if (j > r || a[j] <= x) { + break; + } + a[i] = a[j]; + } + a[i] = x; +} + +static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len) +{ + LONGINT l, r, x; + l = __ASHR(n, 1); + r = n - 1; + while (l > 0) { + l -= 1; + Heap_Sift(l, r, (void*)a, a__len); + } + while (r > 0) { + x = a[0]; + a[0] = a[r]; + a[r] = x; + r -= 1; + Heap_Sift(l, r, (void*)a, a__len); + } +} + +static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len) +{ + LONGINT chnk, adr, tag, next, lim, lim1, i, ptr, size; + chnk = Heap_heap; + i = 0; + lim = cand[n - 1]; + while ((chnk != 0 && chnk < lim)) { + adr = chnk + 24; + lim1 = Heap_FetchAddress(chnk + 8); + if (lim < lim1) { + lim1 = lim; + } + while (adr < lim1) { + tag = Heap_FetchAddress(adr); + if (__ODD(tag)) { + size = Heap_FetchAddress(tag - 1); + adr += size; + } else { + size = Heap_FetchAddress(tag); + ptr = adr + 8; + while (cand[i] < ptr) { + i += 1; + } + if (i == n) { + return; + } + next = adr + size; + if (cand[i] < next) { + Heap_Mark(ptr); + } + adr = next; + } + } + chnk = Heap_FetchAddress(chnk); + } +} + +static void Heap_CheckFin (void) +{ + Heap_FinNode n; + LONGINT tag; + n = Heap_fin; + while (n != NIL) { + tag = Heap_FetchAddress(n->obj - 8); + if (!__ODD(tag)) { + n->marked = 0; + Heap_Mark(n->obj); + } else { + n->marked = 1; + } + n = n->next; + } +} + +static void Heap_Finalize (void) +{ + Heap_FinNode n, prev; + n = Heap_fin; + prev = NIL; + while (n != NIL) { + if (!n->marked) { + if (n == Heap_fin) { + Heap_fin = Heap_fin->next; + } else { + prev->next = n->next; + } + (*n->finalize)((SYSTEM_PTR)(uintptr_t)n->obj); + if (prev == NIL) { + n = Heap_fin; + } else { + n = n->next; + } + } else { + prev = n; + n = n->next; + } + } +} + +void Heap_FINALL (void) +{ + Heap_FinNode n; + while (Heap_fin != NIL) { + n = Heap_fin; + Heap_fin = Heap_fin->next; + (*n->finalize)((SYSTEM_PTR)(uintptr_t)n->obj); + } +} + +static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len) +{ + SYSTEM_PTR frame; + LONGINT inc, nofcand, sp, p, stack0, ptr; + struct Heap__1 align; + if (n > 0) { + Heap_MarkStack(n - 1, cand, cand__len); + if (n > 100) { + return; + } + } + if (n == 0) { + nofcand = 0; + sp = (LONGINT)(uintptr_t)&frame; + stack0 = Heap_PlatformMainStackFrame(); + inc = (LONGINT)(uintptr_t)&align.p - (LONGINT)(uintptr_t)&align; + if (sp > stack0) { + inc = -inc; + } + while (sp != stack0) { + __GET(sp, p, LONGINT); + if ((p > Heap_heap && p < Heap_heapend)) { + if (nofcand == cand__len) { + Heap_HeapSort(nofcand, (void*)cand, cand__len); + Heap_MarkCandidates(nofcand, (void*)cand, cand__len); + nofcand = 0; + } + cand[nofcand] = p; + nofcand += 1; + } + sp += inc; + } + if (nofcand > 0) { + Heap_HeapSort(nofcand, (void*)cand, cand__len); + Heap_MarkCandidates(nofcand, (void*)cand, cand__len); + } + } +} + +void Heap_GC (BOOLEAN markStack) +{ + Heap_Module m; + LONGINT i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23; + LONGINT cand[10000]; + if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) { + Heap_Lock(); + m = (Heap_Module)(uintptr_t)Heap_modules; + while (m != NIL) { + if (m->enumPtrs != NIL) { + (*m->enumPtrs)(Heap_MarkP); + } + m = m->next; + } + if (markStack) { + i0 = -100; + i1 = -101; + i2 = -102; + i3 = -103; + i4 = -104; + i5 = -105; + i6 = -106; + i7 = -107; + i8 = 1; + i9 = 2; + i10 = 3; + i11 = 4; + i12 = 5; + i13 = 6; + i14 = 7; + i15 = 8; + i16 = 9; + i17 = 10; + i18 = 11; + i19 = 12; + i20 = 13; + i21 = 14; + i22 = 15; + i23 = 16; + for (;;) { + i0 += 1; + i1 += 2; + i2 += 3; + i3 += 4; + i4 += 5; + i5 += 6; + i6 += 7; + i7 += 8; + i8 += 9; + i9 += 10; + i10 += 11; + i11 += 12; + i12 += 13; + i13 += 14; + i14 += 15; + i15 += 16; + i16 += 17; + i17 += 18; + i18 += 19; + i19 += 20; + i20 += 21; + i21 += 22; + i22 += 23; + i23 += 24; + if ((i0 == -99 && i15 == 24)) { + Heap_MarkStack(((LONGINT)(32)), (void*)cand, ((LONGINT)(10000))); + break; + } + } + if (((((((((((((((((((((((i0 + i1) + i2) + i3) + i4) + i5) + i6) + i7) + i8) + i9) + i10) + i11) + i12) + i13) + i14) + i15) + i16) + i17) + i18) + i19) + i20) + i21) + i22) + i23 > 10000) { + return; + } + } + Heap_CheckFin(); + Heap_Scan(); + Heap_Finalize(); + Heap_Unlock(); + } +} + +void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize) +{ + Heap_FinNode f; + __NEW(f, Heap_FinDesc); + f->obj = (LONGINT)(uintptr_t)obj; + f->finalize = finalize; + f->marked = 1; + f->next = Heap_fin; + Heap_fin = f; +} + +void Heap_InitHeap (void) +{ + Heap_heap = Heap_NewChunk(((LONGINT)(256000))); + Heap_heapend = Heap_FetchAddress(Heap_heap + 8); + __PUT(Heap_heap, 0, LONGINT); + Heap_allocated = 0; + Heap_firstTry = 1; + Heap_freeList[9] = 1; + Heap_lockdepth = 0; + Heap_FileCount = 0; + Heap_modules = NIL; + Heap_heapsize = 0; + Heap_bigBlocks = 0; + Heap_fin = NIL; + Heap_interrupted = 0; + Heap_HeapModuleInit(); +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(Heap_modules); + P(Heap_fin); +} + +__TDESC(Heap_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 80), {0, 40, -24}}; +__TDESC(Heap_CmdDesc, 1, 1) = {__TDFLDS("CmdDesc", 40), {0, -16}}; +__TDESC(Heap_FinDesc, 1, 1) = {__TDFLDS("FinDesc", 32), {0, -16}}; +__TDESC(Heap__1, 1, 1) = {__TDFLDS("", 16), {8, -16}}; + +export void *Heap__init(void) +{ + __DEFMOD; + __REGMOD("Heap", EnumPtrs); + __REGCMD("FINALL", Heap_FINALL); + __REGCMD("InitHeap", Heap_InitHeap); + __REGCMD("Lock", Heap_Lock); + __REGCMD("Unlock", Heap_Unlock); + __INITYP(Heap_ModuleDesc, Heap_ModuleDesc, 0); + __INITYP(Heap_CmdDesc, Heap_CmdDesc, 0); + __INITYP(Heap_FinDesc, Heap_FinDesc, 0); + __INITYP(Heap__1, Heap__1, 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-88/Heap.h b/bootstrap/unix-88/Heap.h new file mode 100644 index 00000000..1b23ddb3 --- /dev/null +++ b/bootstrap/unix-88/Heap.h @@ -0,0 +1,55 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tskSfF */ + +#ifndef Heap__h +#define Heap__h + +#define LARGE +#include "SYSTEM.h" + +typedef + CHAR Heap_CmdName[24]; + +typedef + void (*Heap_Command)(void); + +typedef + void (*Heap_EnumProc)(void(*)(SYSTEM_PTR)); + +typedef + void (*Heap_Finalizer)(SYSTEM_PTR); + +typedef + struct Heap_ModuleDesc *Heap_Module; + +typedef + struct Heap_ModuleDesc { + LONGINT _prvt0; + char _prvt1[72]; + } Heap_ModuleDesc; + +typedef + CHAR Heap_ModuleName[20]; + + +import SYSTEM_PTR Heap_modules; +import LONGINT Heap_allocated, Heap_heapsize; +import INTEGER Heap_FileCount; + +import LONGINT *Heap_ModuleDesc__typ; + +import void Heap_FINALL (void); +import void Heap_GC (BOOLEAN markStack); +import void Heap_INCREF (Heap_Module m); +import void Heap_InitHeap (void); +import void Heap_Lock (void); +import SYSTEM_PTR Heap_NEWBLK (LONGINT size); +import SYSTEM_PTR Heap_NEWREC (LONGINT tag); +import void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd); +import SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs); +import void Heap_REGTYP (Heap_Module m, LONGINT typ); +import void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize); +import void Heap_Unlock (void); +import void *Heap__init(void); + + +#endif diff --git a/bootstrap/unix-88/Modules.c b/bootstrap/unix-88/Modules.c new file mode 100644 index 00000000..77278391 --- /dev/null +++ b/bootstrap/unix-88/Modules.c @@ -0,0 +1,172 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "Console.h" +#include "Heap.h" + +typedef + struct Modules_CmdDesc *Modules_Cmd; + +typedef + void (*Modules_Command)(void); + +typedef + struct Modules_CmdDesc { + Modules_Cmd next; + CHAR name[24]; + Modules_Command cmd; + } Modules_CmdDesc; + +typedef + struct Modules_ModuleDesc *Modules_Module; + +typedef + CHAR Modules_ModuleName[20]; + +typedef + struct Modules_ModuleDesc { + Modules_Module next; + Modules_ModuleName name; + LONGINT refcnt; + Modules_Cmd cmds; + LONGINT types; + void (*enumPtrs)(void(*)(LONGINT)); + LONGINT reserved1, reserved2; + } Modules_ModuleDesc; + + +export INTEGER Modules_res; +export CHAR Modules_resMsg[256]; +export Modules_ModuleName Modules_imported, Modules_importing; + +export LONGINT *Modules_ModuleDesc__typ; +export LONGINT *Modules_CmdDesc__typ; + +static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len); +export void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all); +export Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len); +export Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len); + +#define Modules_modules() (Modules_Module)Heap_modules +#define Modules_setmodules(m) Heap_modules = m + +static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len) +{ + INTEGER i, j; + __DUP(b, b__len, CHAR); + i = 0; + while (a[__X(i, a__len)] != 0x00) { + i += 1; + } + j = 0; + while (b[__X(j, b__len)] != 0x00) { + a[__X(i, a__len)] = b[__X(j, b__len)]; + i += 1; + j += 1; + } + a[__X(i, a__len)] = 0x00; + __DEL(b); +} + +Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len) +{ + Modules_Module _o_result; + Modules_Module m = NIL; + CHAR bodyname[64]; + Modules_Command body; + __DUP(name, name__len, CHAR); + m = Modules_modules(); + while ((m != NIL && __STRCMP(m->name, name) != 0)) { + m = m->next; + } + if (m != NIL) { + Modules_res = 0; + Modules_resMsg[0] = 0x00; + } else { + Modules_res = 1; + __COPY(name, Modules_importing, ((LONGINT)(20))); + __MOVE(" module \"", Modules_resMsg, 10); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), name, name__len); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)"\" not found", (LONGINT)12); + } + _o_result = m; + __DEL(name); + return _o_result; +} + +Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len) +{ + Modules_Command _o_result; + Modules_Cmd c = NIL; + __DUP(name, name__len, CHAR); + c = mod->cmds; + while ((c != NIL && __STRCMP(c->name, name) != 0)) { + c = c->next; + } + if (c != NIL) { + Modules_res = 0; + Modules_resMsg[0] = 0x00; + _o_result = c->cmd; + __DEL(name); + return _o_result; + } else { + Modules_res = 2; + __MOVE(" command \"", Modules_resMsg, 11); + __COPY(name, Modules_importing, ((LONGINT)(20))); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), mod->name, ((LONGINT)(20))); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)".", (LONGINT)2); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), name, name__len); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)"\" not found", (LONGINT)12); + _o_result = NIL; + __DEL(name); + return _o_result; + } + __RETCHK; +} + +void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all) +{ + Modules_Module m = NIL, p = NIL; + __DUP(name, name__len, CHAR); + m = Modules_modules(); + if (all) { + Modules_res = 1; + __MOVE("unloading \"all\" not yet supported", Modules_resMsg, 34); + } else { + while ((m != NIL && __STRCMP(m->name, name) != 0)) { + p = m; + m = m->next; + } + if ((m != NIL && m->refcnt == 0)) { + if (m == Modules_modules()) { + Modules_setmodules(m->next); + } else { + p->next = m->next; + } + Modules_res = 0; + } else { + Modules_res = 1; + if (m == NIL) { + __MOVE("module not found", Modules_resMsg, 17); + } else { + __MOVE("clients of this module exist", Modules_resMsg, 29); + } + } + } + __DEL(name); +} + +__TDESC(Modules_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 80), {0, 40, -24}}; +__TDESC(Modules_CmdDesc, 1, 1) = {__TDFLDS("CmdDesc", 40), {0, -16}}; + +export void *Modules__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Console); + __MODULE_IMPORT(Heap); + __REGMOD("Modules", 0); + __INITYP(Modules_ModuleDesc, Modules_ModuleDesc, 0); + __INITYP(Modules_CmdDesc, Modules_CmdDesc, 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-88/Modules.h b/bootstrap/unix-88/Modules.h new file mode 100644 index 00000000..88bb46e1 --- /dev/null +++ b/bootstrap/unix-88/Modules.h @@ -0,0 +1,55 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Modules__h +#define Modules__h + +#define LARGE +#include "SYSTEM.h" + +typedef + struct Modules_CmdDesc *Modules_Cmd; + +typedef + void (*Modules_Command)(void); + +typedef + struct Modules_CmdDesc { + Modules_Cmd next; + CHAR name[24]; + Modules_Command cmd; + } Modules_CmdDesc; + +typedef + struct Modules_ModuleDesc *Modules_Module; + +typedef + CHAR Modules_ModuleName[20]; + +typedef + struct Modules_ModuleDesc { + Modules_Module next; + Modules_ModuleName name; + LONGINT refcnt; + Modules_Cmd cmds; + LONGINT types; + void (*enumPtrs)(void(*)(LONGINT)); + char _prvt0[16]; + } Modules_ModuleDesc; + + +import INTEGER Modules_res; +import CHAR Modules_resMsg[256]; +import Modules_ModuleName Modules_imported, Modules_importing; + +import LONGINT *Modules_ModuleDesc__typ; +import LONGINT *Modules_CmdDesc__typ; + +import void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all); +import Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len); +import Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len); +import void *Modules__init(void); + +#define Modules_modules() (Modules_Module)Heap_modules +#define Modules_setmodules(m) Heap_modules = m + +#endif diff --git a/bootstrap/unix-88/OPB.c b/bootstrap/unix-88/OPB.c new file mode 100644 index 00000000..428d0881 --- /dev/null +++ b/bootstrap/unix-88/OPB.c @@ -0,0 +1,2678 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "OPM.h" +#include "OPS.h" +#include "OPT.h" + + +export void (*OPB_typSize)(OPT_Struct); +static INTEGER OPB_exp; +static LONGINT OPB_maxExp; + + +export void OPB_Assign (OPT_Node *x, OPT_Node y); +static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node y); +static LONGINT OPB_BoolToInt (BOOLEAN b); +export void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp); +static void OPB_CharToString (OPT_Node n); +static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode); +static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo); +export void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames); +static void OPB_CheckProc (OPT_Struct x, OPT_Object y); +static void OPB_CheckPtr (OPT_Node x, OPT_Node y); +static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x); +static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp); +static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y); +export void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y); +static void OPB_Convert (OPT_Node *x, OPT_Struct typ); +export void OPB_DeRef (OPT_Node *x); +static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar); +export OPT_Node OPB_EmptySet (void); +export void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc); +export void OPB_Field (OPT_Node *x, OPT_Object y); +export void OPB_In (OPT_Node *x, OPT_Node y); +export void OPB_Index (OPT_Node *x, OPT_Node y); +export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ); +static BOOLEAN OPB_IntToBool (LONGINT i); +export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y); +export void OPB_MOp (SHORTINT op, OPT_Node *x); +export OPT_Node OPB_NewBoolConst (BOOLEAN boolval); +export OPT_Node OPB_NewIntConst (LONGINT intval); +export OPT_Node OPB_NewLeaf (OPT_Object obj); +export OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ); +export OPT_Node OPB_NewString (OPS_String str, LONGINT len); +export OPT_Node OPB_Nil (void); +static BOOLEAN OPB_NotVar (OPT_Node x); +export void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y); +export void OPB_OptIf (OPT_Node *x); +export void OPB_Param (OPT_Node ap, OPT_Object fp); +export void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar); +export void OPB_Return (OPT_Node *x, OPT_Object proc); +export void OPB_SetElem (OPT_Node *x); +static void OPB_SetIntType (OPT_Node node); +export void OPB_SetRange (OPT_Node *x, OPT_Node y); +export void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno); +export void OPB_StPar0 (OPT_Node *par0, INTEGER fctno); +export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno); +export void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n); +export void OPB_StaticLink (SHORTINT dlev); +export void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard); +static void OPB_err (INTEGER n); +static LONGINT OPB_log (LONGINT x); + + +static void OPB_err (INTEGER n) +{ + OPM_err(n); +} + +OPT_Node OPB_NewLeaf (OPT_Object obj) +{ + OPT_Node _o_result; + OPT_Node node = NIL; + switch (obj->mode) { + case 1: + node = OPT_NewNode(0); + node->readonly = (obj->vis == 2 && obj->mnolev < 0); + break; + case 2: + node = OPT_NewNode(1); + break; + case 3: + node = OPT_NewNode(7); + node->conval = OPT_NewConst(); + __GUARDEQP(node->conval, OPT_ConstDesc) = *obj->conval; + break; + case 5: + node = OPT_NewNode(8); + break; + case 6: case 7: case 8: case 9: case 10: + node = OPT_NewNode(9); + break; + default: + OPB_err(127); + node = OPT_NewNode(0); + break; + } + node->obj = obj; + node->typ = obj->typ; + _o_result = node; + return _o_result; +} + +void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y) +{ + OPT_Node node = NIL; + node = OPT_NewNode(class); + node->typ = OPT_notyp; + node->left = *x; + node->right = y; + *x = node; +} + +void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y) +{ + if (*x == NIL) { + *x = y; + } else { + (*last)->link = y; + } + while (y->link != NIL) { + y = y->link; + } + *last = y; +} + +static LONGINT OPB_BoolToInt (BOOLEAN b) +{ + LONGINT _o_result; + if (b) { + _o_result = 1; + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +static BOOLEAN OPB_IntToBool (LONGINT i) +{ + BOOLEAN _o_result; + if (i == 0) { + _o_result = 0; + return _o_result; + } else { + _o_result = 1; + return _o_result; + } + __RETCHK; +} + +OPT_Node OPB_NewBoolConst (BOOLEAN boolval) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->typ = OPT_booltyp; + x->conval = OPT_NewConst(); + x->conval->intval = OPB_BoolToInt(boolval); + _o_result = x; + return _o_result; +} + +void OPB_OptIf (OPT_Node *x) +{ + OPT_Node if_ = NIL, pred = NIL; + if_ = (*x)->left; + while (if_->left->class == 7) { + if (OPB_IntToBool(if_->left->conval->intval)) { + *x = if_->right; + return; + } else if (if_->link == NIL) { + *x = (*x)->right; + return; + } else { + if_ = if_->link; + (*x)->left = if_; + } + } + pred = if_; + if_ = if_->link; + while (if_ != NIL) { + if (if_->left->class == 7) { + if (OPB_IntToBool(if_->left->conval->intval)) { + pred->link = NIL; + (*x)->right = if_->right; + return; + } else { + if_ = if_->link; + pred->link = if_; + } + } else { + pred = if_; + if_ = if_->link; + } + } +} + +OPT_Node OPB_Nil (void) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->typ = OPT_niltyp; + x->conval = OPT_NewConst(); + x->conval->intval = 0; + _o_result = x; + return _o_result; +} + +OPT_Node OPB_EmptySet (void) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->typ = OPT_settyp; + x->conval = OPT_NewConst(); + x->conval->setval = 0x0; + _o_result = x; + return _o_result; +} + +static void OPB_SetIntType (OPT_Node node) +{ + LONGINT v; + v = node->conval->intval; + if ((OPM_MinSInt <= (LONGINT)v && (LONGINT)v <= OPM_MaxSInt)) { + node->typ = OPT_sinttyp; + } else if ((OPM_MinInt <= (LONGINT)v && (LONGINT)v <= OPM_MaxInt)) { + node->typ = OPT_inttyp; + } else if ((OPM_MinLInt <= v && v <= OPM_MaxLInt)) { + node->typ = OPT_linttyp; + } else { + OPB_err(203); + node->typ = OPT_sinttyp; + node->conval->intval = 1; + } +} + +OPT_Node OPB_NewIntConst (LONGINT intval) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->conval = OPT_NewConst(); + x->conval->intval = intval; + OPB_SetIntType(x); + _o_result = x; + return _o_result; +} + +OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->conval = OPT_NewConst(); + x->conval->realval = realval; + x->typ = typ; + x->conval->intval = -1; + _o_result = x; + return _o_result; +} + +OPT_Node OPB_NewString (OPS_String str, LONGINT len) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->conval = OPT_NewConst(); + x->typ = OPT_stringtyp; + x->conval->intval = -1; + x->conval->intval2 = len; + x->conval->ext = OPT_NewExt(); + __COPY(str, *x->conval->ext, ((LONGINT)(256))); + _o_result = x; + return _o_result; +} + +static void OPB_CharToString (OPT_Node n) +{ + CHAR ch; + n->typ = OPT_stringtyp; + ch = (CHAR)n->conval->intval; + n->conval->ext = OPT_NewExt(); + if (ch == 0x00) { + n->conval->intval2 = 1; + } else { + n->conval->intval2 = 2; + (*n->conval->ext)[1] = 0x00; + } + (*n->conval->ext)[0] = ch; + n->conval->intval = -1; + n->obj = NIL; +} + +static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node y) +{ + OPT_Node node = NIL; + node = OPT_NewNode(class); + node->typ = typ; + node->left = *x; + node->right = y; + *x = node; +} + +static BOOLEAN OPB_NotVar (OPT_Node x) +{ + BOOLEAN _o_result; + _o_result = (x->class >= 7 && ((x->class != 11 || x->subcl != 29) || x->left->class >= 7)); + return _o_result; +} + +void OPB_DeRef (OPT_Node *x) +{ + OPT_Object strobj = NIL, bstrobj = NIL; + OPT_Struct typ = NIL, btyp = NIL; + typ = (*x)->typ; + if ((*x)->class >= 7) { + OPB_err(78); + } else if (typ->form == 13) { + if (typ == OPT_sysptrtyp) { + OPB_err(57); + } + btyp = typ->BaseTyp; + strobj = typ->strobj; + bstrobj = btyp->strobj; + if ((((((strobj != NIL && strobj->name[0] != 0x00)) && bstrobj != NIL)) && bstrobj->name[0] != 0x00)) { + btyp->pbused = 1; + } + OPB_BindNodes(3, btyp, &*x, NIL); + } else { + OPB_err(84); + } +} + +void OPB_Index (OPT_Node *x, OPT_Node y) +{ + INTEGER f; + OPT_Struct typ = NIL; + f = y->typ->form; + if ((*x)->class >= 7) { + OPB_err(79); + } else if (!__IN(f, 0x70) || __IN(y->class, 0x0300)) { + OPB_err(80); + y->typ = OPT_inttyp; + } + if ((*x)->typ->comp == 2) { + typ = (*x)->typ->BaseTyp; + if ((y->class == 7 && (y->conval->intval < 0 || y->conval->intval >= (*x)->typ->n))) { + OPB_err(81); + } + } else if ((*x)->typ->comp == 3) { + typ = (*x)->typ->BaseTyp; + if ((y->class == 7 && y->conval->intval < 0)) { + OPB_err(81); + } + } else { + OPB_err(82); + typ = OPT_undftyp; + } + OPB_BindNodes(4, typ, &*x, y); + (*x)->readonly = (*x)->left->readonly; +} + +void OPB_Field (OPT_Node *x, OPT_Object y) +{ + if ((*x)->class >= 7) { + OPB_err(77); + } + if ((y != NIL && __IN(y->mode, 0x2010))) { + OPB_BindNodes(2, y->typ, &*x, NIL); + (*x)->obj = y; + (*x)->readonly = (*x)->left->readonly || (y->vis == 2 && y->mnolev < 0); + } else { + OPB_err(83); + (*x)->typ = OPT_undftyp; + } +} + +static struct TypTest__57 { + OPT_Node *x; + OPT_Object *obj; + BOOLEAN *guard; + struct TypTest__57 *lnk; +} *TypTest__57_s; + +static void GTT__58 (OPT_Struct t0, OPT_Struct t1); + +static void GTT__58 (OPT_Struct t0, OPT_Struct t1) +{ + OPT_Node node = NIL; + OPT_Struct t = NIL; + t = t0; + while ((((t != NIL && t != t1)) && t != OPT_undftyp)) { + t = t->BaseTyp; + } + if (t != t1) { + while ((((t1 != NIL && t1 != t0)) && t1 != OPT_undftyp)) { + t1 = t1->BaseTyp; + } + if (t1 == t0 || t0->form == 0) { + if (*TypTest__57_s->guard) { + OPB_BindNodes(5, NIL, &*TypTest__57_s->x, NIL); + (*TypTest__57_s->x)->readonly = (*TypTest__57_s->x)->left->readonly; + } else { + node = OPT_NewNode(11); + node->subcl = 16; + node->left = *TypTest__57_s->x; + node->obj = *TypTest__57_s->obj; + *TypTest__57_s->x = node; + } + } else { + OPB_err(85); + } + } else if (t0 != t1) { + OPB_err(85); + } else if (!*TypTest__57_s->guard) { + if ((*TypTest__57_s->x)->class == 5) { + node = OPT_NewNode(11); + node->subcl = 16; + node->left = *TypTest__57_s->x; + node->obj = *TypTest__57_s->obj; + *TypTest__57_s->x = node; + } else { + *TypTest__57_s->x = OPB_NewBoolConst(1); + } + } +} + +void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard) +{ + struct TypTest__57 _s; + _s.x = x; + _s.obj = &obj; + _s.guard = &guard; + _s.lnk = TypTest__57_s; + TypTest__57_s = &_s; + if (OPB_NotVar(*x)) { + OPB_err(112); + } else if ((*x)->typ->form == 13) { + if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) { + OPB_err(85); + } else if (obj->typ->form == 13) { + GTT__58((*x)->typ->BaseTyp, obj->typ->BaseTyp); + } else { + OPB_err(86); + } + } else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) { + GTT__58((*x)->typ, obj->typ); + } else { + OPB_err(87); + } + if (guard) { + (*x)->typ = obj->typ; + } else { + (*x)->typ = OPT_booltyp; + } + TypTest__57_s = _s.lnk; +} + +void OPB_In (OPT_Node *x, OPT_Node y) +{ + INTEGER f; + LONGINT k; + f = (*x)->typ->form; + if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) { + OPB_err(126); + } else if ((__IN(f, 0x70) && y->typ->form == 9)) { + if ((*x)->class == 7) { + k = (*x)->conval->intval; + if (k < 0 || k > (LONGINT)OPM_MaxSet) { + OPB_err(202); + } else if (y->class == 7) { + (*x)->conval->intval = OPB_BoolToInt(__IN(k, y->conval->setval)); + (*x)->obj = NIL; + } else { + OPB_BindNodes(12, OPT_booltyp, &*x, y); + (*x)->subcl = 15; + } + } else { + OPB_BindNodes(12, OPT_booltyp, &*x, y); + (*x)->subcl = 15; + } + } else { + OPB_err(92); + } + (*x)->typ = OPT_booltyp; +} + +static LONGINT OPB_log (LONGINT x) +{ + LONGINT _o_result; + OPB_exp = 0; + if (x > 0) { + while (!__ODD(x)) { + x = __ASHR(x, 1); + OPB_exp += 1; + } + } + _o_result = x; + return _o_result; +} + +static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x) +{ + LONGREAL min, max, r; + if (f == 7) { + min = OPM_MinReal; + max = OPM_MaxReal; + } else { + min = OPM_MinLReal; + max = OPM_MaxLReal; + } + r = __ABS(x->realval); + if (r > max || r < min) { + OPB_err(nr); + x->realval = (LONGREAL)1; + } else if (f == 7) { + x->realval = x->realval; + } + x->intval = -1; +} + +static struct MOp__28 { + struct MOp__28 *lnk; +} *MOp__28_s; + +static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z); + +static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z) +{ + OPT_Node _o_result; + OPT_Node node = NIL; + node = OPT_NewNode(11); + node->subcl = op; + node->typ = typ; + node->left = z; + _o_result = node; + return _o_result; +} + +void OPB_MOp (SHORTINT op, OPT_Node *x) +{ + INTEGER f; + OPT_Struct typ = NIL; + OPT_Node z = NIL; + struct MOp__28 _s; + _s.lnk = MOp__28_s; + MOp__28_s = &_s; + z = *x; + if (z->class == 8 || z->class == 9) { + OPB_err(126); + } else { + typ = z->typ; + f = typ->form; + switch (op) { + case 33: + if (f == 2) { + if (z->class == 7) { + z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval)); + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(98); + } + break; + case 6: + if (!__IN(f, 0x01f0)) { + OPB_err(96); + } + break; + case 7: + if (__IN(f, 0x03f0)) { + if (z->class == 7) { + if (__IN(f, 0x70)) { + if (z->conval->intval == (-9223372036854775807-1)) { + OPB_err(203); + } else { + z->conval->intval = -z->conval->intval; + OPB_SetIntType(z); + } + } else if (__IN(f, 0x0180)) { + z->conval->realval = -z->conval->realval; + } else { + z->conval->setval = ~z->conval->setval; + } + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(97); + } + break; + case 21: + if (__IN(f, 0x01f0)) { + if (z->class == 7) { + if (__IN(f, 0x70)) { + if (z->conval->intval == (-9223372036854775807-1)) { + OPB_err(203); + } else { + z->conval->intval = __ABS(z->conval->intval); + OPB_SetIntType(z); + } + } else { + z->conval->realval = __ABS(z->conval->realval); + } + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(111); + } + break; + case 22: + if (f == 3) { + if (z->class == 7) { + z->conval->intval = (int)__CAP((CHAR)z->conval->intval); + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(111); + z->typ = OPT_chartyp; + } + break; + case 23: + if (__IN(f, 0x70)) { + if (z->class == 7) { + z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval)); + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(111); + } + z->typ = OPT_booltyp; + break; + case 24: + if ((((z->class == 7 && f == 3)) && z->conval->intval >= 32)) { + OPB_CharToString(z); + f = 10; + } + if (z->class < 7 || f == 10) { + z = NewOp__29(op, typ, z); + } else { + OPB_err(127); + } + z->typ = OPT_linttyp; + break; + case 25: + if ((__IN(f, 0x70) && z->class == 7)) { + if ((0 <= z->conval->intval && z->conval->intval <= -1)) { + z = NewOp__29(op, typ, z); + } else { + OPB_err(219); + } + } else { + OPB_err(69); + } + z->typ = OPT_booltyp; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.MOp, op = ", (LONGINT)33); + OPM_LogWNum(op, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } + *x = z; + MOp__28_s = _s.lnk; +} + +static void OPB_CheckPtr (OPT_Node x, OPT_Node y) +{ + INTEGER g; + OPT_Struct p = NIL, q = NIL, t = NIL; + g = y->typ->form; + if (g == 13) { + p = x->typ->BaseTyp; + q = y->typ->BaseTyp; + if ((p->comp == 4 && q->comp == 4)) { + if (p->extlev < q->extlev) { + t = p; + p = q; + q = t; + } + while ((((p != q && p != NIL)) && p != OPT_undftyp)) { + p = p->BaseTyp; + } + if (p == NIL) { + OPB_err(100); + } + } else { + OPB_err(100); + } + } else if (g != 11) { + OPB_err(100); + } +} + +void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames) +{ + OPT_Struct ft = NIL, at = NIL; + while (fp != NIL) { + if (ap != NIL) { + ft = fp->typ; + at = ap->typ; + while ((ft->comp == 3 && at->comp == 3)) { + ft = ft->BaseTyp; + at = at->BaseTyp; + } + if (ft != at) { + if ((ft->form == 14 && at->form == 14)) { + if (ft->BaseTyp == at->BaseTyp) { + OPB_CheckParameters(ft->link, at->link, 0); + } else { + OPB_err(117); + } + } else { + OPB_err(115); + } + } + if (fp->mode != ap->mode || (checkNames && __STRCMP(fp->name, ap->name) != 0)) { + OPB_err(115); + } + ap = ap->link; + } else { + OPB_err(116); + } + fp = fp->link; + } + if (ap != NIL) { + OPB_err(116); + } +} + +static void OPB_CheckProc (OPT_Struct x, OPT_Object y) +{ + if (__IN(y->mode, 0x04c0)) { + if (y->mode == 6) { + if (y->mnolev == 0) { + y->mode = 7; + } else { + OPB_err(73); + } + } + if (x->BaseTyp == y->typ) { + OPB_CheckParameters(x->link, y->link, 0); + } else { + OPB_err(117); + } + } else { + OPB_err(113); + } +} + +static struct ConstOp__13 { + OPT_Node *x; + INTEGER *f; + OPT_Const *xval, *yval; + struct ConstOp__13 *lnk; +} *ConstOp__13_s; + +static INTEGER ConstCmp__14 (void); + +static INTEGER ConstCmp__14 (void) +{ + INTEGER _o_result; + INTEGER res; + switch (*ConstOp__13_s->f) { + case 0: + res = 9; + break; + case 1: case 3: case 4: case 5: case 6: + if ((*ConstOp__13_s->xval)->intval < (*ConstOp__13_s->yval)->intval) { + res = 11; + } else if ((*ConstOp__13_s->xval)->intval > (*ConstOp__13_s->yval)->intval) { + res = 13; + } else { + res = 9; + } + break; + case 7: case 8: + if ((*ConstOp__13_s->xval)->realval < (*ConstOp__13_s->yval)->realval) { + res = 11; + } else if ((*ConstOp__13_s->xval)->realval > (*ConstOp__13_s->yval)->realval) { + res = 13; + } else { + res = 9; + } + break; + case 2: + if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) { + res = 10; + } else { + res = 9; + } + break; + case 9: + if ((*ConstOp__13_s->xval)->setval != (*ConstOp__13_s->yval)->setval) { + res = 10; + } else { + res = 9; + } + break; + case 10: + if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) < 0) { + res = 11; + } else if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) > 0) { + res = 13; + } else { + res = 9; + } + break; + case 11: case 13: case 14: + if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) { + res = 10; + } else { + res = 9; + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", (LONGINT)37); + OPM_LogWNum(*ConstOp__13_s->f, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + (*ConstOp__13_s->x)->typ = OPT_booltyp; + _o_result = res; + return _o_result; +} + +static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y) +{ + INTEGER f, g; + OPT_Const xval = NIL, yval = NIL; + LONGINT xv, yv; + BOOLEAN temp; + struct ConstOp__13 _s; + _s.x = &x; + _s.f = &f; + _s.xval = &xval; + _s.yval = &yval; + _s.lnk = ConstOp__13_s; + ConstOp__13_s = &_s; + f = x->typ->form; + g = y->typ->form; + xval = x->conval; + yval = y->conval; + if (f != g) { + switch (f) { + case 3: + if (g == 10) { + OPB_CharToString(x); + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 4: + if (__IN(g, 0x70)) { + x->typ = y->typ; + } else if (g == 7) { + x->typ = OPT_realtyp; + xval->realval = xval->intval; + } else if (g == 8) { + x->typ = OPT_lrltyp; + xval->realval = xval->intval; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 5: + if (g == 4) { + y->typ = OPT_inttyp; + } else if (__IN(g, 0x70)) { + x->typ = y->typ; + } else if (g == 7) { + x->typ = OPT_realtyp; + xval->realval = xval->intval; + } else if (g == 8) { + x->typ = OPT_lrltyp; + xval->realval = xval->intval; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 6: + if (__IN(g, 0x70)) { + y->typ = OPT_linttyp; + } else if (g == 7) { + x->typ = OPT_realtyp; + xval->realval = xval->intval; + } else if (g == 8) { + x->typ = OPT_lrltyp; + xval->realval = xval->intval; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 7: + if (__IN(g, 0x70)) { + y->typ = x->typ; + yval->realval = yval->intval; + } else if (g == 8) { + x->typ = OPT_lrltyp; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 8: + if (__IN(g, 0x70)) { + y->typ = x->typ; + yval->realval = yval->intval; + } else if (g == 7) { + y->typ = OPT_lrltyp; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 10: + if (g == 3) { + OPB_CharToString(y); + g = 10; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 11: + if (!__IN(g, 0x6000)) { + OPB_err(100); + } + break; + case 13: + OPB_CheckPtr(x, y); + break; + case 14: + if (g != 11) { + OPB_err(100); + } + break; + default: + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + break; + } + f = x->typ->form; + } + switch (op) { + case 1: + if (__IN(f, 0x70)) { + xv = xval->intval; + yv = yval->intval; + if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807-1))) && yv != (-9223372036854775807-1))) && -xv <= __DIV(9223372036854775807, -yv))) { + xval->intval = xv * yv; + OPB_SetIntType(x); + } else { + OPB_err(204); + } + } else if (__IN(f, 0x0180)) { + temp = __ABS(yval->realval) <= (LONGREAL)1; + if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 / (LONGREAL)__ABS(yval->realval)) { + xval->realval = xval->realval * yval->realval; + OPB_CheckRealType(f, 204, xval); + } else { + OPB_err(204); + } + } else if (f == 9) { + xval->setval = (xval->setval & yval->setval); + } else if (f != 0) { + OPB_err(101); + } + break; + case 2: + if (__IN(f, 0x70)) { + if (yval->intval != 0) { + xval->realval = xval->intval / (REAL)yval->intval; + OPB_CheckRealType(7, 205, xval); + } else { + OPB_err(205); + xval->realval = (LONGREAL)1; + } + x->typ = OPT_realtyp; + } else if (__IN(f, 0x0180)) { + temp = __ABS(yval->realval) >= (LONGREAL)1; + if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 * __ABS(yval->realval)) { + xval->realval = xval->realval / yval->realval; + OPB_CheckRealType(f, 205, xval); + } else { + OPB_err(205); + } + } else if (f == 9) { + xval->setval = xval->setval ^ yval->setval; + } else if (f != 0) { + OPB_err(102); + } + break; + case 3: + if (__IN(f, 0x70)) { + if (yval->intval != 0) { + xval->intval = __DIV(xval->intval, yval->intval); + OPB_SetIntType(x); + } else { + OPB_err(205); + } + } else if (f != 0) { + OPB_err(103); + } + break; + case 4: + if (__IN(f, 0x70)) { + if (yval->intval != 0) { + xval->intval = __MOD(xval->intval, yval->intval); + OPB_SetIntType(x); + } else { + OPB_err(205); + } + } else if (f != 0) { + OPB_err(104); + } + break; + case 5: + if (f == 2) { + xval->intval = OPB_BoolToInt((OPB_IntToBool(xval->intval) && OPB_IntToBool(yval->intval))); + } else { + OPB_err(94); + } + break; + case 6: + if (__IN(f, 0x70)) { + temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807 - yval->intval); + if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807-1) - yval->intval)) { + xval->intval += yval->intval; + OPB_SetIntType(x); + } else { + OPB_err(206); + } + } else if (__IN(f, 0x0180)) { + temp = (yval->realval >= (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 - yval->realval); + if (temp || (yval->realval < (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 - yval->realval)) { + xval->realval = xval->realval + yval->realval; + OPB_CheckRealType(f, 206, xval); + } else { + OPB_err(206); + } + } else if (f == 9) { + xval->setval = xval->setval | yval->setval; + } else if (f != 0) { + OPB_err(105); + } + break; + case 7: + if (__IN(f, 0x70)) { + if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807 + yval->intval)) { + xval->intval -= yval->intval; + OPB_SetIntType(x); + } else { + OPB_err(207); + } + } else if (__IN(f, 0x0180)) { + temp = (yval->realval >= (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 + yval->realval); + if (temp || (yval->realval < (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 + yval->realval)) { + xval->realval = xval->realval - yval->realval; + OPB_CheckRealType(f, 207, xval); + } else { + OPB_err(207); + } + } else if (f == 9) { + xval->setval = (xval->setval & ~yval->setval); + } else if (f != 0) { + OPB_err(106); + } + break; + case 8: + if (f == 2) { + xval->intval = OPB_BoolToInt(OPB_IntToBool(xval->intval) || OPB_IntToBool(yval->intval)); + } else { + OPB_err(95); + } + break; + case 9: + xval->intval = OPB_BoolToInt(ConstCmp__14() == 9); + break; + case 10: + xval->intval = OPB_BoolToInt(ConstCmp__14() != 9); + break; + case 11: + if (__IN(f, 0x2a04)) { + OPB_err(108); + } else { + xval->intval = OPB_BoolToInt(ConstCmp__14() == 11); + } + break; + case 12: + if (__IN(f, 0x2a04)) { + OPB_err(108); + } else { + xval->intval = OPB_BoolToInt(ConstCmp__14() != 13); + } + break; + case 13: + if (__IN(f, 0x2a04)) { + OPB_err(108); + } else { + xval->intval = OPB_BoolToInt(ConstCmp__14() == 13); + } + break; + case 14: + if (__IN(f, 0x2a04)) { + OPB_err(108); + } else { + xval->intval = OPB_BoolToInt(ConstCmp__14() != 11); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstOp, op = ", (LONGINT)37); + OPM_LogWNum(op, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + ConstOp__13_s = _s.lnk; +} + +static void OPB_Convert (OPT_Node *x, OPT_Struct typ) +{ + OPT_Node node = NIL; + INTEGER f, g; + LONGINT k; + LONGREAL r; + f = (*x)->typ->form; + g = typ->form; + if ((*x)->class == 7) { + if (__IN(f, 0x70)) { + if (__IN(g, 0x70)) { + if (f > g) { + OPB_SetIntType(*x); + if ((int)(*x)->typ->form > g) { + OPB_err(203); + (*x)->conval->intval = 1; + } + } + } else if (__IN(g, 0x0180)) { + (*x)->conval->realval = (*x)->conval->intval; + (*x)->conval->intval = -1; + } else { + k = (*x)->conval->intval; + if (0 > k || k > 255) { + OPB_err(220); + } + } + } else if (__IN(f, 0x0180)) { + if (__IN(g, 0x0180)) { + OPB_CheckRealType(g, 203, (*x)->conval); + } else { + r = (*x)->conval->realval; + if (r < -9.22337203685478e+018 || r > 9.22337203685478e+018) { + OPB_err(203); + r = (LONGREAL)1; + } + (*x)->conval->intval = __ENTIER(r); + OPB_SetIntType(*x); + } + } + (*x)->obj = NIL; + } else if (((((*x)->class == 11 && (*x)->subcl == 20)) && ((int)(*x)->left->typ->form < f || f > g))) { + if ((*x)->left->typ == typ) { + *x = (*x)->left; + } + } else { + node = OPT_NewNode(11); + node->subcl = 20; + node->left = *x; + *x = node; + } + (*x)->typ = typ; +} + +static struct Op__38 { + INTEGER *f, *g; + struct Op__38 *lnk; +} *Op__38_s; + +static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y); +static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y); + +static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y) +{ + OPT_Node node = NIL; + node = OPT_NewNode(12); + node->subcl = op; + node->typ = typ; + node->left = *x; + node->right = y; + *x = node; +} + +static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y) +{ + BOOLEAN _o_result; + BOOLEAN ok, xCharArr, yCharArr; + xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 10; + yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 10; + if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) { + OPB_CharToString(*y); + *Op__38_s->g = 10; + yCharArr = 1; + } + if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) { + OPB_CharToString(*x); + *Op__38_s->f = 10; + xCharArr = 1; + } + ok = (xCharArr && yCharArr); + if (ok) { + if ((*Op__38_s->f == 10 && (*x)->conval->intval2 == 1)) { + (*x)->typ = OPT_chartyp; + (*x)->conval->intval = 0; + OPB_Index(&*y, OPB_NewIntConst(((LONGINT)(0)))); + } else if ((*Op__38_s->g == 10 && (*y)->conval->intval2 == 1)) { + (*y)->typ = OPT_chartyp; + (*y)->conval->intval = 0; + OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0)))); + } + } + _o_result = ok; + return _o_result; +} + +void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y) +{ + INTEGER f, g; + OPT_Node t = NIL, z = NIL; + OPT_Struct typ = NIL; + BOOLEAN do_; + LONGINT val; + struct Op__38 _s; + _s.f = &f; + _s.g = &g; + _s.lnk = Op__38_s; + Op__38_s = &_s; + z = *x; + if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) { + OPB_err(126); + } else if ((z->class == 7 && y->class == 7)) { + OPB_ConstOp(op, z, y); + z->obj = NIL; + } else { + if (z->typ != y->typ) { + g = y->typ->form; + switch (z->typ->form) { + case 3: + if (z->class == 7) { + OPB_CharToString(z); + } else { + OPB_err(100); + } + break; + case 4: + if (__IN(g, 0x01f0)) { + OPB_Convert(&z, y->typ); + } else { + OPB_err(100); + } + break; + case 5: + if (g == 4) { + OPB_Convert(&y, z->typ); + } else if (__IN(g, 0x01f0)) { + OPB_Convert(&z, y->typ); + } else { + OPB_err(100); + } + break; + case 6: + if (__IN(g, 0x70)) { + OPB_Convert(&y, z->typ); + } else if (__IN(g, 0x0180)) { + OPB_Convert(&z, y->typ); + } else { + OPB_err(100); + } + break; + case 7: + if (__IN(g, 0x70)) { + OPB_Convert(&y, z->typ); + } else if (__IN(g, 0x0180)) { + OPB_Convert(&z, y->typ); + } else { + OPB_err(100); + } + break; + case 8: + if (__IN(g, 0x01f0)) { + OPB_Convert(&y, z->typ); + } else if (__IN(g, 0x0180)) { + OPB_Convert(&y, z->typ); + } else { + OPB_err(100); + } + break; + case 11: + if (!__IN(g, 0x6000)) { + OPB_err(100); + } + break; + case 13: + OPB_CheckPtr(z, y); + break; + case 14: + if (g != 11) { + OPB_err(100); + } + break; + case 10: + break; + case 15: + if (z->typ->comp == 4) { + OPB_err(100); + } + break; + default: + OPB_err(100); + break; + } + } + typ = z->typ; + f = typ->form; + g = y->typ->form; + switch (op) { + case 1: + do_ = 1; + if (__IN(f, 0x70)) { + if (z->class == 7) { + val = z->conval->intval; + if (val == 1) { + do_ = 0; + z = y; + } else if (val == 0) { + do_ = 0; + } else if (OPB_log(val) == 1) { + t = y; + y = z; + z = t; + op = 17; + y->typ = OPT_sinttyp; + y->conval->intval = OPB_exp; + y->obj = NIL; + } + } else if (y->class == 7) { + val = y->conval->intval; + if (val == 1) { + do_ = 0; + } else if (val == 0) { + do_ = 0; + z = y; + } else if (OPB_log(val) == 1) { + op = 17; + y->typ = OPT_sinttyp; + y->conval->intval = OPB_exp; + y->obj = NIL; + } + } + } else if (!__IN(f, 0x0381)) { + OPB_err(105); + typ = OPT_undftyp; + } + if (do_) { + NewOp__39(op, typ, &z, y); + } + break; + case 2: + if (__IN(f, 0x70)) { + if ((y->class == 7 && y->conval->intval == 0)) { + OPB_err(205); + } + OPB_Convert(&z, OPT_realtyp); + OPB_Convert(&y, OPT_realtyp); + typ = OPT_realtyp; + } else if (__IN(f, 0x0180)) { + if ((y->class == 7 && y->conval->realval == (LONGREAL)0)) { + OPB_err(205); + } + } else if ((f != 9 && f != 0)) { + OPB_err(102); + typ = OPT_undftyp; + } + NewOp__39(op, typ, &z, y); + break; + case 3: + do_ = 1; + if (__IN(f, 0x70)) { + if (y->class == 7) { + val = y->conval->intval; + if (val == 0) { + OPB_err(205); + } else if (val == 1) { + do_ = 0; + } else if (OPB_log(val) == 1) { + op = 17; + y->typ = OPT_sinttyp; + y->conval->intval = -OPB_exp; + y->obj = NIL; + } + } + } else if (f != 0) { + OPB_err(103); + typ = OPT_undftyp; + } + if (do_) { + NewOp__39(op, typ, &z, y); + } + break; + case 4: + if (__IN(f, 0x70)) { + if (y->class == 7) { + if (y->conval->intval == 0) { + OPB_err(205); + } else if (OPB_log(y->conval->intval) == 1) { + op = 18; + y->conval->intval = __ASH(-1, OPB_exp); + y->obj = NIL; + } + } + } else if (f != 0) { + OPB_err(104); + typ = OPT_undftyp; + } + NewOp__39(op, typ, &z, y); + break; + case 5: + if (f == 2) { + if (z->class == 7) { + if (OPB_IntToBool(z->conval->intval)) { + z = y; + } + } else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) { + } else { + NewOp__39(op, typ, &z, y); + } + } else if (f != 0) { + OPB_err(94); + z->typ = OPT_undftyp; + } + break; + case 6: + if (!__IN(f, 0x03f1)) { + OPB_err(105); + typ = OPT_undftyp; + } + do_ = 1; + if (__IN(f, 0x70)) { + if ((z->class == 7 && z->conval->intval == 0)) { + do_ = 0; + z = y; + } + if ((y->class == 7 && y->conval->intval == 0)) { + do_ = 0; + } + } + if (do_) { + NewOp__39(op, typ, &z, y); + } + break; + case 7: + if (!__IN(f, 0x03f1)) { + OPB_err(106); + typ = OPT_undftyp; + } + if ((!__IN(f, 0x70) || y->class != 7) || y->conval->intval != 0) { + NewOp__39(op, typ, &z, y); + } + break; + case 8: + if (f == 2) { + if (z->class == 7) { + if (!OPB_IntToBool(z->conval->intval)) { + z = y; + } + } else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) { + } else { + NewOp__39(op, typ, &z, y); + } + } else if (f != 0) { + OPB_err(95); + z->typ = OPT_undftyp; + } + break; + case 9: case 10: + if (__IN(f, 0x6bff) || strings__41(&z, &y)) { + typ = OPT_booltyp; + } else { + OPB_err(107); + typ = OPT_undftyp; + } + NewOp__39(op, typ, &z, y); + break; + case 11: case 12: case 13: case 14: + if (__IN(f, 0x01f9) || strings__41(&z, &y)) { + typ = OPT_booltyp; + } else { + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"ELSE in Op()", (LONGINT)13); + OPM_LogWLn(); + OPB_err(108); + typ = OPT_undftyp; + } + NewOp__39(op, typ, &z, y); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", (LONGINT)32); + OPM_LogWNum(op, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } + *x = z; + Op__38_s = _s.lnk; +} + +void OPB_SetRange (OPT_Node *x, OPT_Node y) +{ + LONGINT k, l; + if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) { + OPB_err(126); + } else if ((__IN((*x)->typ->form, 0x70) && __IN(y->typ->form, 0x70))) { + if ((*x)->class == 7) { + k = (*x)->conval->intval; + if (0 > k || k > (LONGINT)OPM_MaxSet) { + OPB_err(202); + } + } + if (y->class == 7) { + l = y->conval->intval; + if (0 > l || l > (LONGINT)OPM_MaxSet) { + OPB_err(202); + } + } + if (((*x)->class == 7 && y->class == 7)) { + if (k <= l) { + (*x)->conval->setval = __SETRNG(k, l); + } else { + OPB_err(201); + (*x)->conval->setval = __SETRNG(l, k); + } + (*x)->obj = NIL; + } else { + OPB_BindNodes(10, OPT_settyp, &*x, y); + } + } else { + OPB_err(93); + } + (*x)->typ = OPT_settyp; +} + +void OPB_SetElem (OPT_Node *x) +{ + LONGINT k; + if ((*x)->class == 8 || (*x)->class == 9) { + OPB_err(126); + } else if (!__IN((*x)->typ->form, 0x70)) { + OPB_err(93); + } else if ((*x)->class == 7) { + k = (*x)->conval->intval; + if ((0 <= k && k <= (LONGINT)OPM_MaxSet)) { + (*x)->conval->setval = __SETOF(k); + } else { + OPB_err(202); + } + (*x)->obj = NIL; + } else { + OPB_Convert(&*x, OPT_settyp); + } + (*x)->typ = OPT_settyp; +} + +static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode) +{ + INTEGER f, g; + OPT_Struct y = NIL, p = NIL, q = NIL; + if (OPM_Verbose) { + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"PROCEDURE CheckAssign", (LONGINT)22); + OPM_LogWLn(); + } + y = ynode->typ; + f = x->form; + g = y->form; + if (OPM_Verbose) { + OPM_LogWStr((CHAR*)"y.form = ", (LONGINT)10); + OPM_LogWNum(y->form, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"f = ", (LONGINT)5); + OPM_LogWNum(f, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"g = ", (LONGINT)5); + OPM_LogWNum(g, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"ynode.typ.syze = ", (LONGINT)18); + OPM_LogWNum(ynode->typ->size, ((LONGINT)(0))); + OPM_LogWLn(); + } + if (ynode->class == 8 || (ynode->class == 9 && f != 14)) { + OPB_err(126); + } + switch (f) { + case 0: case 10: + break; + case 1: + if (!__IN(g, 0x1a)) { + OPB_err(113); + } + break; + case 2: case 3: case 4: case 9: + if (g != f) { + OPB_err(113); + } + break; + case 5: + if (!__IN(g, 0x30)) { + OPB_err(113); + } + break; + case 6: + if (OPM_LIntSize == 4) { + if (!__IN(g, 0x70)) { + OPB_err(113); + } + } else { + if (!__IN(g, 0x70)) { + OPB_err(113); + } + } + break; + case 7: + if (!__IN(g, 0xf0)) { + OPB_err(113); + } + break; + case 8: + if (!__IN(g, 0x01f0)) { + OPB_err(113); + } + break; + case 13: + if ((x == y || g == 11) || (x == OPT_sysptrtyp && g == 13)) { + } else if (g == 13) { + p = x->BaseTyp; + q = y->BaseTyp; + if ((p->comp == 4 && q->comp == 4)) { + while ((((q != p && q != NIL)) && q != OPT_undftyp)) { + q = q->BaseTyp; + } + if (q == NIL) { + OPB_err(113); + } + } else { + OPB_err(113); + } + } else { + OPB_err(113); + } + break; + case 14: + if (ynode->class == 9) { + OPB_CheckProc(x, ynode->obj); + } else if (x == y || g == 11) { + } else { + OPB_err(113); + } + break; + case 12: case 11: + OPB_err(113); + break; + case 15: + x->pvused = 1; + if (x->comp == 2) { + if ((ynode->class == 7 && g == 3)) { + OPB_CharToString(ynode); + y = ynode->typ; + g = 10; + } + if (x == y) { + } else if (x->BaseTyp == OPT_chartyp) { + if (g == 10) { + if (ynode->conval->intval2 > x->n) { + OPB_err(114); + } + } else if ((__IN(y->comp, 0x0c) && y->BaseTyp == OPT_chartyp)) { + } else { + OPB_err(113); + } + } else { + OPB_err(113); + } + } else if ((x->comp == 3 && x->BaseTyp == OPT_chartyp)) { + if ((__IN(y->comp, 0x0c) && y->BaseTyp == OPT_chartyp)) { + } else { + OPB_err(113); + } + } else if (x->comp == 4) { + if (x == y) { + } else if (y->comp == 4) { + q = y->BaseTyp; + while ((((q != NIL && q != x)) && q != OPT_undftyp)) { + q = q->BaseTyp; + } + if (q == NIL) { + OPB_err(113); + } + } else { + OPB_err(113); + } + } else { + OPB_err(113); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.CheckAssign, f = ", (LONGINT)40); + OPM_LogWNum(f, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + if ((((((ynode->class == 7 && g < f)) && __IN(g, 0xf0))) && __IN(f, 0x01e0))) { + OPB_Convert(&ynode, x); + } +} + +static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo) +{ +} + +void OPB_StPar0 (OPT_Node *par0, INTEGER fctno) +{ + INTEGER f; + OPT_Struct typ = NIL; + OPT_Node x = NIL; + x = *par0; + f = x->typ->form; + switch (fctno) { + case 0: + if ((__IN(f, 0x70) && x->class == 7)) { + if ((0 <= x->conval->intval && x->conval->intval <= 255)) { + OPB_BindNodes(28, OPT_notyp, &x, x); + } else { + OPB_err(218); + } + } else { + OPB_err(69); + } + x->typ = OPT_notyp; + break; + case 1: + typ = OPT_notyp; + if (OPB_NotVar(x)) { + OPB_err(112); + } else if (f == 13) { + if (x->readonly) { + OPB_err(76); + } + f = x->typ->BaseTyp->comp; + if (__IN(f, 0x1c)) { + if (f == 3) { + typ = x->typ->BaseTyp; + } + OPB_BindNodes(19, OPT_notyp, &x, NIL); + x->subcl = 1; + } else { + OPB_err(111); + } + } else { + OPB_err(111); + } + x->typ = typ; + break; + case 2: + OPB_MOp(21, &x); + break; + case 3: + OPB_MOp(22, &x); + break; + case 4: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (f == 3) { + OPB_Convert(&x, OPT_inttyp); + } else { + OPB_err(111); + } + x->typ = OPT_inttyp; + break; + case 5: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x0180)) { + OPB_Convert(&x, OPT_linttyp); + } else { + OPB_err(111); + } + x->typ = OPT_linttyp; + break; + case 6: + OPB_MOp(23, &x); + break; + case 7: + if (x->class == 8) { + switch (f) { + case 2: + x = OPB_NewBoolConst(0); + break; + case 3: + x = OPB_NewIntConst(((LONGINT)(0))); + x->typ = OPT_chartyp; + break; + case 4: + x = OPB_NewIntConst(OPM_MinSInt); + break; + case 5: + x = OPB_NewIntConst(OPM_MinInt); + break; + case 6: + x = OPB_NewIntConst(OPM_MinLInt); + break; + case 9: + x = OPB_NewIntConst(((LONGINT)(0))); + x->typ = OPT_inttyp; + break; + case 7: + x = OPB_NewRealConst(OPM_MinReal, OPT_realtyp); + break; + case 8: + x = OPB_NewRealConst(OPM_MinLReal, OPT_lrltyp); + break; + default: + OPB_err(111); + break; + } + } else { + OPB_err(110); + } + break; + case 8: + if (x->class == 8) { + switch (f) { + case 2: + x = OPB_NewBoolConst(1); + break; + case 3: + x = OPB_NewIntConst(((LONGINT)(255))); + x->typ = OPT_chartyp; + break; + case 4: + x = OPB_NewIntConst(OPM_MaxSInt); + break; + case 5: + x = OPB_NewIntConst(OPM_MaxInt); + break; + case 6: + x = OPB_NewIntConst(OPM_MaxLInt); + break; + case 9: + x = OPB_NewIntConst(OPM_MaxSet); + x->typ = OPT_inttyp; + break; + case 7: + x = OPB_NewRealConst(OPM_MaxReal, OPT_realtyp); + break; + case 8: + x = OPB_NewRealConst(OPM_MaxLReal, OPT_lrltyp); + break; + default: + OPB_err(111); + break; + } + } else { + OPB_err(110); + } + break; + case 9: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x71)) { + OPB_Convert(&x, OPT_chartyp); + } else { + OPB_err(111); + x->typ = OPT_chartyp; + } + break; + case 10: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (f == 5) { + OPB_Convert(&x, OPT_sinttyp); + } else if (f == 6) { + OPB_Convert(&x, OPT_inttyp); + } else if (f == 8) { + OPB_Convert(&x, OPT_realtyp); + } else { + OPB_err(111); + } + break; + case 11: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (f == 4) { + OPB_Convert(&x, OPT_inttyp); + } else if (f == 5) { + OPB_Convert(&x, OPT_linttyp); + } else if (f == 7) { + OPB_Convert(&x, OPT_lrltyp); + } else if (f == 3) { + OPB_Convert(&x, OPT_linttyp); + } else { + OPB_err(111); + } + break; + case 13: case 14: + if (OPB_NotVar(x)) { + OPB_err(112); + } else if (!__IN(f, 0x70)) { + OPB_err(111); + } else if (x->readonly) { + OPB_err(76); + } + break; + case 15: case 16: + if (OPB_NotVar(x)) { + OPB_err(112); + } else if (x->typ != OPT_settyp) { + OPB_err(111); + x->typ = OPT_settyp; + } else if (x->readonly) { + OPB_err(76); + } + break; + case 17: + if (!__IN(x->typ->comp, 0x0c)) { + OPB_err(131); + } + break; + case 18: + if ((x->class == 7 && f == 3)) { + OPB_CharToString(x); + f = 10; + } + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (((!__IN(x->typ->comp, 0x0c) || x->typ->BaseTyp->form != 3) && f != 10)) { + OPB_err(111); + } + break; + case 19: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + if (f != 6) { + OPB_Convert(&x, OPT_linttyp); + } + } else { + OPB_err(111); + x->typ = OPT_linttyp; + } + break; + case 20: + OPB_CheckLeaf(x, 0); + OPB_MOp(24, &x); + break; + case 12: + if (x->class != 8) { + OPB_err(110); + x = OPB_NewIntConst(((LONGINT)(1))); + } else if (__IN(f, 0x63fe) || __IN(x->typ->comp, 0x14)) { + (*OPB_typSize)(x->typ); + x->typ->pvused = 1; + x = OPB_NewIntConst(x->typ->size); + } else { + OPB_err(111); + x = OPB_NewIntConst(((LONGINT)(1))); + } + break; + case 21: + OPB_MOp(25, &x); + break; + case 22: case 23: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (!__IN(f, 0x027a)) { + OPB_err(111); + } + break; + case 24: case 25: case 28: case 31: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if ((x->class == 7 && __IN(f, 0x30))) { + OPB_Convert(&x, OPT_linttyp); + } else if (!__IN(f, 0x2040)) { + OPB_err(111); + x->typ = OPT_linttyp; + } + break; + case 26: case 27: + if ((__IN(f, 0x70) && x->class == 7)) { + if (x->conval->intval < 0 || x->conval->intval > -1) { + OPB_err(220); + } + } else { + OPB_err(69); + } + break; + case 29: + if (x->class != 8) { + OPB_err(110); + } else if (__IN(f, 0x1401) || x->typ->comp == 3) { + OPB_err(111); + } + break; + case 30: + if (OPB_NotVar(x)) { + OPB_err(112); + } else if (f == 13) { + } else { + OPB_err(111); + } + break; + case 32: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + x = OPB_NewBoolConst(0); + } else if (f != 2) { + OPB_err(120); + x = OPB_NewBoolConst(0); + } else { + OPB_MOp(33, &x); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.StPar0, fctno = ", (LONGINT)39); + OPM_LogWNum(fctno, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + *par0 = x; +} + +static struct StPar1__52 { + struct StPar1__52 *lnk; +} *StPar1__52_s; + +static OPT_Node NewOp__53 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right); + +static OPT_Node NewOp__53 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right) +{ + OPT_Node _o_result; + OPT_Node node = NIL; + node = OPT_NewNode(class); + node->subcl = subcl; + node->left = left; + node->right = right; + _o_result = node; + return _o_result; +} + +void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno) +{ + INTEGER f, L; + OPT_Struct typ = NIL; + OPT_Node p = NIL, t = NIL; + struct StPar1__52 _s; + _s.lnk = StPar1__52_s; + StPar1__52_s = &_s; + p = *par0; + f = x->typ->form; + switch (fctno) { + case 13: case 14: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + p->typ = OPT_notyp; + } else { + if (x->typ != p->typ) { + if ((x->class == 7 && __IN(f, 0x70))) { + OPB_Convert(&x, p->typ); + } else { + OPB_err(111); + } + } + p = NewOp__53(19, fctno, p, x); + p->typ = OPT_notyp; + } + break; + case 15: case 16: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (LONGINT)OPM_MaxSet))) { + OPB_err(202); + } + p = NewOp__53(19, fctno, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + break; + case 17: + if (!__IN(f, 0x70) || x->class != 7) { + OPB_err(69); + } else if (f == 4) { + L = (int)x->conval->intval; + typ = p->typ; + while ((L > 0 && __IN(typ->comp, 0x0c))) { + typ = typ->BaseTyp; + L -= 1; + } + if (L != 0 || !__IN(typ->comp, 0x0c)) { + OPB_err(132); + } else { + x->obj = NIL; + if (typ->comp == 3) { + while (p->class == 4) { + p = p->left; + x->conval->intval += 1; + } + p = NewOp__53(12, 19, p, x); + p->typ = OPT_linttyp; + } else { + p = x; + p->conval->intval = typ->n; + OPB_SetIntType(p); + } + } + } else { + OPB_err(132); + } + break; + case 18: + if (OPB_NotVar(x)) { + OPB_err(112); + } else if ((__IN(x->typ->comp, 0x0c) && x->typ->BaseTyp->form == 3)) { + if (x->readonly) { + OPB_err(76); + } + t = x; + x = p; + p = t; + p = NewOp__53(19, 18, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + break; + case 19: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + if ((p->class == 7 && x->class == 7)) { + if (-OPB_maxExp > x->conval->intval || x->conval->intval > OPB_maxExp) { + OPB_err(208); + p->conval->intval = 1; + } else if (x->conval->intval >= 0) { + if (__ABS(p->conval->intval) <= __DIV(9223372036854775807, __ASH(1, x->conval->intval))) { + p->conval->intval = p->conval->intval * __ASH(1, x->conval->intval); + } else { + OPB_err(208); + p->conval->intval = 1; + } + } else { + p->conval->intval = __ASH(p->conval->intval, x->conval->intval); + } + p->obj = NIL; + } else { + p = NewOp__53(12, 17, p, x); + p->typ = OPT_linttyp; + } + } else { + OPB_err(111); + } + break; + case 1: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (p->typ->comp == 3) { + if (__IN(f, 0x70)) { + if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) { + OPB_err(63); + } + } else { + OPB_err(111); + } + p->right = x; + p->typ = p->typ->BaseTyp; + } else { + OPB_err(64); + } + break; + case 22: case 23: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (!__IN(f, 0x70)) { + OPB_err(111); + } else { + if (fctno == 22) { + p = NewOp__53(12, 27, p, x); + } else { + p = NewOp__53(12, 28, p, x); + } + p->typ = p->left->typ; + } + break; + case 24: case 25: case 26: case 27: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x63ff)) { + if (fctno == 24 || fctno == 26) { + if (OPB_NotVar(x)) { + OPB_err(112); + } + t = x; + x = p; + p = t; + } + p = NewOp__53(19, fctno, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + break; + case 28: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + p = NewOp__53(12, 26, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_booltyp; + break; + case 29: + if (((x->class == 8 || x->class == 9) || __IN(f, 0x1401)) || x->typ->comp == 3) { + OPB_err(126); + } + t = OPT_NewNode(11); + t->subcl = 29; + t->left = x; + x = t; + x->typ = p->typ; + p = x; + break; + case 30: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + p = NewOp__53(19, 30, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + break; + case 31: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if ((x->class == 7 && __IN(f, 0x30))) { + OPB_Convert(&x, OPT_linttyp); + } else if (!__IN(f, 0x2040)) { + OPB_err(111); + x->typ = OPT_linttyp; + } + p->link = x; + break; + case 32: + if ((__IN(f, 0x70) && x->class == 7)) { + if ((0 <= x->conval->intval && x->conval->intval <= 255)) { + OPB_BindNodes(28, OPT_notyp, &x, x); + x->conval = OPT_NewConst(); + x->conval->intval = OPM_errpos; + OPB_Construct(15, &p, x); + p->conval = OPT_NewConst(); + p->conval->intval = OPM_errpos; + OPB_Construct(20, &p, NIL); + OPB_OptIf(&p); + if (p == NIL) { + } else if (p->class == 28) { + OPB_err(99); + } else { + p->subcl = 32; + } + } else { + OPB_err(218); + } + } else { + OPB_err(69); + } + break; + default: + OPB_err(64); + break; + } + *par0 = p; + StPar1__52_s = _s.lnk; +} + +void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n) +{ + OPT_Node node = NIL; + INTEGER f; + OPT_Node p = NIL; + p = *par0; + f = x->typ->form; + if (fctno == 1) { + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (p->typ->comp != 3) { + OPB_err(64); + } else if (__IN(f, 0x70)) { + if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) { + OPB_err(63); + } + node = p->right; + while (node->link != NIL) { + node = node->link; + } + node->link = x; + p->typ = p->typ->BaseTyp; + } else { + OPB_err(111); + } + } else if ((fctno == 31 && n == 2)) { + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + node = OPT_NewNode(19); + node->subcl = 31; + node->right = p; + node->left = p->link; + p->link = x; + p = node; + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + } else { + OPB_err(64); + } + *par0 = p; +} + +void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno) +{ + INTEGER dim; + OPT_Node x = NIL, p = NIL; + p = *par0; + if (fctno <= 19) { + if ((fctno == 1 && p->typ != OPT_notyp)) { + if (p->typ->comp == 3) { + OPB_err(65); + } + p->typ = OPT_notyp; + } else if (fctno <= 12) { + if (parno < 1) { + OPB_err(65); + } + } else { + if (((fctno == 13 || fctno == 14) && parno == 1)) { + OPB_BindNodes(19, OPT_notyp, &p, OPB_NewIntConst(((LONGINT)(1)))); + p->subcl = fctno; + p->right->typ = p->left->typ; + } else if ((fctno == 17 && parno == 1)) { + if (p->typ->comp == 3) { + dim = 0; + while (p->class == 4) { + p = p->left; + dim += 1; + } + OPB_BindNodes(12, OPT_linttyp, &p, OPB_NewIntConst(dim)); + p->subcl = 19; + } else { + p = OPB_NewIntConst(p->typ->n); + } + } else if (parno < 2) { + OPB_err(65); + } + } + } else if (fctno == 32) { + if (parno == 1) { + x = NIL; + OPB_BindNodes(28, OPT_notyp, &x, OPB_NewIntConst(((LONGINT)(0)))); + x->conval = OPT_NewConst(); + x->conval->intval = OPM_errpos; + OPB_Construct(15, &p, x); + p->conval = OPT_NewConst(); + p->conval->intval = OPM_errpos; + OPB_Construct(20, &p, NIL); + OPB_OptIf(&p); + if (p == NIL) { + } else if (p->class == 28) { + OPB_err(99); + } else { + p->subcl = 32; + } + } else if (parno < 1) { + OPB_err(65); + } + } else { + if ((parno < 1 || (fctno > 21 && parno < 2)) || (fctno == 31 && parno < 3)) { + OPB_err(65); + } + } + *par0 = p; +} + +static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar) +{ + INTEGER f; + f = atyp->comp; + ftyp = ftyp->BaseTyp; + atyp = atyp->BaseTyp; + if ((fvarpar && ftyp == OPT_bytetyp)) { + if (!__IN(f, 0x0c) || !__IN(atyp->form, 0x1e)) { + if (__IN(18, OPM_opt)) { + OPB_err(-301); + } + } + } else if (__IN(f, 0x0c)) { + if (ftyp->comp == 3) { + OPB_DynArrParCheck(ftyp, atyp, fvarpar); + } else if (ftyp != atyp) { + if ((((!fvarpar && ftyp->form == 13)) && atyp->form == 13)) { + ftyp = ftyp->BaseTyp; + atyp = atyp->BaseTyp; + if ((ftyp->comp == 4 && atyp->comp == 4)) { + while ((((ftyp != atyp && atyp != NIL)) && atyp != OPT_undftyp)) { + atyp = atyp->BaseTyp; + } + if (atyp == NIL) { + OPB_err(113); + } + } else { + OPB_err(66); + } + } else { + OPB_err(66); + } + } + } else { + OPB_err(67); + } +} + +static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp) +{ + if (fp->typ->form == 13) { + if ((*x)->class == 3) { + *x = (*x)->left; + } else { + OPB_err(71); + } + } +} + +void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar) +{ + if (((*x)->obj != NIL && __IN((*x)->obj->mode, 0x22c0))) { + *fpar = (*x)->obj->link; + if ((*x)->obj->mode == 13) { + OPB_CheckReceiver(&(*x)->left, *fpar); + *fpar = (*fpar)->link; + } + } else if (((((*x)->class != 8 && (*x)->typ != NIL)) && (*x)->typ->form == 14)) { + *fpar = (*x)->typ->link; + } else { + OPB_err(121); + *fpar = NIL; + (*x)->typ = OPT_undftyp; + } +} + +void OPB_Param (OPT_Node ap, OPT_Object fp) +{ + OPT_Struct q = NIL; + if (fp->typ->form != 0) { + if (fp->mode == 2) { + if (OPB_NotVar(ap)) { + OPB_err(122); + } else { + OPB_CheckLeaf(ap, 0); + } + if (ap->readonly) { + OPB_err(76); + } + if (fp->typ->comp == 3) { + OPB_DynArrParCheck(fp->typ, ap->typ, 1); + } else if ((fp->typ->comp == 4 && ap->typ->comp == 4)) { + q = ap->typ; + while ((((q != fp->typ && q != NIL)) && q != OPT_undftyp)) { + q = q->BaseTyp; + } + if (q == NIL) { + OPB_err(111); + } + } else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 13)) { + } else if ((ap->typ != fp->typ && !((fp->typ->form == 1 && __IN(ap->typ->form, 0x18))))) { + OPB_err(123); + } else if ((fp->typ->form == 13 && ap->class == 5)) { + OPB_err(123); + } + } else if (fp->typ->comp == 3) { + if ((ap->class == 7 && ap->typ->form == 3)) { + OPB_CharToString(ap); + } + if ((ap->typ->form == 10 && fp->typ->BaseTyp->form == 3)) { + } else if (ap->class >= 7) { + OPB_err(59); + } else { + OPB_DynArrParCheck(fp->typ, ap->typ, 0); + } + } else { + OPB_CheckAssign(fp->typ, ap); + } + } +} + +void OPB_StaticLink (SHORTINT dlev) +{ + OPT_Object scope = NIL; + scope = OPT_topScope; + while (dlev > 0) { + dlev -= 1; + scope->link->conval->setval |= __SETOF(3); + scope = scope->left; + } +} + +void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp) +{ + OPT_Struct typ = NIL; + OPT_Node p = NIL; + SHORTINT lev; + if ((*x)->class == 9) { + typ = (*x)->typ; + lev = (*x)->obj->mnolev; + if (lev > 0) { + OPB_StaticLink(OPT_topScope->mnolev - lev); + } + if ((*x)->obj->mode == 10) { + OPB_err(121); + } + } else if (((*x)->class == 2 && (*x)->obj->mode == 13)) { + typ = (*x)->typ; + (*x)->class = 9; + p = (*x)->left; + (*x)->left = NIL; + p->link = apar; + apar = p; + fp = (*x)->obj->link; + } else { + typ = (*x)->typ->BaseTyp; + } + OPB_BindNodes(13, typ, &*x, apar); + (*x)->obj = fp; +} + +void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc) +{ + OPT_Node x = NIL; + x = OPT_NewNode(18); + x->typ = OPT_notyp; + x->obj = proc; + x->left = *procdec; + x->right = stat; + *procdec = x; +} + +void OPB_Return (OPT_Node *x, OPT_Object proc) +{ + OPT_Node node = NIL; + if (proc == NIL) { + if (*x != NIL) { + OPB_err(124); + } + } else { + if (*x != NIL) { + OPB_CheckAssign(proc->typ, *x); + } else if (proc->typ != OPT_notyp) { + OPB_err(124); + } + } + node = OPT_NewNode(26); + node->typ = OPT_notyp; + node->obj = proc; + node->left = *x; + *x = node; +} + +void OPB_Assign (OPT_Node *x, OPT_Node y) +{ + OPT_Node z = NIL; + SHORTINT subcl; + if ((*x)->class >= 7) { + OPB_err(56); + } + OPB_CheckAssign((*x)->typ, y); + if ((*x)->readonly) { + OPB_err(76); + } + if ((*x)->typ->comp == 4) { + if ((*x)->class == 5) { + z = (*x)->left; + } else { + z = *x; + } + if ((z->class == 3 && z->left->class == 5)) { + z->left = z->left->left; + } + if (((*x)->typ->strobj != NIL && (z->class == 3 || z->class == 1))) { + OPB_BindNodes(6, (*x)->typ, &z, NIL); + *x = z; + } + } else if (((((((*x)->typ->comp == 2 && (*x)->typ->BaseTyp == OPT_chartyp)) && y->typ->form == 10)) && y->conval->intval2 == 1)) { + y->typ = OPT_chartyp; + y->conval->intval = 0; + OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0)))); + } + if ((((((__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp == OPT_chartyp)) && __IN(y->typ->comp, 0x0c))) && y->typ->BaseTyp == OPT_chartyp)) { + subcl = 18; + } else { + subcl = 0; + } + OPB_BindNodes(19, OPT_notyp, &*x, y); + (*x)->subcl = subcl; +} + +void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ) +{ + OPT_Node node = NIL; + node = OPT_NewNode(14); + node->typ = typ; + node->conval = OPT_NewConst(); + node->conval->intval = typ->txtpos; + if (*inittd == NIL) { + *inittd = node; + } else { + (*last)->link = node; + } + *last = node; +} + + +export void *OPB__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPS); + __MODULE_IMPORT(OPT); + __REGMOD("OPB", 0); +/* BEGIN */ + OPB_maxExp = OPB_log(4611686018427387904); + OPB_maxExp = OPB_exp; + __ENDMOD; +} diff --git a/bootstrap/unix-88/OPB.h b/bootstrap/unix-88/OPB.h new file mode 100644 index 00000000..c8165f54 --- /dev/null +++ b/bootstrap/unix-88/OPB.h @@ -0,0 +1,50 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPB__h +#define OPB__h + +#define LARGE +#include "SYSTEM.h" +#include "OPS.h" +#include "OPT.h" + + +import void (*OPB_typSize)(OPT_Struct); + + +import void OPB_Assign (OPT_Node *x, OPT_Node y); +import void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp); +import void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames); +import void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y); +import void OPB_DeRef (OPT_Node *x); +import OPT_Node OPB_EmptySet (void); +import void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc); +import void OPB_Field (OPT_Node *x, OPT_Object y); +import void OPB_In (OPT_Node *x, OPT_Node y); +import void OPB_Index (OPT_Node *x, OPT_Node y); +import void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ); +import void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y); +import void OPB_MOp (SHORTINT op, OPT_Node *x); +import OPT_Node OPB_NewBoolConst (BOOLEAN boolval); +import OPT_Node OPB_NewIntConst (LONGINT intval); +import OPT_Node OPB_NewLeaf (OPT_Object obj); +import OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ); +import OPT_Node OPB_NewString (OPS_String str, LONGINT len); +import OPT_Node OPB_Nil (void); +import void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y); +import void OPB_OptIf (OPT_Node *x); +import void OPB_Param (OPT_Node ap, OPT_Object fp); +import void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar); +import void OPB_Return (OPT_Node *x, OPT_Object proc); +import void OPB_SetElem (OPT_Node *x); +import void OPB_SetRange (OPT_Node *x, OPT_Node y); +import void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno); +import void OPB_StPar0 (OPT_Node *par0, INTEGER fctno); +import void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno); +import void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n); +import void OPB_StaticLink (SHORTINT dlev); +import void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard); +import void *OPB__init(void); + + +#endif diff --git a/bootstrap/unix-88/OPC.c b/bootstrap/unix-88/OPC.c new file mode 100644 index 00000000..10468b9e --- /dev/null +++ b/bootstrap/unix-88/OPC.c @@ -0,0 +1,2109 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "Configuration.h" +#include "OPM.h" +#include "OPT.h" + + +static INTEGER OPC_indentLevel; +static BOOLEAN OPC_ptrinit, OPC_mainprog, OPC_ansi; +static SHORTINT OPC_hashtab[105]; +static CHAR OPC_keytab[36][9]; +static BOOLEAN OPC_GlbPtrs; +static CHAR OPC_BodyNameExt[13]; + + +export void OPC_Align (LONGINT *adr, LONGINT base); +export void OPC_Andent (OPT_Struct typ); +static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames); +export LONGINT OPC_Base (OPT_Struct typ); +export OPT_Object OPC_BaseTProc (OPT_Object obj); +export void OPC_BegBlk (void); +export void OPC_BegStat (void); +static void OPC_CProcDefs (OPT_Object obj, INTEGER vis); +export void OPC_Case (LONGINT caseVal, INTEGER form); +export void OPC_Cmp (INTEGER rel); +export void OPC_CompleteIdent (OPT_Object obj); +export void OPC_Constant (OPT_Const con, INTEGER form); +static void OPC_DeclareBase (OPT_Object dcl); +static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef); +static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro); +static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty); +static void OPC_DefAnonRecs (OPT_Node n); +export void OPC_DefineInter (OPT_Object proc); +static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty); +static void OPC_DefineTProcTypes (OPT_Object obj); +static void OPC_DefineType (OPT_Struct str); +export void OPC_EndBlk (void); +export void OPC_EndBlk0 (void); +export void OPC_EndStat (void); +export void OPC_EnterBody (void); +export void OPC_EnterProc (OPT_Object proc); +export void OPC_ExitBody (void); +export void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet); +static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *n, LONGINT *curAlign); +static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign); +export void OPC_GenBdy (OPT_Node n); +static void OPC_GenDynTypes (OPT_Node n, INTEGER vis); +export void OPC_GenEnumPtrs (OPT_Object var); +export void OPC_GenHdr (OPT_Node n); +export void OPC_GenHdrIncludes (void); +static void OPC_GenHeaderMsg (void); +export void OPC_Halt (LONGINT n); +export void OPC_Ident (OPT_Object obj); +static void OPC_IdentList (OPT_Object obj, INTEGER vis); +static void OPC_Include (CHAR *name, LONGINT name__len); +static void OPC_IncludeImports (OPT_Object obj, INTEGER vis); +export void OPC_Increment (BOOLEAN decrement); +export void OPC_Indent (INTEGER count); +export void OPC_Init (void); +static void OPC_InitImports (OPT_Object obj); +static void OPC_InitKeywords (void); +export void OPC_InitTDesc (OPT_Struct typ); +static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj); +export void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim); +static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName); +static INTEGER OPC_Length (CHAR *s, LONGINT s__len); +export LONGINT OPC_NofPtrs (OPT_Struct typ); +static INTEGER OPC_PerfectHash (CHAR *s, LONGINT s__len); +static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len); +static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define); +static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis); +static void OPC_PutBase (OPT_Struct typ); +static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt); +static void OPC_RegCmds (OPT_Object obj); +export void OPC_SetInclude (BOOLEAN exclude); +static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause); +static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x); +export void OPC_TDescDecl (OPT_Struct typ); +export void OPC_TypeDefs (OPT_Object obj, INTEGER vis); +export void OPC_TypeOf (OPT_Object ap); +static BOOLEAN OPC_Undefined (OPT_Object obj); + + +void OPC_Init (void) +{ + OPC_indentLevel = 0; + OPC_ptrinit = __IN(5, OPM_opt); + OPC_mainprog = OPM_mainProg || OPM_mainLinkStat; + OPC_ansi = __IN(6, OPM_opt); + if (OPC_ansi) { + __MOVE("__init(void)", OPC_BodyNameExt, 13); + } else { + __MOVE("__init()", OPC_BodyNameExt, 9); + } +} + +void OPC_Indent (INTEGER count) +{ + OPC_indentLevel += count; +} + +void OPC_BegStat (void) +{ + INTEGER i; + i = OPC_indentLevel; + while (i > 0) { + OPM_Write(0x09); + i -= 1; + } +} + +void OPC_EndStat (void) +{ + OPM_Write(';'); + OPM_WriteLn(); +} + +void OPC_BegBlk (void) +{ + OPM_Write('{'); + OPM_WriteLn(); + OPC_indentLevel += 1; +} + +void OPC_EndBlk (void) +{ + OPC_indentLevel -= 1; + OPC_BegStat(); + OPM_Write('}'); + OPM_WriteLn(); +} + +void OPC_EndBlk0 (void) +{ + OPC_indentLevel -= 1; + OPC_BegStat(); + OPM_Write('}'); +} + +static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x) +{ + CHAR ch; + INTEGER i; + __DUP(s, s__len, CHAR); + ch = s[0]; + i = 0; + while (ch != 0x00) { + if (ch == '#') { + OPM_WriteInt(x); + } else { + OPM_Write(ch); + } + i += 1; + ch = s[__X(i, s__len)]; + } + __DEL(s); +} + +static INTEGER OPC_Length (CHAR *s, LONGINT s__len) +{ + INTEGER _o_result; + INTEGER i; + i = 0; + while (s[__X(i, s__len)] != 0x00) { + i += 1; + } + _o_result = i; + return _o_result; +} + +static INTEGER OPC_PerfectHash (CHAR *s, LONGINT s__len) +{ + INTEGER _o_result; + INTEGER i, h; + i = 0; + h = 0; + while ((s[__X(i, s__len)] != 0x00 && i < 5)) { + h = 3 * h + (int)s[__X(i, s__len)]; + i += 1; + } + _o_result = (int)__MOD(h, 105); + return _o_result; +} + +void OPC_Ident (OPT_Object obj) +{ + INTEGER mode, level, h; + mode = obj->mode; + level = obj->mnolev; + if ((__IN(mode, 0x62) && level > 0) || __IN(mode, 0x14)) { + OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256))); + h = OPC_PerfectHash((void*)obj->name, ((LONGINT)(256))); + if (OPC_hashtab[__X(h, ((LONGINT)(105)))] >= 0) { + if (__STRCMP(OPC_keytab[__X(OPC_hashtab[__X(h, ((LONGINT)(105)))], ((LONGINT)(36)))], obj->name) == 0) { + OPM_Write('_'); + } + } + } else { + if (mode != 5 || obj->linkadr != 2) { + if (mode == 13) { + OPC_Ident(obj->link->typ->strobj); + } else if (level < 0) { + OPM_WriteStringVar((void*)OPT_GlbMod[__X(-level, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + if (OPM_currFile == 0) { + OPT_GlbMod[__X(-level, ((LONGINT)(64)))]->vis = 1; + } + } else { + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + } + OPM_Write('_'); + } else if (obj == OPT_sysptrtyp->strobj || obj == OPT_bytetyp->strobj) { + OPM_WriteString((CHAR*)"SYSTEM_", (LONGINT)8); + } + OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256))); + } +} + +static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause) +{ + INTEGER pointers; + *openClause = 0; + if (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->comp != 4)) { + if (__IN(typ->comp, 0x0c)) { + OPC_Stars(typ->BaseTyp, &*openClause); + *openClause = typ->comp == 2; + } else if (typ->form == 14) { + OPM_Write('('); + OPM_Write('*'); + } else { + pointers = 0; + while (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->form == 13)) { + pointers += 1; + typ = typ->BaseTyp; + } + if (pointers > 0) { + if (typ->comp != 3) { + OPC_Stars(typ, &*openClause); + } + if (*openClause) { + OPM_Write('('); + *openClause = 0; + } + while (pointers > 0) { + OPM_Write('*'); + pointers -= 1; + } + } + } + } +} + +static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef) +{ + OPT_Struct typ = NIL; + BOOLEAN varPar, openClause; + INTEGER form, comp; + typ = dcl->typ; + varPar = ((dcl->mode == 2 && typ->comp != 2) || typ->comp == 3) || scopeDef; + OPC_Stars(typ, &openClause); + if (varPar) { + if (openClause) { + OPM_Write('('); + } + OPM_Write('*'); + } + if (dcl->name[0] != 0x00) { + OPC_Ident(dcl); + } + if ((varPar && openClause)) { + OPM_Write(')'); + } + openClause = 0; + for (;;) { + form = typ->form; + comp = typ->comp; + if (((typ->strobj != NIL && typ->strobj->name[0] != 0x00) || form == 12) || comp == 4) { + break; + } else if ((form == 13 && typ->BaseTyp->comp != 3)) { + openClause = 1; + } else if (form == 14 || __IN(comp, 0x0c)) { + if (openClause) { + OPM_Write(')'); + openClause = 0; + } + if (form == 14) { + if (OPC_ansi) { + OPM_Write(')'); + OPC_AnsiParamList(typ->link, 0); + } else { + OPM_WriteString((CHAR*)")()", (LONGINT)4); + } + break; + } else if (comp == 2) { + OPM_Write('['); + OPM_WriteInt(typ->n); + OPM_Write(']'); + } + } else { + break; + } + typ = typ->BaseTyp; + } +} + +void OPC_Andent (OPT_Struct typ) +{ + if (typ->strobj == NIL || typ->align >= 65536) { + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + OPC_Str1((CHAR*)"__#", (LONGINT)4, __ASHR(typ->align, 16)); + } else { + OPC_Ident(typ->strobj); + } +} + +static BOOLEAN OPC_Undefined (OPT_Object obj) +{ + BOOLEAN _o_result; + _o_result = (((obj->mnolev >= 0 && obj->linkadr != (LONGINT)(3 + OPM_currFile))) && obj->linkadr != 2) || obj->name[0] == 0x00; + return _o_result; +} + +static void OPC_DeclareBase (OPT_Object dcl) +{ + OPT_Struct typ = NIL, prev = NIL; + OPT_Object obj = NIL; + INTEGER nofdims; + LONGINT off, n, dummy; + typ = dcl->typ; + prev = typ; + while ((((((((typ->strobj == NIL || typ->comp == 3) || OPC_Undefined(typ->strobj)) && typ->comp != 4)) && typ->form != 12)) && !((typ->form == 13 && typ->BaseTyp->comp == 3)))) { + prev = typ; + typ = typ->BaseTyp; + } + obj = typ->strobj; + if (typ->form == 12) { + OPM_WriteString((CHAR*)"void", (LONGINT)5); + } else if ((obj != NIL && !OPC_Undefined(obj))) { + OPC_Ident(obj); + } else if (typ->comp == 4) { + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPC_Andent(typ); + if ((prev->form != 13 && (obj != NIL || dcl->name[0] == 0x00))) { + if ((typ->BaseTyp != NIL && typ->BaseTyp->strobj->vis != 0)) { + OPM_WriteString((CHAR*)" { /* ", (LONGINT)7); + OPC_Ident(typ->BaseTyp->strobj); + OPM_WriteString((CHAR*)" */", (LONGINT)4); + OPM_WriteLn(); + OPC_Indent(1); + } else { + OPM_Write(' '); + OPC_BegBlk(); + } + OPC_FieldList(typ, 1, &off, &n, &dummy); + OPC_EndBlk0(); + } + } else if ((typ->form == 13 && typ->BaseTyp->comp == 3)) { + typ = typ->BaseTyp->BaseTyp; + nofdims = 1; + while (typ->comp == 3) { + nofdims += 1; + typ = typ->BaseTyp; + } + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPC_BegBlk(); + OPC_BegStat(); + OPC_Str1((CHAR*)"LONGINT len[#]", (LONGINT)15, nofdims); + OPC_EndStat(); + OPC_BegStat(); + __NEW(obj, OPT_ObjDesc); + __NEW(obj->typ, OPT_StrDesc); + obj->typ->form = 15; + obj->typ->comp = 2; + obj->typ->n = 1; + obj->typ->BaseTyp = typ; + obj->mode = 4; + __MOVE("data", obj->name, 5); + obj->linkadr = 0; + OPC_DeclareBase(obj); + OPM_Write(' '); + OPC_DeclareObj(obj, 0); + OPC_EndStat(); + OPC_EndBlk0(); + } +} + +LONGINT OPC_NofPtrs (OPT_Struct typ) +{ + LONGINT _o_result; + OPT_Object fld = NIL; + OPT_Struct btyp = NIL; + LONGINT n; + if ((typ->form == 13 && typ->sysflag == 0)) { + _o_result = 1; + return _o_result; + } else if ((typ->comp == 4 && __MASK(typ->sysflag, -256) == 0)) { + btyp = typ->BaseTyp; + if (btyp != NIL) { + n = OPC_NofPtrs(btyp); + } else { + n = 0; + } + fld = typ->link; + while ((fld != NIL && fld->mode == 4)) { + if (__STRCMP(fld->name, "@ptr") != 0) { + n = n + OPC_NofPtrs(fld->typ); + } else { + n += 1; + } + fld = fld->link; + } + _o_result = n; + return _o_result; + } else if (typ->comp == 2) { + btyp = typ->BaseTyp; + n = typ->n; + while (btyp->comp == 2) { + n = btyp->n * n; + btyp = btyp->BaseTyp; + } + _o_result = OPC_NofPtrs(btyp) * n; + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt) +{ + OPT_Object fld = NIL; + OPT_Struct btyp = NIL; + LONGINT n, i; + if ((typ->form == 13 && typ->sysflag == 0)) { + OPM_WriteInt(adr); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + *cnt += 1; + if (__MASK(*cnt, -16) == 0) { + OPM_WriteLn(); + OPM_Write(0x09); + } + } else if ((typ->comp == 4 && __MASK(typ->sysflag, -256) == 0)) { + btyp = typ->BaseTyp; + if (btyp != NIL) { + OPC_PutPtrOffsets(btyp, adr, &*cnt); + } + fld = typ->link; + while ((fld != NIL && fld->mode == 4)) { + if (__STRCMP(fld->name, "@ptr") != 0) { + OPC_PutPtrOffsets(fld->typ, adr + fld->adr, &*cnt); + } else { + OPM_WriteInt(adr + fld->adr); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + *cnt += 1; + if (__MASK(*cnt, -16) == 0) { + OPM_WriteLn(); + OPM_Write(0x09); + } + } + fld = fld->link; + } + } else if (typ->comp == 2) { + btyp = typ->BaseTyp; + n = typ->n; + while (btyp->comp == 2) { + n = btyp->n * n; + btyp = btyp->BaseTyp; + } + if (OPC_NofPtrs(btyp) > 0) { + i = 0; + while (i < n) { + OPC_PutPtrOffsets(btyp, adr + i * btyp->size, &*cnt); + i += 1; + } + } + } +} + +static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj) +{ + if (obj != NIL) { + OPC_InitTProcs(typ, obj->left); + if (obj->mode == 13) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"__INITBP(", (LONGINT)10); + OPC_Ident(typ); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(obj); + OPC_Str1((CHAR*)", #)", (LONGINT)5, __ASHR(obj->adr, 16)); + OPC_EndStat(); + } + OPC_InitTProcs(typ, obj->right); + } +} + +static void OPC_PutBase (OPT_Struct typ) +{ + if (typ != NIL) { + OPC_PutBase(typ->BaseTyp); + OPC_Ident(typ->strobj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + } +} + +static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName) +{ + OPT_Struct typ = NIL; + INTEGER dim; + if (showParamName) { + OPC_Ident(par); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + } + dim = 1; + typ = par->typ->BaseTyp; + while (typ->comp == 3) { + if (ansiDefine) { + OPM_WriteString((CHAR*)", LONGINT ", (LONGINT)11); + } else { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + } + if (showParamName) { + OPC_Ident(par); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + OPM_WriteInt(dim); + } + typ = typ->BaseTyp; + dim += 1; + } +} + +static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro) +{ + OPM_Write('('); + while (par != NIL) { + if (macro) { + OPM_WriteStringVar((void*)par->name, ((LONGINT)(256))); + } else { + if ((par->mode == 1 && par->typ->form == 7)) { + OPM_Write('_'); + } + OPC_Ident(par); + } + if (par->typ->comp == 3) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_LenList(par, 0, 1); + } else if ((par->mode == 2 && par->typ->comp == 4)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteStringVar((void*)par->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } + par = par->link; + if (par != NIL) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + } + } + OPM_Write(')'); +} + +static void OPC_DefineTProcTypes (OPT_Object obj) +{ + OPT_Object par = NIL; + if (obj->typ != OPT_notyp) { + OPC_DefineType(obj->typ); + } + if (OPC_ansi) { + par = obj->link; + while (par != NIL) { + OPC_DefineType(par->typ); + par = par->link; + } + } +} + +static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty) +{ + if (obj != NIL) { + OPC_DeclareTProcs(obj->left, &*empty); + if (obj->mode == 13) { + if (obj->typ != OPT_notyp) { + OPC_DefineType(obj->typ); + } + if (OPM_currFile == 0) { + if (obj->vis == 1) { + OPC_DefineTProcTypes(obj); + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + *empty = 0; + OPC_ProcHeader(obj, 0); + } + } else { + *empty = 0; + OPC_DefineTProcTypes(obj); + if (obj->vis == 0) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + } + OPC_ProcHeader(obj, 0); + } + } + OPC_DeclareTProcs(obj->right, &*empty); + } +} + +OPT_Object OPC_BaseTProc (OPT_Object obj) +{ + OPT_Object _o_result; + OPT_Struct typ = NIL, base = NIL; + LONGINT mno; + typ = obj->link->typ; + if (typ->form == 13) { + typ = typ->BaseTyp; + } + base = typ->BaseTyp; + mno = __ASHR(obj->adr, 16); + while ((base != NIL && mno < base->n)) { + typ = base; + base = typ->BaseTyp; + } + OPT_FindField(obj->name, typ, &obj); + _o_result = obj; + return _o_result; +} + +static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty) +{ + if (obj != NIL) { + OPC_DefineTProcMacros(obj->left, &*empty); + if ((((obj->mode == 13 && obj == OPC_BaseTProc(obj))) && (OPM_currFile != 0 || obj->vis == 1))) { + OPM_WriteString((CHAR*)"#define __", (LONGINT)11); + OPC_Ident(obj); + OPC_DeclareParams(obj->link, 1); + OPM_WriteString((CHAR*)" __SEND(", (LONGINT)9); + if (obj->link->typ->form == 13) { + OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10); + OPC_Ident(obj->link); + OPM_Write(')'); + } else { + OPC_Ident(obj->link); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } + OPC_Str1((CHAR*)", #, ", (LONGINT)6, __ASHR(obj->adr, 16)); + if (obj->typ == OPT_notyp) { + OPM_WriteString((CHAR*)"void", (LONGINT)5); + } else { + OPC_Ident(obj->typ->strobj); + } + OPM_WriteString((CHAR*)"(*)", (LONGINT)4); + if (OPC_ansi) { + OPC_AnsiParamList(obj->link, 0); + } else { + OPM_WriteString((CHAR*)"()", (LONGINT)3); + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_DeclareParams(obj->link, 1); + OPM_Write(')'); + OPM_WriteLn(); + } + OPC_DefineTProcMacros(obj->right, &*empty); + } +} + +static void OPC_DefineType (OPT_Struct str) +{ + OPT_Object obj = NIL, field = NIL, par = NIL; + BOOLEAN empty; + if (OPM_currFile == 1 || str->ref < 255) { + obj = str->strobj; + if (obj == NIL || OPC_Undefined(obj)) { + if (obj != NIL) { + if (obj->linkadr == 1) { + if (str->form != 13) { + OPM_Mark(244, str->txtpos); + obj->linkadr = 2; + } + } else { + obj->linkadr = 1; + } + } + if (str->comp == 4) { + if (str->BaseTyp != NIL) { + OPC_DefineType(str->BaseTyp); + } + field = str->link; + while ((field != NIL && field->mode == 4)) { + if (field->vis != 0 || OPM_currFile == 1) { + OPC_DefineType(field->typ); + } + field = field->link; + } + } else if (str->form == 13) { + if (str->BaseTyp->comp != 4) { + OPC_DefineType(str->BaseTyp); + } + } else if (__IN(str->comp, 0x0c)) { + OPC_DefineType(str->BaseTyp); + } else if (str->form == 14) { + if (str->BaseTyp != OPT_notyp) { + OPC_DefineType(str->BaseTyp); + } + field = str->link; + while (field != NIL) { + OPC_DefineType(field->typ); + field = field->link; + } + } + } + if ((obj != NIL && OPC_Undefined(obj))) { + OPM_WriteString((CHAR*)"typedef", (LONGINT)8); + OPM_WriteLn(); + OPM_Write(0x09); + OPC_Indent(1); + obj->linkadr = 1; + OPC_DeclareBase(obj); + OPM_Write(' '); + obj->typ->strobj = NIL; + OPC_DeclareObj(obj, 0); + obj->typ->strobj = obj; + obj->linkadr = 3 + OPM_currFile; + OPC_EndStat(); + OPC_Indent(-1); + OPM_WriteLn(); + if (obj->typ->comp == 4) { + empty = 1; + OPC_DeclareTProcs(str->link, &empty); + OPC_DefineTProcMacros(str->link, &empty); + if (!empty) { + OPM_WriteLn(); + } + } + } + } +} + +static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len) +{ + BOOLEAN _o_result; + INTEGER i; + BOOLEAN r; + __DUP(y, y__len, CHAR); + i = 0; + while ((*x)[__X(i + 1, ((LONGINT)(256)))] == y[__X(i, y__len)]) { + i += 1; + } + r = y[__X(i, y__len)] == 0x00; + _o_result = r; + __DEL(y); + return _o_result; +} + +static void OPC_CProcDefs (OPT_Object obj, INTEGER vis) +{ + INTEGER i; + OPT_ConstExt ext = NIL; + INTEGER _for__9; + if (obj != NIL) { + OPC_CProcDefs(obj->left, vis); + if ((((obj->mode == 9 && (int)obj->vis >= vis)) && obj->adr == 1)) { + ext = obj->conval->ext; + i = 1; + if (((*ext)[1] != '#' && !(OPC_Prefixed(ext, (CHAR*)"extern ", (LONGINT)8) || OPC_Prefixed(ext, (CHAR*)"import ", (LONGINT)8)))) { + OPM_WriteString((CHAR*)"#define ", (LONGINT)9); + OPC_Ident(obj); + OPC_DeclareParams(obj->link, 1); + OPM_Write(0x09); + } + _for__9 = (int)(*obj->conval->ext)[0]; + i = i; + while (i <= _for__9) { + OPM_Write((*obj->conval->ext)[__X(i, ((LONGINT)(256)))]); + i += 1; + } + OPM_WriteLn(); + } + OPC_CProcDefs(obj->right, vis); + } +} + +void OPC_TypeDefs (OPT_Object obj, INTEGER vis) +{ + if (obj != NIL) { + OPC_TypeDefs(obj->left, vis); + if ((obj->mode == 5 && obj->typ->txtpos > 0)) { + OPC_DefineType(obj->typ); + } + OPC_TypeDefs(obj->right, vis); + } +} + +static void OPC_DefAnonRecs (OPT_Node n) +{ + OPT_Object o = NIL; + OPT_Struct typ = NIL; + while ((n != NIL && n->class == 14)) { + typ = n->typ; + if ((typ->strobj == NIL && (OPM_currFile == 1 || typ->ref < 255))) { + OPC_DefineType(typ); + __NEW(o, OPT_ObjDesc); + o->typ = typ; + o->name[0] = 0x00; + OPC_DeclareBase(o); + OPC_EndStat(); + OPM_WriteLn(); + } + n = n->link; + } +} + +void OPC_TDescDecl (OPT_Struct typ) +{ + LONGINT nofptrs; + OPT_Object o = NIL; + OPC_BegStat(); + OPM_WriteString((CHAR*)"__TDESC(", (LONGINT)9); + OPC_Andent(typ); + OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1); + OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ)); + OPM_Write('\"'); + if (typ->strobj != NIL) { + OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256))); + } + OPC_Str1((CHAR*)"\", #), {", (LONGINT)9, typ->size); + nofptrs = 0; + OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs); + OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (LONGINT)OPM_LIntSize)); + OPC_EndStat(); +} + +void OPC_InitTDesc (OPT_Struct typ) +{ + OPC_BegStat(); + OPM_WriteString((CHAR*)"__INITYP(", (LONGINT)10); + OPC_Andent(typ); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (typ->BaseTyp != NIL) { + OPC_Andent(typ->BaseTyp); + } else { + OPC_Andent(typ); + } + OPC_Str1((CHAR*)", #)", (LONGINT)5, typ->extlev); + OPC_EndStat(); + if (typ->strobj != NIL) { + OPC_InitTProcs(typ->strobj, typ->link); + } +} + +void OPC_Align (LONGINT *adr, LONGINT base) +{ + switch (base) { + case 2: + *adr += __MASK(*adr, -2); + break; + case 4: + *adr += __MASK(-*adr, -4); + break; + case 8: + *adr += __MASK(-*adr, -8); + break; + case 16: + *adr += __MASK(-*adr, -16); + break; + default: + break; + } +} + +LONGINT OPC_Base (OPT_Struct typ) +{ + LONGINT _o_result; + switch (typ->form) { + case 1: + _o_result = 1; + return _o_result; + break; + case 3: + _o_result = OPM_CharAlign; + return _o_result; + break; + case 2: + _o_result = OPM_BoolAlign; + return _o_result; + break; + case 4: + _o_result = OPM_SIntAlign; + return _o_result; + break; + case 5: + _o_result = OPM_IntAlign; + return _o_result; + break; + case 6: + _o_result = OPM_LIntAlign; + return _o_result; + break; + case 7: + _o_result = OPM_RealAlign; + return _o_result; + break; + case 8: + _o_result = OPM_LRealAlign; + return _o_result; + break; + case 9: + _o_result = OPM_SetAlign; + return _o_result; + break; + case 13: + _o_result = OPM_PointerAlign; + return _o_result; + break; + case 14: + _o_result = OPM_ProcAlign; + return _o_result; + break; + case 15: + if (typ->comp == 4) { + _o_result = __MASK(typ->align, -65536); + return _o_result; + } else { + _o_result = OPC_Base(typ->BaseTyp); + return _o_result; + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPC.Base, typ^form = ", (LONGINT)40); + OPM_LogWNum(typ->form, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + __RETCHK; +} + +static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign) +{ + LONGINT adr; + adr = off; + OPC_Align(&adr, align); + if ((*curAlign < align && gap - (adr - off) >= align)) { + gap -= (adr - off) + align; + OPC_BegStat(); + if (align == (LONGINT)OPM_IntSize) { + OPM_WriteString((CHAR*)"INTEGER", (LONGINT)8); + } else if (align == (LONGINT)OPM_LIntSize) { + OPM_WriteString((CHAR*)"LONGINT", (LONGINT)8); + } else if (align == (LONGINT)OPM_LRealSize) { + OPM_WriteString((CHAR*)"LONGREAL", (LONGINT)9); + } + OPC_Str1((CHAR*)" _prvt#", (LONGINT)8, *n); + *n += 1; + OPC_EndStat(); + *curAlign = align; + } + if (gap > 0) { + OPC_BegStat(); + OPC_Str1((CHAR*)"char _prvt#", (LONGINT)12, *n); + *n += 1; + OPC_Str1((CHAR*)"[#]", (LONGINT)4, gap); + OPC_EndStat(); + } +} + +static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *n, LONGINT *curAlign) +{ + OPT_Object fld = NIL; + OPT_Struct base = NIL; + LONGINT gap, adr, align, fldAlign; + fld = typ->link; + align = __MASK(typ->align, -65536); + if (typ->BaseTyp != NIL) { + OPC_FieldList(typ->BaseTyp, 0, &*off, &*n, &*curAlign); + } else { + *off = 0; + *n = 0; + *curAlign = 1; + } + while ((fld != NIL && fld->mode == 4)) { + if ((OPM_currFile == 0 && fld->vis == 0) || (((OPM_currFile == 1 && fld->vis == 0)) && typ->mno != 0)) { + fld = fld->link; + while ((((fld != NIL && fld->mode == 4)) && fld->vis == 0)) { + fld = fld->link; + } + } else { + adr = *off; + fldAlign = OPC_Base(fld->typ); + OPC_Align(&adr, fldAlign); + gap = fld->adr - adr; + if (fldAlign > *curAlign) { + *curAlign = fldAlign; + } + if (gap > 0) { + OPC_FillGap(gap, *off, align, &*n, &*curAlign); + } + OPC_BegStat(); + OPC_DeclareBase(fld); + OPM_Write(' '); + OPC_DeclareObj(fld, 0); + *off = fld->adr + fld->typ->size; + base = fld->typ; + fld = fld->link; + while ((((((((fld != NIL && fld->mode == 4)) && fld->typ == base)) && fld->adr == *off)) && ((OPM_currFile == 1 || fld->vis != 0) || fld->typ->strobj == NIL))) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_DeclareObj(fld, 0); + *off = fld->adr + fld->typ->size; + fld = fld->link; + } + OPC_EndStat(); + } + } + if (last) { + adr = typ->size - (LONGINT)__ASHR(typ->sysflag, 8); + if (adr == 0) { + gap = 1; + } else { + gap = adr - *off; + } + if (gap > 0) { + OPC_FillGap(gap, *off, align, &*n, &*curAlign); + } + } +} + +static void OPC_IdentList (OPT_Object obj, INTEGER vis) +{ + OPT_Struct base = NIL; + BOOLEAN first; + INTEGER lastvis; + base = NIL; + first = 1; + while ((obj != NIL && obj->mode != 13)) { + if ((__IN(vis, 0x05) || (vis == 1 && obj->vis != 0)) || (vis == 3 && !obj->leaf)) { + if (obj->typ != base || (int)obj->vis != lastvis) { + if (!first) { + OPC_EndStat(); + } + first = 0; + base = obj->typ; + lastvis = obj->vis; + OPC_BegStat(); + if ((vis == 1 && obj->vis != 0)) { + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + } else if ((obj->mnolev == 0 && vis == 0)) { + if (obj->vis == 0) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + } + } + if ((((vis == 2 && obj->mode == 1)) && base->form == 7)) { + OPM_WriteString((CHAR*)"double", (LONGINT)7); + } else { + OPC_DeclareBase(obj); + } + } else { + OPM_Write(','); + } + OPM_Write(' '); + if ((((vis == 2 && obj->mode == 1)) && base->form == 7)) { + OPM_Write('_'); + } + OPC_DeclareObj(obj, vis == 3); + if (obj->typ->comp == 3) { + OPC_EndStat(); + OPC_BegStat(); + base = OPT_linttyp; + OPM_WriteString((CHAR*)"LONGINT ", (LONGINT)9); + OPC_LenList(obj, 0, 1); + } else if ((obj->mode == 2 && obj->typ->comp == 4)) { + OPC_EndStat(); + OPC_BegStat(); + OPM_WriteString((CHAR*)"LONGINT *", (LONGINT)10); + OPC_Ident(obj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + base = NIL; + } else if ((((((OPC_ptrinit && vis == 0)) && obj->mnolev > 0)) && obj->typ->form == 13)) { + OPM_WriteString((CHAR*)" = NIL", (LONGINT)7); + } + } + obj = obj->link; + } + if (!first) { + OPC_EndStat(); + } +} + +static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames) +{ + CHAR name[32]; + OPM_Write('('); + if (obj == NIL || obj->mode == 13) { + OPM_WriteString((CHAR*)"void", (LONGINT)5); + } else { + for (;;) { + OPC_DeclareBase(obj); + if (showParamNames) { + OPM_Write(' '); + OPC_DeclareObj(obj, 0); + } else { + __COPY(obj->name, name, ((LONGINT)(32))); + obj->name[0] = 0x00; + OPC_DeclareObj(obj, 0); + __COPY(name, obj->name, ((LONGINT)(256))); + } + if (obj->typ->comp == 3) { + OPM_WriteString((CHAR*)", LONGINT ", (LONGINT)11); + OPC_LenList(obj, 1, showParamNames); + } else if ((obj->mode == 2 && obj->typ->comp == 4)) { + OPM_WriteString((CHAR*)", LONGINT *", (LONGINT)12); + if (showParamNames) { + OPC_Ident(obj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } + } + if (obj->link == NIL || obj->link->mode == 13) { + break; + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + obj = obj->link; + } + } + OPM_Write(')'); +} + +static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define) +{ + if (proc->typ == OPT_notyp) { + OPM_WriteString((CHAR*)"void", (LONGINT)5); + } else { + OPC_Ident(proc->typ->strobj); + } + OPM_Write(' '); + OPC_Ident(proc); + OPM_Write(' '); + if (OPC_ansi) { + OPC_AnsiParamList(proc->link, 1); + if (!define) { + OPM_Write(';'); + } + OPM_WriteLn(); + } else if (define) { + OPC_DeclareParams(proc->link, 0); + OPM_WriteLn(); + OPC_Indent(1); + OPC_IdentList(proc->link, 2); + OPC_Indent(-1); + } else { + OPM_WriteString((CHAR*)"();", (LONGINT)4); + OPM_WriteLn(); + } +} + +static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis) +{ + if (obj != NIL) { + OPC_ProcPredefs(obj->left, vis); + if ((((__IN(obj->mode, 0xc0) && obj->vis >= vis)) && (obj->history != 4 || obj->mode == 6))) { + if (vis == 1) { + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + } else if (obj->vis == 0) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + } + OPC_ProcHeader(obj, 0); + } + OPC_ProcPredefs(obj->right, vis); + } +} + +static void OPC_Include (CHAR *name, LONGINT name__len) +{ + __DUP(name, name__len, CHAR); + OPM_WriteString((CHAR*)"#include ", (LONGINT)10); + OPM_Write('\"'); + OPM_WriteStringVar((void*)name, name__len); + OPM_WriteString((CHAR*)".h", (LONGINT)3); + OPM_Write('\"'); + OPM_WriteLn(); + __DEL(name); +} + +static void OPC_IncludeImports (OPT_Object obj, INTEGER vis) +{ + if (obj != NIL) { + OPC_IncludeImports(obj->left, vis); + if ((((obj->mode == 11 && obj->mnolev != 0)) && (int)OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->vis >= vis)) { + OPC_Include(OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + } + OPC_IncludeImports(obj->right, vis); + } +} + +static void OPC_GenDynTypes (OPT_Node n, INTEGER vis) +{ + OPT_Struct typ = NIL; + while ((n != NIL && n->class == 14)) { + typ = n->typ; + if (vis == 0 || typ->ref < 255) { + OPC_BegStat(); + if (vis == 1) { + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + } else if ((typ->strobj != NIL && typ->strobj->mnolev > 0)) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + } + OPM_WriteString((CHAR*)"LONGINT *", (LONGINT)10); + OPC_Andent(typ); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPC_EndStat(); + } + n = n->link; + } +} + +void OPC_GenHdr (OPT_Node n) +{ + OPM_currFile = 0; + OPC_DefAnonRecs(n); + OPC_TypeDefs(OPT_topScope->right, 1); + OPM_WriteLn(); + OPC_IdentList(OPT_topScope->scope, 1); + OPM_WriteLn(); + OPC_GenDynTypes(n, 1); + OPM_WriteLn(); + OPC_ProcPredefs(OPT_topScope->right, 1); + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + OPM_WriteString((CHAR*)"void *", (LONGINT)7); + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + OPM_WriteString(OPC_BodyNameExt, ((LONGINT)(13))); + OPC_EndStat(); + OPM_WriteLn(); + OPC_CProcDefs(OPT_topScope->right, 1); + OPM_WriteLn(); + OPM_WriteString((CHAR*)"#endif", (LONGINT)7); + OPM_WriteLn(); +} + +static void OPC_GenHeaderMsg (void) +{ + INTEGER i; + OPM_WriteString((CHAR*)"/*", (LONGINT)3); + OPM_WriteString((CHAR*)" voc ", (LONGINT)6); + OPM_Write(' '); + OPM_WriteString((CHAR*)"1.2 [2016/06/15] for gcc LP64 on cygwin", (LONGINT)40); + OPM_Write(' '); + i = 0; + while (i <= 63) { + if (__IN(i, OPM_glbopt)) { + switch (i) { + case 0: + OPM_Write('x'); + break; + case 2: + OPM_Write('r'); + break; + case 3: + OPM_Write('t'); + break; + case 4: + OPM_Write('s'); + break; + case 5: + OPM_Write('p'); + break; + case 6: + OPM_Write('k'); + break; + case 7: + OPM_Write('a'); + break; + case 9: + OPM_Write('e'); + break; + case 10: + OPM_Write('m'); + break; + case 13: + OPM_Write('S'); + break; + case 14: + OPM_Write('c'); + break; + case 15: + OPM_Write('M'); + break; + case 16: + OPM_Write('f'); + break; + case 17: + OPM_Write('F'); + break; + case 18: + OPM_Write('v'); + break; + default: + OPM_LogWStr((CHAR*)"( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg", (LONGINT)126); + OPM_LogWLn(); + break; + } + } + i += 1; + } + OPM_WriteString((CHAR*)" */", (LONGINT)4); + OPM_WriteLn(); +} + +void OPC_GenHdrIncludes (void) +{ + OPM_currFile = 2; + OPC_GenHeaderMsg(); + OPM_WriteLn(); + OPM_WriteString((CHAR*)"#ifndef ", (LONGINT)9); + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + OPM_WriteString((CHAR*)"__h", (LONGINT)4); + OPM_WriteLn(); + OPM_WriteString((CHAR*)"#define ", (LONGINT)9); + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + OPM_WriteString((CHAR*)"__h", (LONGINT)4); + OPM_WriteLn(); + OPM_WriteLn(); + if (OPM_LIntSize == 8) { + OPM_WriteString((CHAR*)"#define LARGE", (LONGINT)14); + OPM_WriteLn(); + } + OPC_Include((CHAR*)"SYSTEM", (LONGINT)7); + OPC_IncludeImports(OPT_topScope->right, 1); + OPM_WriteLn(); +} + +void OPC_GenBdy (OPT_Node n) +{ + OPM_currFile = 1; + OPC_GenHeaderMsg(); + if (OPM_LIntSize == 8) { + OPM_WriteString((CHAR*)"#define LARGE", (LONGINT)14); + OPM_WriteLn(); + } + OPC_Include((CHAR*)"SYSTEM", (LONGINT)7); + OPC_IncludeImports(OPT_topScope->right, 0); + OPM_WriteLn(); + OPC_DefAnonRecs(n); + OPC_TypeDefs(OPT_topScope->right, 0); + OPM_WriteLn(); + OPC_IdentList(OPT_topScope->scope, 0); + OPM_WriteLn(); + OPC_GenDynTypes(n, 0); + OPM_WriteLn(); + OPC_ProcPredefs(OPT_topScope->right, 0); + OPM_WriteLn(); + OPC_CProcDefs(OPT_topScope->right, 0); + OPM_WriteLn(); +} + +static void OPC_RegCmds (OPT_Object obj) +{ + if (obj != NIL) { + OPC_RegCmds(obj->left); + if ((obj->mode == 7 && obj->history != 4)) { + if ((((obj->vis != 0 && obj->link == NIL)) && obj->typ == OPT_notyp)) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"__REGCMD(\"", (LONGINT)11); + OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"\", ", (LONGINT)4); + OPC_Ident(obj); + OPM_Write(')'); + OPC_EndStat(); + } + } + OPC_RegCmds(obj->right); + } +} + +static void OPC_InitImports (OPT_Object obj) +{ + if (obj != NIL) { + OPC_InitImports(obj->left); + if ((obj->mode == 11 && obj->mnolev != 0)) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"__MODULE_IMPORT(", (LONGINT)17); + OPM_WriteStringVar((void*)OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + OPM_Write(')'); + OPC_EndStat(); + } + OPC_InitImports(obj->right); + } +} + +void OPC_GenEnumPtrs (OPT_Object var) +{ + OPT_Struct typ = NIL; + LONGINT n; + OPC_GlbPtrs = 0; + while (var != NIL) { + typ = var->typ; + if (OPC_NofPtrs(typ) > 0) { + if (!OPC_GlbPtrs) { + OPC_GlbPtrs = 1; + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + if (OPC_ansi) { + OPM_WriteString((CHAR*)"void EnumPtrs(void (*P)(void*))", (LONGINT)32); + } else { + OPM_WriteString((CHAR*)"void EnumPtrs(P)", (LONGINT)17); + OPM_WriteLn(); + OPM_Write(0x09); + OPM_WriteString((CHAR*)"void (*P)();", (LONGINT)13); + } + OPM_WriteLn(); + OPC_BegBlk(); + } + OPC_BegStat(); + if (typ->form == 13) { + OPM_WriteString((CHAR*)"P(", (LONGINT)3); + OPC_Ident(var); + OPM_Write(')'); + } else if (typ->comp == 4) { + OPM_WriteString((CHAR*)"__ENUMR(&", (LONGINT)10); + OPC_Ident(var); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(typ); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPC_Str1((CHAR*)", #", (LONGINT)4, typ->size); + OPM_WriteString((CHAR*)", 1, P)", (LONGINT)8); + } else if (typ->comp == 2) { + n = typ->n; + typ = typ->BaseTyp; + while (typ->comp == 2) { + n = n * typ->n; + typ = typ->BaseTyp; + } + if (typ->form == 13) { + OPM_WriteString((CHAR*)"__ENUMP(", (LONGINT)9); + OPC_Ident(var); + OPC_Str1((CHAR*)", #, P)", (LONGINT)8, n); + } else if (typ->comp == 4) { + OPM_WriteString((CHAR*)"__ENUMR(", (LONGINT)9); + OPC_Ident(var); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(typ); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPC_Str1((CHAR*)", #", (LONGINT)4, typ->size); + OPC_Str1((CHAR*)", #, P)", (LONGINT)8, n); + } + } + OPC_EndStat(); + } + var = var->link; + } + if (OPC_GlbPtrs) { + OPC_EndBlk(); + OPM_WriteLn(); + } +} + +void OPC_EnterBody (void) +{ + OPM_WriteLn(); + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + if (OPC_mainprog) { + if (OPC_ansi) { + OPM_WriteString((CHAR*)"int main(int argc, char **argv)", (LONGINT)32); + OPM_WriteLn(); + } else { + OPM_WriteString((CHAR*)"main(argc, argv)", (LONGINT)17); + OPM_WriteLn(); + OPM_Write(0x09); + OPM_WriteString((CHAR*)"int argc; char **argv;", (LONGINT)23); + OPM_WriteLn(); + } + } else { + OPM_WriteString((CHAR*)"void *", (LONGINT)7); + OPM_WriteString(OPM_modName, ((LONGINT)(32))); + OPM_WriteString(OPC_BodyNameExt, ((LONGINT)(13))); + OPM_WriteLn(); + } + OPC_BegBlk(); + OPC_BegStat(); + if (OPC_mainprog) { + OPM_WriteString((CHAR*)"__INIT(argc, argv)", (LONGINT)19); + } else { + OPM_WriteString((CHAR*)"__DEFMOD", (LONGINT)9); + } + OPC_EndStat(); + if ((OPC_mainprog && 0)) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"/*don`t do it!*/ printf(\"DEMO VERSION: DO NOT USE THIS PROGRAM FOR ANY COMMERCIAL PURPOSE\\n\")", (LONGINT)94); + OPC_EndStat(); + } + OPC_InitImports(OPT_topScope->right); + OPC_BegStat(); + if (OPC_mainprog) { + OPM_WriteString((CHAR*)"__REGMAIN(\"", (LONGINT)12); + } else { + OPM_WriteString((CHAR*)"__REGMOD(\"", (LONGINT)11); + } + OPM_WriteString(OPM_modName, ((LONGINT)(32))); + if (OPC_GlbPtrs) { + OPM_WriteString((CHAR*)"\", EnumPtrs)", (LONGINT)13); + } else { + OPM_WriteString((CHAR*)"\", 0)", (LONGINT)6); + } + OPC_EndStat(); + if (__STRCMP(OPM_modName, "SYSTEM") != 0) { + OPC_RegCmds(OPT_topScope); + } +} + +void OPC_ExitBody (void) +{ + OPC_BegStat(); + if (OPC_mainprog) { + OPM_WriteString((CHAR*)"__FINI;", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ENDMOD;", (LONGINT)10); + } + OPM_WriteLn(); + OPC_EndBlk(); +} + +void OPC_DefineInter (OPT_Object proc) +{ + OPT_Object scope = NIL; + scope = proc->scope; + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_Write(' '); + OPC_BegBlk(); + OPC_IdentList(proc->link, 3); + OPC_IdentList(scope->scope, 3); + OPC_BegStat(); + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_Write(' '); + OPM_Write('*'); + OPM_WriteString((CHAR*)"lnk", (LONGINT)4); + OPC_EndStat(); + OPC_EndBlk0(); + OPM_Write(' '); + OPM_Write('*'); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPC_EndStat(); + OPM_WriteLn(); + OPC_ProcPredefs(scope->right, 0); + OPM_WriteLn(); +} + +void OPC_EnterProc (OPT_Object proc) +{ + OPT_Object var = NIL, scope = NIL; + OPT_Struct typ = NIL; + INTEGER dim; + if (proc->vis != 1) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } + OPC_ProcHeader(proc, 1); + OPC_BegBlk(); + if (proc->typ != OPT_notyp) { + OPC_BegStat(); + OPC_Ident(proc->typ->strobj); + OPM_WriteString((CHAR*)" _o_result;", (LONGINT)12); + OPM_WriteLn(); + } + scope = proc->scope; + OPC_IdentList(scope->scope, 0); + if (!scope->leaf) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_Write(' '); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPC_EndStat(); + } + var = proc->link; + while (var != NIL) { + if ((var->typ->comp == 2 && var->mode == 1)) { + OPC_BegStat(); + if (var->typ->strobj == NIL) { + OPM_Mark(200, var->typ->txtpos); + } else { + OPC_Ident(var->typ->strobj); + } + OPM_Write(' '); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__copy", (LONGINT)7); + OPC_EndStat(); + } + var = var->link; + } + if (!OPC_ansi) { + var = proc->link; + while (var != NIL) { + if ((var->typ->form == 7 && var->mode == 1)) { + OPC_BegStat(); + OPC_Ident(var->typ->strobj); + OPM_Write(' '); + OPC_Ident(var); + OPM_WriteString((CHAR*)" = _", (LONGINT)5); + OPC_Ident(var); + OPC_EndStat(); + } + var = var->link; + } + } + var = proc->link; + while (var != NIL) { + if ((((__IN(var->typ->comp, 0x0c) && var->mode == 1)) && var->typ->sysflag == 0)) { + OPC_BegStat(); + if (var->typ->comp == 2) { + OPM_WriteString((CHAR*)"__DUPARR(", (LONGINT)10); + OPC_Ident(var); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (var->typ->strobj == NIL) { + OPM_Mark(200, var->typ->txtpos); + } else { + OPC_Ident(var->typ->strobj); + } + } else { + OPM_WriteString((CHAR*)"__DUP(", (LONGINT)7); + OPC_Ident(var); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + typ = var->typ->BaseTyp; + dim = 1; + while (typ->comp == 3) { + OPM_WriteString((CHAR*)" * ", (LONGINT)4); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + OPM_WriteInt(dim); + typ = typ->BaseTyp; + dim += 1; + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (typ->strobj == NIL) { + OPM_Mark(200, typ->txtpos); + } else { + OPC_Ident(typ->strobj); + } + } + OPM_Write(')'); + OPC_EndStat(); + } + var = var->link; + } + if (!scope->leaf) { + var = proc->link; + while (var != NIL) { + if (!var->leaf) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPC_Ident(var); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + if (__IN(var->typ->comp, 0x0c)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } else if (var->mode != 2) { + OPM_Write('&'); + } + OPC_Ident(var); + if (var->typ->comp == 3) { + typ = var->typ; + dim = 0; + do { + OPM_WriteString((CHAR*)"; ", (LONGINT)3); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + if (dim != 0) { + OPM_WriteInt(dim); + } + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + if (dim != 0) { + OPM_WriteInt(dim); + } + typ = typ->BaseTyp; + } while (!(typ->comp != 3)); + } else if ((var->mode == 2 && var->typ->comp == 4)) { + OPM_WriteString((CHAR*)"; ", (LONGINT)3); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } + OPC_EndStat(); + } + var = var->link; + } + var = scope->scope; + while (var != NIL) { + if (!var->leaf) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPC_Ident(var); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + if (var->typ->comp != 2) { + OPM_Write('&'); + } else { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } + OPC_Ident(var); + OPC_EndStat(); + } + var = var->link; + } + OPC_BegStat(); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPM_WriteString((CHAR*)"lnk", (LONGINT)4); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPC_EndStat(); + OPC_BegStat(); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPM_Write('&'); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPC_EndStat(); + } +} + +void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet) +{ + OPT_Object var = NIL; + BOOLEAN indent; + indent = eoBlock; + if ((implicitRet && proc->typ != OPT_notyp)) { + OPM_Write(0x09); + OPM_WriteString((CHAR*)"__RETCHK;", (LONGINT)10); + OPM_WriteLn(); + } else if (!eoBlock || implicitRet) { + if (!proc->scope->leaf) { + if (indent) { + OPC_BegStat(); + } else { + indent = 1; + } + OPM_WriteStringVar((void*)proc->scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPM_WriteString((CHAR*)"lnk", (LONGINT)4); + OPC_EndStat(); + } + var = proc->link; + while (var != NIL) { + if ((((var->typ->comp == 3 && var->mode == 1)) && var->typ->sysflag == 0)) { + if (indent) { + OPC_BegStat(); + } else { + indent = 1; + } + OPM_WriteString((CHAR*)"__DEL(", (LONGINT)7); + OPC_Ident(var); + OPM_Write(')'); + OPC_EndStat(); + } + var = var->link; + } + } + if (eoBlock) { + OPC_EndBlk(); + OPM_WriteLn(); + } else if (indent) { + OPC_BegStat(); + } +} + +void OPC_CompleteIdent (OPT_Object obj) +{ + INTEGER comp, level; + level = obj->mnolev; + if (obj->adr == 1) { + if (obj->typ->comp == 4) { + OPC_Ident(obj); + OPM_WriteString((CHAR*)"__", (LONGINT)3); + } else { + OPM_WriteString((CHAR*)"((", (LONGINT)3); + OPC_Ident(obj->typ->strobj); + OPM_Write(')'); + OPC_Ident(obj); + OPM_Write(')'); + } + } else if ((level != OPM_level && level > 0)) { + comp = obj->typ->comp; + if ((obj->mode != 2 && comp != 3)) { + OPM_Write('*'); + } + OPM_WriteStringVar((void*)obj->scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_WriteString((CHAR*)"->", (LONGINT)3); + OPC_Ident(obj); + } else { + OPC_Ident(obj); + } +} + +void OPC_TypeOf (OPT_Object ap) +{ + INTEGER i; + __ASSERT(ap->typ->comp == 4, 0); + if (ap->mode == 2) { + if ((int)ap->mnolev != OPM_level) { + OPM_WriteStringVar((void*)ap->scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s->", (LONGINT)5); + OPC_Ident(ap); + } else { + OPC_Ident(ap); + } + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } else if (ap->typ->strobj != NIL) { + OPC_Ident(ap->typ->strobj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } else { + OPC_Andent(ap->typ); + } +} + +void OPC_Cmp (INTEGER rel) +{ + switch (rel) { + case 9: + OPM_WriteString((CHAR*)" == ", (LONGINT)5); + break; + case 10: + OPM_WriteString((CHAR*)" != ", (LONGINT)5); + break; + case 11: + OPM_WriteString((CHAR*)" < ", (LONGINT)4); + break; + case 12: + OPM_WriteString((CHAR*)" <= ", (LONGINT)5); + break; + case 13: + OPM_WriteString((CHAR*)" > ", (LONGINT)4); + break; + case 14: + OPM_WriteString((CHAR*)" >= ", (LONGINT)5); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPC.Cmp, rel = ", (LONGINT)34); + OPM_LogWNum(rel, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } +} + +void OPC_Case (LONGINT caseVal, INTEGER form) +{ + CHAR ch; + OPM_WriteString((CHAR*)"case ", (LONGINT)6); + switch (form) { + case 3: + ch = (CHAR)caseVal; + if ((ch >= ' ' && ch <= '~')) { + OPM_Write('\''); + if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') { + OPM_Write('\\'); + OPM_Write(ch); + } else { + OPM_Write(ch); + } + OPM_Write('\''); + } else { + OPM_WriteString((CHAR*)"0x", (LONGINT)3); + OPM_WriteHex(caseVal); + } + break; + case 4: case 5: case 6: + OPM_WriteInt(caseVal); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPC.Case, form = ", (LONGINT)36); + OPM_LogWNum(form, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + OPM_WriteString((CHAR*)": ", (LONGINT)3); +} + +void OPC_SetInclude (BOOLEAN exclude) +{ + if (exclude) { + OPM_WriteString((CHAR*)" &= ~", (LONGINT)6); + } else { + OPM_WriteString((CHAR*)" |= ", (LONGINT)5); + } +} + +void OPC_Increment (BOOLEAN decrement) +{ + if (decrement) { + OPM_WriteString((CHAR*)" -= ", (LONGINT)5); + } else { + OPM_WriteString((CHAR*)" += ", (LONGINT)5); + } +} + +void OPC_Halt (LONGINT n) +{ + OPC_Str1((CHAR*)"__HALT(#)", (LONGINT)10, n); +} + +void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim) +{ + if (array->comp == 3) { + OPC_CompleteIdent(obj); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + if (dim != 0) { + OPM_WriteInt(dim); + } + } else { + while (dim > 0) { + array = array->BaseTyp; + dim -= 1; + } + OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12); + OPM_WriteInt(array->n); + OPM_WriteString((CHAR*)"))", (LONGINT)3); + } +} + +void OPC_Constant (OPT_Const con, INTEGER form) +{ + INTEGER i, len; + CHAR ch; + SET s; + LONGINT hex; + BOOLEAN skipLeading; + switch (form) { + case 1: + OPM_WriteInt(con->intval); + break; + case 2: + OPM_WriteInt(con->intval); + break; + case 3: + ch = (CHAR)con->intval; + if ((ch >= ' ' && ch <= '~')) { + OPM_Write('\''); + if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') { + OPM_Write('\\'); + } + OPM_Write(ch); + OPM_Write('\''); + } else { + OPM_WriteString((CHAR*)"0x", (LONGINT)3); + OPM_WriteHex(con->intval); + } + break; + case 4: case 5: case 6: + OPM_WriteInt(con->intval); + break; + case 7: + OPM_WriteReal(con->realval, 'f'); + break; + case 8: + OPM_WriteReal(con->realval, 0x00); + break; + case 9: + OPM_WriteString((CHAR*)"0x", (LONGINT)3); + skipLeading = 1; + s = con->setval; + i = 64; + do { + hex = 0; + do { + i -= 1; + hex = __ASHL(hex, 1); + if (__IN(i, s)) { + hex += 1; + } + } while (!(__MASK(i, -8) == 0)); + if (hex != 0 || !skipLeading) { + OPM_WriteHex(hex); + skipLeading = 0; + } + } while (!(i == 0)); + if (skipLeading) { + OPM_Write('0'); + } + break; + case 10: + OPM_Write('\"'); + len = (int)con->intval2 - 1; + i = 0; + while (i < len) { + ch = (*con->ext)[__X(i, ((LONGINT)(256)))]; + if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') { + OPM_Write('\\'); + } + OPM_Write(ch); + i += 1; + } + OPM_Write('\"'); + break; + case 11: + OPM_WriteString((CHAR*)"NIL", (LONGINT)4); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPC.Constant, form = ", (LONGINT)40); + OPM_LogWNum(form, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } +} + +static struct InitKeywords__47 { + SHORTINT *n; + struct InitKeywords__47 *lnk; +} *InitKeywords__47_s; + +static void Enter__48 (CHAR *s, LONGINT s__len); + +static void Enter__48 (CHAR *s, LONGINT s__len) +{ + INTEGER h; + __DUP(s, s__len, CHAR); + h = OPC_PerfectHash((void*)s, s__len); + OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__47_s->n; + __COPY(s, OPC_keytab[__X(*InitKeywords__47_s->n, ((LONGINT)(36)))], ((LONGINT)(9))); + *InitKeywords__47_s->n += 1; + __DEL(s); +} + +static void OPC_InitKeywords (void) +{ + SHORTINT n, i; + struct InitKeywords__47 _s; + _s.n = &n; + _s.lnk = InitKeywords__47_s; + InitKeywords__47_s = &_s; + n = 0; + i = 0; + while (i <= 104) { + OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1; + i += 1; + } + Enter__48((CHAR*)"asm", (LONGINT)4); + Enter__48((CHAR*)"auto", (LONGINT)5); + Enter__48((CHAR*)"break", (LONGINT)6); + Enter__48((CHAR*)"case", (LONGINT)5); + Enter__48((CHAR*)"char", (LONGINT)5); + Enter__48((CHAR*)"const", (LONGINT)6); + Enter__48((CHAR*)"continue", (LONGINT)9); + Enter__48((CHAR*)"default", (LONGINT)8); + Enter__48((CHAR*)"do", (LONGINT)3); + Enter__48((CHAR*)"double", (LONGINT)7); + Enter__48((CHAR*)"else", (LONGINT)5); + Enter__48((CHAR*)"enum", (LONGINT)5); + Enter__48((CHAR*)"extern", (LONGINT)7); + Enter__48((CHAR*)"export", (LONGINT)7); + Enter__48((CHAR*)"float", (LONGINT)6); + Enter__48((CHAR*)"for", (LONGINT)4); + Enter__48((CHAR*)"fortran", (LONGINT)8); + Enter__48((CHAR*)"goto", (LONGINT)5); + Enter__48((CHAR*)"if", (LONGINT)3); + Enter__48((CHAR*)"import", (LONGINT)7); + Enter__48((CHAR*)"int", (LONGINT)4); + Enter__48((CHAR*)"long", (LONGINT)5); + Enter__48((CHAR*)"register", (LONGINT)9); + Enter__48((CHAR*)"return", (LONGINT)7); + Enter__48((CHAR*)"short", (LONGINT)6); + Enter__48((CHAR*)"signed", (LONGINT)7); + Enter__48((CHAR*)"sizeof", (LONGINT)7); + Enter__48((CHAR*)"static", (LONGINT)7); + Enter__48((CHAR*)"struct", (LONGINT)7); + Enter__48((CHAR*)"switch", (LONGINT)7); + Enter__48((CHAR*)"typedef", (LONGINT)8); + Enter__48((CHAR*)"union", (LONGINT)6); + Enter__48((CHAR*)"unsigned", (LONGINT)9); + Enter__48((CHAR*)"void", (LONGINT)5); + Enter__48((CHAR*)"volatile", (LONGINT)9); + Enter__48((CHAR*)"while", (LONGINT)6); + InitKeywords__47_s = _s.lnk; +} + + +export void *OPC__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPT); + __REGMOD("OPC", 0); + __REGCMD("BegBlk", OPC_BegBlk); + __REGCMD("BegStat", OPC_BegStat); + __REGCMD("EndBlk", OPC_EndBlk); + __REGCMD("EndBlk0", OPC_EndBlk0); + __REGCMD("EndStat", OPC_EndStat); + __REGCMD("EnterBody", OPC_EnterBody); + __REGCMD("ExitBody", OPC_ExitBody); + __REGCMD("GenHdrIncludes", OPC_GenHdrIncludes); + __REGCMD("Init", OPC_Init); +/* BEGIN */ + OPC_InitKeywords(); + __ENDMOD; +} diff --git a/bootstrap/unix-88/OPC.h b/bootstrap/unix-88/OPC.h new file mode 100644 index 00000000..a91a3810 --- /dev/null +++ b/bootstrap/unix-88/OPC.h @@ -0,0 +1,50 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPC__h +#define OPC__h + +#define LARGE +#include "SYSTEM.h" +#include "OPT.h" + + + + +import void OPC_Align (LONGINT *adr, LONGINT base); +import void OPC_Andent (OPT_Struct typ); +import LONGINT OPC_Base (OPT_Struct typ); +import OPT_Object OPC_BaseTProc (OPT_Object obj); +import void OPC_BegBlk (void); +import void OPC_BegStat (void); +import void OPC_Case (LONGINT caseVal, INTEGER form); +import void OPC_Cmp (INTEGER rel); +import void OPC_CompleteIdent (OPT_Object obj); +import void OPC_Constant (OPT_Const con, INTEGER form); +import void OPC_DefineInter (OPT_Object proc); +import void OPC_EndBlk (void); +import void OPC_EndBlk0 (void); +import void OPC_EndStat (void); +import void OPC_EnterBody (void); +import void OPC_EnterProc (OPT_Object proc); +import void OPC_ExitBody (void); +import void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet); +import void OPC_GenBdy (OPT_Node n); +import void OPC_GenEnumPtrs (OPT_Object var); +import void OPC_GenHdr (OPT_Node n); +import void OPC_GenHdrIncludes (void); +import void OPC_Halt (LONGINT n); +import void OPC_Ident (OPT_Object obj); +import void OPC_Increment (BOOLEAN decrement); +import void OPC_Indent (INTEGER count); +import void OPC_Init (void); +import void OPC_InitTDesc (OPT_Struct typ); +import void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim); +import LONGINT OPC_NofPtrs (OPT_Struct typ); +import void OPC_SetInclude (BOOLEAN exclude); +import void OPC_TDescDecl (OPT_Struct typ); +import void OPC_TypeDefs (OPT_Object obj, INTEGER vis); +import void OPC_TypeOf (OPT_Object ap); +import void *OPC__init(void); + + +#endif diff --git a/bootstrap/unix-88/OPM.c b/bootstrap/unix-88/OPM.c new file mode 100644 index 00000000..798fb492 --- /dev/null +++ b/bootstrap/unix-88/OPM.c @@ -0,0 +1,1092 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "Configuration.h" +#include "Console.h" +#include "Files.h" +#include "Platform.h" +#include "Strings.h" +#include "Texts.h" +#include "errors.h" +#include "vt100.h" + +typedef + CHAR OPM_FileName[32]; + + +static CHAR OPM_SourceFileName[256]; +export INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_CharAlign, OPM_BoolAlign, OPM_SIntAlign, OPM_IntAlign, OPM_LIntAlign, OPM_SetAlign, OPM_RealAlign, OPM_LRealAlign, OPM_PointerAlign, OPM_ProcAlign, OPM_RecAlign, OPM_MaxSet; +export LONGINT OPM_MinSInt, OPM_MinInt, OPM_MinLInt, OPM_MaxSInt, OPM_MaxInt, OPM_MaxLInt, OPM_MaxIndex; +export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; +export BOOLEAN OPM_noerr; +export LONGINT OPM_curpos, OPM_errpos, OPM_breakpc; +export INTEGER OPM_currFile, OPM_level, OPM_pc, OPM_entno; +export CHAR OPM_modName[32]; +export CHAR OPM_objname[64]; +export SET OPM_opt, OPM_glbopt; +static LONGINT OPM_ErrorLineStartPos, OPM_ErrorLineLimitPos, OPM_ErrorLineNumber, OPM_lasterrpos; +static Texts_Reader OPM_inR; +static Texts_Text OPM_Log; +static Texts_Writer OPM_W; +static Files_Rider OPM_oldSF, OPM_newSF; +static Files_Rider OPM_R[3]; +static Files_File OPM_oldSFile, OPM_newSFile, OPM_HFile, OPM_BFile, OPM_HIFile; +static INTEGER OPM_S; +export BOOLEAN OPM_dontAsm, OPM_dontLink, OPM_mainProg, OPM_mainLinkStat, OPM_notColorOutput, OPM_forceNewSym, OPM_Verbose; +static CHAR OPM_OBERON[1024]; +static CHAR OPM_MODULES[1024]; + + +static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F); +export void OPM_CloseFiles (void); +export void OPM_CloseOldSym (void); +export void OPM_DeleteNewSym (void); +export void OPM_FPrint (LONGINT *fp, LONGINT val); +export void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr); +export void OPM_FPrintReal (LONGINT *fp, REAL real); +export void OPM_FPrintSet (LONGINT *fp, SET set); +static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT pos); +export void OPM_Get (CHAR *ch); +static void OPM_GetProperties (void); +static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align); +export void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len); +export void OPM_InitOptions (void); +static void OPM_LogErrMsg (INTEGER n); +export void OPM_LogW (CHAR ch); +export void OPM_LogWLn (void); +export void OPM_LogWNum (LONGINT i, LONGINT len); +export void OPM_LogWStr (CHAR *s, LONGINT s__len); +static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len); +export void OPM_Mark (INTEGER n, LONGINT pos); +static INTEGER OPM_Min (INTEGER a, INTEGER b); +export void OPM_NewSym (CHAR *modName, LONGINT modName__len); +export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done); +export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len); +export BOOLEAN OPM_OpenPar (void); +export void OPM_RegisterNewSym (void); +static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt); +static void OPM_ShowLine (LONGINT pos); +export void OPM_SymRCh (CHAR *ch); +export LONGINT OPM_SymRInt (void); +export void OPM_SymRLReal (LONGREAL *lr); +export void OPM_SymRReal (REAL *r); +export void OPM_SymRSet (SET *s); +export void OPM_SymWCh (CHAR ch); +export void OPM_SymWInt (LONGINT i); +export void OPM_SymWLReal (LONGREAL lr); +export void OPM_SymWReal (REAL r); +export void OPM_SymWSet (SET s); +static void OPM_VerboseListSizes (void); +export void OPM_Write (CHAR ch); +export void OPM_WriteHex (LONGINT i); +export void OPM_WriteInt (LONGINT i); +export void OPM_WriteLn (void); +export void OPM_WriteReal (LONGREAL r, CHAR suffx); +export void OPM_WriteString (CHAR *s, LONGINT s__len); +export void OPM_WriteStringVar (CHAR *s, LONGINT s__len); +export BOOLEAN OPM_eofSF (void); +export void OPM_err (INTEGER n); +static LONGINT OPM_minus (LONGINT i); +static LONGINT OPM_power0 (LONGINT i, LONGINT j); + + +void OPM_LogW (CHAR ch) +{ + Console_Char(ch); +} + +void OPM_LogWStr (CHAR *s, LONGINT s__len) +{ + __DUP(s, s__len, CHAR); + Console_String(s, s__len); + __DEL(s); +} + +void OPM_LogWNum (LONGINT i, LONGINT len) +{ + Console_Int(i, len); +} + +void OPM_LogWLn (void) +{ + Console_Ln(); +} + +static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt) +{ + INTEGER i; + i = 1; + while (s[__X(i, s__len)] != 0x00) { + switch (s[__X(i, s__len)]) { + case 'e': + *opt = *opt ^ 0x0200; + break; + case 's': + *opt = *opt ^ 0x10; + break; + case 'm': + *opt = *opt ^ 0x0400; + break; + case 'x': + *opt = *opt ^ 0x01; + break; + case 'r': + *opt = *opt ^ 0x04; + break; + case 't': + *opt = *opt ^ 0x08; + break; + case 'a': + *opt = *opt ^ 0x80; + break; + case 'k': + *opt = *opt ^ 0x40; + break; + case 'p': + *opt = *opt ^ 0x20; + break; + case 'S': + *opt = *opt ^ 0x2000; + break; + case 'c': + *opt = *opt ^ 0x4000; + break; + case 'M': + *opt = *opt ^ 0x8000; + break; + case 'f': + *opt = *opt ^ 0x010000; + break; + case 'F': + *opt = *opt ^ 0x020000; + break; + case 'V': + *opt = *opt ^ 0x040000; + break; + case 'B': + if (s[__X(i + 1, s__len)] != 0x00) { + i += 1; + OPM_IntSize = (int)s[__X(i, s__len)] - 48; + } + if (s[__X(i + 1, s__len)] != 0x00) { + i += 1; + OPM_PointerSize = (int)s[__X(i, s__len)] - 48; + } + if (s[__X(i + 1, s__len)] != 0x00) { + i += 1; + OPM_Alignment = (int)s[__X(i, s__len)] - 48; + } + __ASSERT(OPM_IntSize == 2 || OPM_IntSize == 4, 0); + __ASSERT(OPM_PointerSize == 4 || OPM_PointerSize == 8, 0); + __ASSERT(OPM_Alignment == 4 || OPM_Alignment == 8, 0); + break; + default: + OPM_LogWStr((CHAR*)" warning: option ", (LONGINT)19); + OPM_LogW('-'); + OPM_LogW(s[__X(i, s__len)]); + OPM_LogWStr((CHAR*)" ignored", (LONGINT)9); + OPM_LogWLn(); + break; + } + i += 1; + } +} + +BOOLEAN OPM_OpenPar (void) +{ + BOOLEAN _o_result; + CHAR s[256]; + if (Platform_ArgCount == 1) { + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Vishap Oberon-2 compiler v", (LONGINT)27); + OPM_LogWStr((CHAR*)"1.2 [2016/06/15] for gcc LP64 on cygwin", (LONGINT)40); + OPM_LogW('.'); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Based on Ofront by Software Templ OEG, continued by Norayr Chilingarian and others.", (LONGINT)84); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Usage:", (LONGINT)7); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + OPM_LogWStr((CHAR*)"voc", (LONGINT)4); + OPM_LogWStr((CHAR*)" options {files {options}}.", (LONGINT)28); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Where options = [\"-\" {option} ].", (LONGINT)33); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" m - generate code for main module", (LONGINT)36); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" M - generate code for main module and link object statically", (LONGINT)63); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" s - generate new symbol file", (LONGINT)31); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" e - allow extending the module interface", (LONGINT)43); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" r - check value ranges", (LONGINT)25); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" a - don\'t check ASSERTs at runtime, use this option in tested production code", (LONGINT)80); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" t - don\'t check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" S - don\'t call external assembler/compiler, only generate C code", (LONGINT)67); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" c - don\'t call linker", (LONGINT)24); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" f - don\'t use color output", (LONGINT)29); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" V - verbose output", (LONGINT)21); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Initial options specify defaults for all files.", (LONGINT)48); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Options following a filename are specific to that file.", (LONGINT)56); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Repeating an option toggles its value.", (LONGINT)39); + OPM_LogWLn(); + _o_result = 0; + return _o_result; + } else { + OPM_S = 1; + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + OPM_glbopt = 0xe9; + while (s[0] == '-') { + OPM_ScanOptions((void*)s, ((LONGINT)(256)), &OPM_glbopt); + OPM_S += 1; + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + } + _o_result = 1; + return _o_result; + } + __RETCHK; +} + +void OPM_InitOptions (void) +{ + CHAR s[256]; + OPM_opt = OPM_glbopt; + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + while (s[0] == '-') { + OPM_ScanOptions((void*)s, ((LONGINT)(256)), &OPM_opt); + OPM_S += 1; + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + } + OPM_dontAsm = __IN(13, OPM_opt); + OPM_dontLink = __IN(14, OPM_opt); + OPM_mainProg = __IN(10, OPM_opt); + OPM_mainLinkStat = __IN(15, OPM_opt); + OPM_notColorOutput = __IN(16, OPM_opt); + OPM_forceNewSym = __IN(17, OPM_opt); + OPM_Verbose = __IN(18, OPM_opt); + if (OPM_mainLinkStat) { + OPM_glbopt |= __SETOF(10); + } + OPM_GetProperties(); +} + +void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len) +{ + Texts_Text T = NIL; + LONGINT beg, end, time; + CHAR s[256]; + *done = 0; + OPM_curpos = 0; + if (OPM_S >= Platform_ArgCount) { + return; + } + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + __NEW(T, Texts_TextDesc); + Texts_Open(T, s, ((LONGINT)(256))); + OPM_LogWStr(s, ((LONGINT)(256))); + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + __COPY(s, mname, mname__len); + __COPY(s, OPM_SourceFileName, ((LONGINT)(256))); + if (T->len == 0) { + OPM_LogWStr(s, ((LONGINT)(256))); + OPM_LogWStr((CHAR*)" not found.", (LONGINT)12); + OPM_LogWLn(); + } else { + Texts_OpenReader(&OPM_inR, Texts_Reader__typ, T, ((LONGINT)(0))); + *done = 1; + } + OPM_S += 1; + OPM_level = 0; + OPM_noerr = 1; + OPM_errpos = OPM_curpos; + OPM_lasterrpos = OPM_curpos - 10; + OPM_ErrorLineStartPos = 0; + OPM_ErrorLineLimitPos = 0; + OPM_ErrorLineNumber = 0; +} + +void OPM_Get (CHAR *ch) +{ + Texts_Read(&OPM_inR, Texts_Reader__typ, &*ch); + if (*ch == 0x0d) { + OPM_curpos = Texts_Pos(&OPM_inR, Texts_Reader__typ); + } else { + OPM_curpos += 1; + } + if ((*ch < 0x09 && !OPM_inR.eot)) { + *ch = ' '; + } +} + +static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len) +{ + INTEGER i, j; + CHAR ch; + __DUP(ext, ext__len, CHAR); + i = 0; + for (;;) { + ch = name[__X(i, name__len)]; + if (ch == 0x00) { + break; + } + FName[__X(i, FName__len)] = ch; + i += 1; + } + j = 0; + do { + ch = ext[__X(j, ext__len)]; + FName[__X(i, FName__len)] = ch; + i += 1; + j += 1; + } while (!(ch == 0x00)); + __DEL(ext); +} + +static void OPM_LogErrMsg (INTEGER n) +{ + Texts_Scanner S; + Texts_Text T = NIL; + CHAR ch; + INTEGER i; + CHAR buf[1024]; + if (n >= 0) { + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"31m", (LONGINT)4); + } + OPM_LogWStr((CHAR*)" err ", (LONGINT)7); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + } else { + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"35m", (LONGINT)4); + } + OPM_LogWStr((CHAR*)" warning ", (LONGINT)11); + n = -n; + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + } + OPM_LogWNum(n, ((LONGINT)(1))); + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + OPM_LogWStr(errors_errors[__X(n, ((LONGINT)(350)))], ((LONGINT)(128))); +} + +static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT pos) +{ + CHAR ch, cheol; + if (pos < OPM_ErrorLineStartPos) { + OPM_ErrorLineStartPos = 0; + OPM_ErrorLineLimitPos = 0; + OPM_ErrorLineNumber = 0; + } + if (pos < OPM_ErrorLineLimitPos) { + Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos); + return; + } + Files_Set(&*r, r__typ, f, OPM_ErrorLineLimitPos); + Files_Read(&*r, r__typ, (void*)&ch); + while ((OPM_ErrorLineLimitPos < pos && !(*r).eof)) { + OPM_ErrorLineStartPos = OPM_ErrorLineLimitPos; + OPM_ErrorLineNumber += 1; + while ((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) { + Files_Read(&*r, r__typ, (void*)&ch); + OPM_ErrorLineLimitPos += 1; + } + cheol = ch; + Files_Read(&*r, r__typ, (void*)&ch); + OPM_ErrorLineLimitPos += 1; + if ((cheol == 0x0d && ch == 0x0a)) { + OPM_ErrorLineLimitPos += 1; + Files_Read(&*r, r__typ, (void*)&ch); + } + } + Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos); +} + +static void OPM_ShowLine (LONGINT pos) +{ + Files_File f = NIL; + Files_Rider r; + CHAR line[1023]; + INTEGER i; + CHAR ch; + f = Files_Old(OPM_SourceFileName, ((LONGINT)(256))); + OPM_FindLine(f, &r, Files_Rider__typ, pos); + i = 0; + Files_Read(&r, Files_Rider__typ, (void*)&ch); + while ((((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) && i < 1022)) { + line[__X(i, ((LONGINT)(1023)))] = ch; + i += 1; + Files_Read(&r, Files_Rider__typ, (void*)&ch); + } + line[__X(i, ((LONGINT)(1023)))] = 0x00; + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWNum(OPM_ErrorLineNumber, ((LONGINT)(4))); + OPM_LogWStr((CHAR*)": ", (LONGINT)3); + OPM_LogWStr(line, ((LONGINT)(1023))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" ", (LONGINT)7); + if (pos >= OPM_ErrorLineLimitPos) { + pos = OPM_ErrorLineLimitPos - 1; + } + i = (int)(pos - OPM_ErrorLineStartPos); + while (i > 0) { + OPM_LogW(' '); + i -= 1; + } + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"32m", (LONGINT)4); + } + OPM_LogW('^'); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + Files_Close(f); +} + +void OPM_Mark (INTEGER n, LONGINT pos) +{ + if (pos == -1) { + pos = 0; + } + if (n >= 0) { + OPM_noerr = 0; + if (pos < OPM_lasterrpos || OPM_lasterrpos + 9 < pos) { + OPM_lasterrpos = pos; + OPM_ShowLine(pos); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + if (n < 249) { + OPM_LogWStr((CHAR*)" pos", (LONGINT)6); + OPM_LogWNum(pos, ((LONGINT)(6))); + OPM_LogErrMsg(n); + } else if (n == 255) { + OPM_LogWStr((CHAR*)"pos", (LONGINT)4); + OPM_LogWNum(pos, ((LONGINT)(6))); + OPM_LogWStr((CHAR*)" pc ", (LONGINT)6); + OPM_LogWNum(OPM_breakpc, ((LONGINT)(1))); + } else if (n == 254) { + OPM_LogWStr((CHAR*)"pc not found", (LONGINT)13); + } else { + OPM_LogWStr(OPM_objname, ((LONGINT)(64))); + if (n == 253) { + OPM_LogWStr((CHAR*)" is new, compile with option e", (LONGINT)31); + } else if (n == 252) { + OPM_LogWStr((CHAR*)" is redefined, compile with option s", (LONGINT)37); + } else if (n == 251) { + OPM_LogWStr((CHAR*)" is redefined (private part only), compile with option s", (LONGINT)57); + } else if (n == 250) { + OPM_LogWStr((CHAR*)" is no longer visible, compile with option s", (LONGINT)45); + } else if (n == 249) { + OPM_LogWStr((CHAR*)" is not consistently imported, recompile imports", (LONGINT)49); + } + } + } + } else { + if (pos >= 0) { + OPM_ShowLine(pos); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" pos", (LONGINT)6); + OPM_LogWNum(pos, ((LONGINT)(6))); + } + OPM_LogErrMsg(n); + if (pos < 0) { + OPM_LogWLn(); + } + } +} + +void OPM_err (INTEGER n) +{ + OPM_Mark(n, OPM_errpos); +} + +void OPM_FPrint (LONGINT *fp, LONGINT val) +{ + *fp = __ROTL((LONGINT)((SET)*fp ^ (SET)val), 1, LONGINT); +} + +void OPM_FPrintSet (LONGINT *fp, SET set) +{ + OPM_FPrint(&*fp, (LONGINT)set); +} + +void OPM_FPrintReal (LONGINT *fp, REAL real) +{ + OPM_FPrint(&*fp, __VAL(LONGINT, real)); +} + +void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr) +{ + LONGINT l, h; + __GET((LONGINT)(uintptr_t)&lr, l, LONGINT); + __GET((LONGINT)(uintptr_t)&lr + 4, h, LONGINT); + OPM_FPrint(&*fp, l); + OPM_FPrint(&*fp, h); +} + +static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align) +{ + __DUP(name, name__len, CHAR); + if (((*S).class == 1 && __STRCMP((*S).s, name) == 0)) { + Texts_Scan(&*S, S__typ); + if ((*S).class == 3) { + *size = (int)(*S).i; + Texts_Scan(&*S, S__typ); + } else { + OPM_Mark(-157, ((LONGINT)(-1))); + } + if ((*S).class == 3) { + *align = (int)(*S).i; + Texts_Scan(&*S, S__typ); + } else { + OPM_Mark(-157, ((LONGINT)(-1))); + } + } else { + OPM_Mark(-157, ((LONGINT)(-1))); + } + __DEL(name); +} + +static LONGINT OPM_minus (LONGINT i) +{ + LONGINT _o_result; + _o_result = -i; + return _o_result; +} + +static LONGINT OPM_power0 (LONGINT i, LONGINT j) +{ + LONGINT _o_result; + LONGINT k, p; + k = 1; + p = i; + do { + p = p * i; + k += 1; + } while (!(k == j)); + _o_result = p; + return _o_result; +} + +static void OPM_VerboseListSizes (void) +{ + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Type Size Alignement", (LONGINT)29); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"CHAR ", (LONGINT)14); + OPM_LogWNum(OPM_CharSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_CharAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"BOOLEAN ", (LONGINT)14); + OPM_LogWNum(OPM_BoolSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_BoolAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"SHORTINT ", (LONGINT)14); + OPM_LogWNum(OPM_SIntSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_SIntAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"INTEGER ", (LONGINT)14); + OPM_LogWNum(OPM_IntSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_IntAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"LONGINT ", (LONGINT)14); + OPM_LogWNum(OPM_LIntSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_LIntAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"SET ", (LONGINT)14); + OPM_LogWNum(OPM_SetSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_SetAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"REAL ", (LONGINT)14); + OPM_LogWNum(OPM_RealSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_RealAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"LONGREAL ", (LONGINT)14); + OPM_LogWNum(OPM_LRealSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_LRealAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"PTR ", (LONGINT)14); + OPM_LogWNum(OPM_PointerSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_PointerAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"PROC ", (LONGINT)14); + OPM_LogWNum(OPM_ProcSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_ProcAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"RECORD ", (LONGINT)14); + OPM_LogWNum(OPM_RecSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_RecAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Min shortint ", (LONGINT)14); + OPM_LogWNum(OPM_MinSInt, ((LONGINT)(4))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Max shortint ", (LONGINT)14); + OPM_LogWNum(OPM_MaxSInt, ((LONGINT)(4))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Min integer ", (LONGINT)14); + OPM_LogWNum(OPM_MinInt, ((LONGINT)(4))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Max integer ", (LONGINT)14); + OPM_LogWNum(OPM_MaxInt, ((LONGINT)(4))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Min longint ", (LONGINT)14); + OPM_LogWNum(OPM_MinLInt, ((LONGINT)(4))); + OPM_LogWLn(); +} + +static INTEGER OPM_Min (INTEGER a, INTEGER b) +{ + INTEGER _o_result; + if (a < b) { + _o_result = a; + return _o_result; + } else { + _o_result = b; + return _o_result; + } + __RETCHK; +} + +static void OPM_GetProperties (void) +{ + LONGINT base; + OPM_ProcSize = OPM_PointerSize; + OPM_LIntSize = __ASHL(OPM_IntSize, 1); + OPM_SetSize = OPM_LIntSize; + OPM_CharAlign = OPM_Min(OPM_Alignment, OPM_CharSize); + OPM_BoolAlign = OPM_Min(OPM_Alignment, OPM_BoolSize); + OPM_SIntAlign = OPM_Min(OPM_Alignment, OPM_SIntSize); + OPM_RecAlign = OPM_Min(OPM_Alignment, OPM_RecSize); + OPM_RealAlign = OPM_Min(OPM_Alignment, OPM_RealSize); + OPM_LRealAlign = OPM_Min(OPM_Alignment, OPM_LRealSize); + OPM_PointerAlign = OPM_Min(OPM_Alignment, OPM_PointerSize); + OPM_ProcAlign = OPM_Min(OPM_Alignment, OPM_ProcSize); + OPM_IntAlign = OPM_Min(OPM_Alignment, OPM_IntSize); + OPM_LIntAlign = OPM_Min(OPM_Alignment, OPM_LIntSize); + OPM_SetAlign = OPM_Min(OPM_Alignment, OPM_SetSize); + base = -2; + OPM_MinSInt = __ASH(base, __ASHL(OPM_SIntSize, 3) - 2); + OPM_MaxSInt = OPM_minus(OPM_MinSInt + 1); + OPM_MinInt = __ASH(base, __ASHL(OPM_IntSize, 3) - 2); + OPM_MaxInt = OPM_minus(OPM_MinInt + 1); + OPM_MinLInt = __ASH(base, __ASHL(OPM_LIntSize, 3) - 2); + OPM_MaxLInt = OPM_minus(OPM_MinLInt + 1); + if (OPM_RealSize == 4) { + OPM_MaxReal = 3.40282346000000e+038; + } else if (OPM_RealSize == 8) { + OPM_MaxReal = 1.79769296342094e+308; + } + if (OPM_LRealSize == 4) { + OPM_MaxLReal = 3.40282346000000e+038; + } else if (OPM_LRealSize == 8) { + OPM_MaxLReal = 1.79769296342094e+308; + } + OPM_MinReal = -OPM_MaxReal; + OPM_MinLReal = -OPM_MaxLReal; + OPM_MaxSet = __ASHL(OPM_SetSize, 3) - 1; + OPM_MaxIndex = OPM_MaxLInt; + if (OPM_Verbose) { + OPM_VerboseListSizes(); + } +} + +void OPM_SymRCh (CHAR *ch) +{ + Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&*ch); +} + +LONGINT OPM_SymRInt (void) +{ + LONGINT _o_result; + LONGINT k; + Files_ReadNum(&OPM_oldSF, Files_Rider__typ, &k); + _o_result = k; + return _o_result; +} + +void OPM_SymRSet (SET *s) +{ + Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (LONGINT*)&*s); +} + +void OPM_SymRReal (REAL *r) +{ + Files_ReadReal(&OPM_oldSF, Files_Rider__typ, &*r); +} + +void OPM_SymRLReal (LONGREAL *lr) +{ + Files_ReadLReal(&OPM_oldSF, Files_Rider__typ, &*lr); +} + +void OPM_CloseOldSym (void) +{ +} + +void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done) +{ + CHAR ch; + OPM_FileName fileName; + OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5); + OPM_oldSFile = Files_Old(fileName, ((LONGINT)(32))); + *done = OPM_oldSFile != NIL; + if (*done) { + Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, ((LONGINT)(0))); + Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ch); + if (ch != 0xf7) { + OPM_err(-306); + OPM_CloseOldSym(); + *done = 0; + } + } +} + +BOOLEAN OPM_eofSF (void) +{ + BOOLEAN _o_result; + _o_result = OPM_oldSF.eof; + return _o_result; +} + +void OPM_SymWCh (CHAR ch) +{ + Files_Write(&OPM_newSF, Files_Rider__typ, ch); +} + +void OPM_SymWInt (LONGINT i) +{ + Files_WriteNum(&OPM_newSF, Files_Rider__typ, i); +} + +void OPM_SymWSet (SET s) +{ + Files_WriteNum(&OPM_newSF, Files_Rider__typ, (LONGINT)s); +} + +void OPM_SymWReal (REAL r) +{ + Files_WriteReal(&OPM_newSF, Files_Rider__typ, r); +} + +void OPM_SymWLReal (LONGREAL lr) +{ + Files_WriteLReal(&OPM_newSF, Files_Rider__typ, lr); +} + +void OPM_RegisterNewSym (void) +{ + if (__STRCMP(OPM_modName, "SYSTEM") != 0 || __IN(10, OPM_opt)) { + Files_Register(OPM_newSFile); + } +} + +void OPM_DeleteNewSym (void) +{ +} + +void OPM_NewSym (CHAR *modName, LONGINT modName__len) +{ + OPM_FileName fileName; + OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5); + OPM_newSFile = Files_New(fileName, ((LONGINT)(32))); + if (OPM_newSFile != NIL) { + Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, ((LONGINT)(0))); + Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7); + } else { + OPM_err(153); + } +} + +void OPM_Write (CHAR ch) +{ + Files_Write(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, ch); +} + +void OPM_WriteString (CHAR *s, LONGINT s__len) +{ + INTEGER i; + i = 0; + while (s[__X(i, s__len)] != 0x00) { + i += 1; + } + Files_WriteBytes(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, (void*)s, s__len * ((LONGINT)(1)), i); +} + +void OPM_WriteStringVar (CHAR *s, LONGINT s__len) +{ + INTEGER i; + i = 0; + while (s[__X(i, s__len)] != 0x00) { + i += 1; + } + Files_WriteBytes(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, (void*)s, s__len * ((LONGINT)(1)), i); +} + +void OPM_WriteHex (LONGINT i) +{ + CHAR s[3]; + INTEGER digit; + digit = __ASHR((int)i, 4); + if (digit < 10) { + s[0] = (CHAR)(48 + digit); + } else { + s[0] = (CHAR)(87 + digit); + } + digit = __MASK((int)i, -16); + if (digit < 10) { + s[1] = (CHAR)(48 + digit); + } else { + s[1] = (CHAR)(87 + digit); + } + s[2] = 0x00; + OPM_WriteString(s, ((LONGINT)(3))); +} + +void OPM_WriteInt (LONGINT i) +{ + CHAR s[20]; + LONGINT i1, k; + if (i == OPM_MinInt || i == OPM_MinLInt) { + OPM_Write('('); + OPM_WriteInt(i + 1); + OPM_WriteString((CHAR*)"-1)", (LONGINT)4); + } else { + i1 = __ABS(i); + s[0] = (CHAR)(__MOD(i1, 10) + 48); + i1 = __DIV(i1, 10); + k = 1; + while (i1 > 0) { + s[__X(k, ((LONGINT)(20)))] = (CHAR)(__MOD(i1, 10) + 48); + i1 = __DIV(i1, 10); + k += 1; + } + if (i < 0) { + s[__X(k, ((LONGINT)(20)))] = '-'; + k += 1; + } + while (k > 0) { + k -= 1; + OPM_Write(s[__X(k, ((LONGINT)(20)))]); + } + } +} + +void OPM_WriteReal (LONGREAL r, CHAR suffx) +{ + Texts_Writer W; + Texts_Text T = NIL; + Texts_Reader R; + CHAR s[32]; + CHAR ch; + INTEGER i; + if ((((r < OPM_MaxLInt && r > OPM_MinLInt)) && r == (__ENTIER(r)))) { + if (suffx == 'f') { + OPM_WriteString((CHAR*)"(REAL)", (LONGINT)7); + } else { + OPM_WriteString((CHAR*)"(LONGREAL)", (LONGINT)11); + } + OPM_WriteInt(__ENTIER(r)); + } else { + Texts_OpenWriter(&W, Texts_Writer__typ); + if (suffx == 'f') { + Texts_WriteLongReal(&W, Texts_Writer__typ, r, 16); + } else { + Texts_WriteLongReal(&W, Texts_Writer__typ, r, 23); + } + __NEW(T, Texts_TextDesc); + Texts_Open(T, (CHAR*)"", (LONGINT)1); + Texts_Append(T, W.buf); + Texts_OpenReader(&R, Texts_Reader__typ, T, ((LONGINT)(0))); + i = 0; + Texts_Read(&R, Texts_Reader__typ, &ch); + while (ch != 0x00) { + s[__X(i, ((LONGINT)(32)))] = ch; + i += 1; + Texts_Read(&R, Texts_Reader__typ, &ch); + } + s[__X(i, ((LONGINT)(32)))] = 0x00; + i = 0; + ch = s[0]; + while ((ch != 'D' && ch != 0x00)) { + i += 1; + ch = s[__X(i, ((LONGINT)(32)))]; + } + if (ch == 'D') { + s[__X(i, ((LONGINT)(32)))] = 'e'; + } + OPM_WriteString(s, ((LONGINT)(32))); + } +} + +void OPM_WriteLn (void) +{ + Files_Write(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, 0x0a); +} + +static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F) +{ + Files_Rider R1; + CHAR buffer[4096]; + if (F != NIL) { + Files_Set(&R1, Files_Rider__typ, F, ((LONGINT)(0))); + Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, ((LONGINT)(4096)), ((LONGINT)(4096))); + while (4096 - R1.res > 0) { + Files_WriteBytes(&*R, R__typ, (void*)buffer, ((LONGINT)(4096)), 4096 - R1.res); + Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, ((LONGINT)(4096)), ((LONGINT)(4096))); + } + } +} + +void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len) +{ + CHAR FName[32]; + __COPY(moduleName, OPM_modName, ((LONGINT)(32))); + OPM_HFile = Files_New((CHAR*)"", (LONGINT)1); + if (OPM_HFile != NIL) { + Files_Set(&OPM_R[0], Files_Rider__typ, OPM_HFile, ((LONGINT)(0))); + } else { + OPM_err(153); + } + OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, ((LONGINT)(32)), (CHAR*)".c", (LONGINT)3); + OPM_BFile = Files_New(FName, ((LONGINT)(32))); + if (OPM_BFile != NIL) { + Files_Set(&OPM_R[1], Files_Rider__typ, OPM_BFile, ((LONGINT)(0))); + } else { + OPM_err(153); + } + OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, ((LONGINT)(32)), (CHAR*)".h", (LONGINT)3); + OPM_HIFile = Files_New(FName, ((LONGINT)(32))); + if (OPM_HIFile != NIL) { + Files_Set(&OPM_R[2], Files_Rider__typ, OPM_HIFile, ((LONGINT)(0))); + } else { + OPM_err(153); + } +} + +void OPM_CloseFiles (void) +{ + CHAR FName[32]; + INTEGER res; + if (OPM_noerr) { + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + OPM_LogWNum(Files_Pos(&OPM_R[1], Files_Rider__typ), ((LONGINT)(0))); + OPM_LogWStr((CHAR*)" chars.", (LONGINT)8); + } + if (OPM_noerr) { + if (__STRCMP(OPM_modName, "SYSTEM") == 0) { + if (!__IN(10, OPM_opt)) { + Files_Register(OPM_BFile); + } + } else if (!__IN(10, OPM_opt)) { + OPM_Append(&OPM_R[2], Files_Rider__typ, OPM_HFile); + Files_Register(OPM_HIFile); + Files_Register(OPM_BFile); + } else { + OPM_MakeFileName((void*)OPM_modName, ((LONGINT)(32)), (void*)FName, ((LONGINT)(32)), (CHAR*)".h", (LONGINT)3); + Files_Delete(FName, ((LONGINT)(32)), &res); + OPM_MakeFileName((void*)OPM_modName, ((LONGINT)(32)), (void*)FName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5); + Files_Delete(FName, ((LONGINT)(32)), &res); + Files_Register(OPM_BFile); + } + } + OPM_HFile = NIL; + OPM_BFile = NIL; + OPM_HIFile = NIL; + OPM_newSFile = NIL; + OPM_oldSFile = NIL; + Files_Set(&OPM_R[0], Files_Rider__typ, NIL, ((LONGINT)(0))); + Files_Set(&OPM_R[1], Files_Rider__typ, NIL, ((LONGINT)(0))); + Files_Set(&OPM_R[2], Files_Rider__typ, NIL, ((LONGINT)(0))); + Files_Set(&OPM_newSF, Files_Rider__typ, NIL, ((LONGINT)(0))); + Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, ((LONGINT)(0))); +} + +static void EnumPtrs(void (*P)(void*)) +{ + __ENUMR(&OPM_inR, Texts_Reader__typ, 96, 1, P); + P(OPM_Log); + __ENUMR(&OPM_W, Texts_Writer__typ, 72, 1, P); + __ENUMR(&OPM_oldSF, Files_Rider__typ, 40, 1, P); + __ENUMR(&OPM_newSF, Files_Rider__typ, 40, 1, P); + __ENUMR(OPM_R, Files_Rider__typ, 40, 3, P); + P(OPM_oldSFile); + P(OPM_newSFile); + P(OPM_HFile); + P(OPM_BFile); + P(OPM_HIFile); +} + + +export void *OPM__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Console); + __MODULE_IMPORT(Files); + __MODULE_IMPORT(Platform); + __MODULE_IMPORT(Strings); + __MODULE_IMPORT(Texts); + __MODULE_IMPORT(errors); + __MODULE_IMPORT(vt100); + __REGMOD("OPM", EnumPtrs); + __REGCMD("CloseFiles", OPM_CloseFiles); + __REGCMD("CloseOldSym", OPM_CloseOldSym); + __REGCMD("DeleteNewSym", OPM_DeleteNewSym); + __REGCMD("InitOptions", OPM_InitOptions); + __REGCMD("LogWLn", OPM_LogWLn); + __REGCMD("RegisterNewSym", OPM_RegisterNewSym); + __REGCMD("WriteLn", OPM_WriteLn); +/* BEGIN */ + Texts_OpenWriter(&OPM_W, Texts_Writer__typ); + OPM_MODULES[0] = 0x00; + Platform_GetEnv((CHAR*)"MODULES", (LONGINT)8, (void*)OPM_MODULES, ((LONGINT)(1024))); + __MOVE(".", OPM_OBERON, 2); + Platform_GetEnv((CHAR*)"OBERON", (LONGINT)7, (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append((CHAR*)";.;", (LONGINT)4, (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append(OPM_MODULES, ((LONGINT)(1024)), (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append((CHAR*)";", (LONGINT)2, (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append((CHAR*)"/sym;", (LONGINT)6, (void*)OPM_OBERON, ((LONGINT)(1024))); + Files_SetSearchPath(OPM_OBERON, ((LONGINT)(1024))); + OPM_CharSize = 1; + OPM_BoolSize = 1; + OPM_SIntSize = 1; + OPM_RecSize = 1; + OPM_ByteSize = 1; + OPM_RealSize = 4; + OPM_LRealSize = 8; + OPM_PointerSize = 8; + OPM_Alignment = 8; + OPM_IntSize = 4; + __ENDMOD; +} diff --git a/bootstrap/unix-88/OPM.h b/bootstrap/unix-88/OPM.h new file mode 100644 index 00000000..e09dbf82 --- /dev/null +++ b/bootstrap/unix-88/OPM.h @@ -0,0 +1,64 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPM__h +#define OPM__h + +#define LARGE +#include "SYSTEM.h" + + +import INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_CharAlign, OPM_BoolAlign, OPM_SIntAlign, OPM_IntAlign, OPM_LIntAlign, OPM_SetAlign, OPM_RealAlign, OPM_LRealAlign, OPM_PointerAlign, OPM_ProcAlign, OPM_RecAlign, OPM_MaxSet; +import LONGINT OPM_MinSInt, OPM_MinInt, OPM_MinLInt, OPM_MaxSInt, OPM_MaxInt, OPM_MaxLInt, OPM_MaxIndex; +import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; +import BOOLEAN OPM_noerr; +import LONGINT OPM_curpos, OPM_errpos, OPM_breakpc; +import INTEGER OPM_currFile, OPM_level, OPM_pc, OPM_entno; +import CHAR OPM_modName[32]; +import CHAR OPM_objname[64]; +import SET OPM_opt, OPM_glbopt; +import BOOLEAN OPM_dontAsm, OPM_dontLink, OPM_mainProg, OPM_mainLinkStat, OPM_notColorOutput, OPM_forceNewSym, OPM_Verbose; + + +import void OPM_CloseFiles (void); +import void OPM_CloseOldSym (void); +import void OPM_DeleteNewSym (void); +import void OPM_FPrint (LONGINT *fp, LONGINT val); +import void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr); +import void OPM_FPrintReal (LONGINT *fp, REAL real); +import void OPM_FPrintSet (LONGINT *fp, SET set); +import void OPM_Get (CHAR *ch); +import void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len); +import void OPM_InitOptions (void); +import void OPM_LogW (CHAR ch); +import void OPM_LogWLn (void); +import void OPM_LogWNum (LONGINT i, LONGINT len); +import void OPM_LogWStr (CHAR *s, LONGINT s__len); +import void OPM_Mark (INTEGER n, LONGINT pos); +import void OPM_NewSym (CHAR *modName, LONGINT modName__len); +import void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done); +import void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len); +import BOOLEAN OPM_OpenPar (void); +import void OPM_RegisterNewSym (void); +import void OPM_SymRCh (CHAR *ch); +import LONGINT OPM_SymRInt (void); +import void OPM_SymRLReal (LONGREAL *lr); +import void OPM_SymRReal (REAL *r); +import void OPM_SymRSet (SET *s); +import void OPM_SymWCh (CHAR ch); +import void OPM_SymWInt (LONGINT i); +import void OPM_SymWLReal (LONGREAL lr); +import void OPM_SymWReal (REAL r); +import void OPM_SymWSet (SET s); +import void OPM_Write (CHAR ch); +import void OPM_WriteHex (LONGINT i); +import void OPM_WriteInt (LONGINT i); +import void OPM_WriteLn (void); +import void OPM_WriteReal (LONGREAL r, CHAR suffx); +import void OPM_WriteString (CHAR *s, LONGINT s__len); +import void OPM_WriteStringVar (CHAR *s, LONGINT s__len); +import BOOLEAN OPM_eofSF (void); +import void OPM_err (INTEGER n); +import void *OPM__init(void); + + +#endif diff --git a/bootstrap/unix-88/OPP.c b/bootstrap/unix-88/OPP.c new file mode 100644 index 00000000..3bc74ce6 --- /dev/null +++ b/bootstrap/unix-88/OPP.c @@ -0,0 +1,1874 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "OPB.h" +#include "OPM.h" +#include "OPS.h" +#include "OPT.h" + +struct OPP__1 { + LONGINT low, high; +}; + +typedef + struct OPP__1 OPP_CaseTable[128]; + + +static SHORTINT OPP_sym, OPP_level; +static INTEGER OPP_LoopLevel; +static OPT_Node OPP_TDinit, OPP_lastTDinit; +static INTEGER OPP_nofFwdPtr; +static OPT_Struct OPP_FwdPtr[64]; + +export LONGINT *OPP__1__typ; + +static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar); +static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned); +static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq); +static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab); +static void OPP_CheckMark (SHORTINT *vis); +static void OPP_CheckSym (INTEGER s); +static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_); +static void OPP_ConstExpression (OPT_Node *x); +static void OPP_Element (OPT_Node *x); +static void OPP_Expression (OPT_Node *x); +static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b); +static void OPP_Factor (OPT_Node *x); +static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp); +export void OPP_Module (OPT_Node *prog, SET opt); +static void OPP_PointerType (OPT_Struct *typ); +static void OPP_ProcedureDeclaration (OPT_Node *x); +static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec); +static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned); +static void OPP_Sets (OPT_Node *x); +static void OPP_SimpleExpression (OPT_Node *x); +static void OPP_StandProcCall (OPT_Node *x); +static void OPP_StatSeq (OPT_Node *stat); +static void OPP_Term (OPT_Node *x); +static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned); +static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned); +static void OPP_err (INTEGER n); +static void OPP_qualident (OPT_Object *id); +static void OPP_selector (OPT_Node *x); + + +static void OPP_err (INTEGER n) +{ + OPM_err(n); +} + +static void OPP_CheckSym (INTEGER s) +{ + if ((int)OPP_sym == s) { + OPS_Get(&OPP_sym); + } else { + OPM_err(s); + } +} + +static void OPP_qualident (OPT_Object *id) +{ + OPT_Object obj = NIL; + SHORTINT lev; + OPT_Find(&obj); + OPS_Get(&OPP_sym); + if ((((OPP_sym == 18 && obj != NIL)) && obj->mode == 11)) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPT_FindImport(obj, &obj); + OPS_Get(&OPP_sym); + } else { + OPP_err(38); + obj = NIL; + } + } + if (obj == NIL) { + OPP_err(0); + obj = OPT_NewObj(); + obj->mode = 1; + obj->typ = OPT_undftyp; + obj->adr = 0; + } else { + lev = obj->mnolev; + if ((__IN(obj->mode, 0x06) && lev != OPP_level)) { + obj->leaf = 0; + if (lev > 0) { + OPB_StaticLink(OPP_level - lev); + } + } + } + *id = obj; +} + +static void OPP_ConstExpression (OPT_Node *x) +{ + OPP_Expression(&*x); + if ((*x)->class != 7) { + OPP_err(50); + *x = OPB_NewIntConst(((LONGINT)(1))); + } +} + +static void OPP_CheckMark (SHORTINT *vis) +{ + OPS_Get(&OPP_sym); + if (OPP_sym == 1 || OPP_sym == 7) { + if (OPP_level > 0) { + OPP_err(47); + } + if (OPP_sym == 1) { + *vis = 1; + } else { + *vis = 2; + } + OPS_Get(&OPP_sym); + } else { + *vis = 0; + } +} + +static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_) +{ + OPT_Node x = NIL; + LONGINT sf; + if (OPP_sym == 31) { + OPS_Get(&OPP_sym); + if (!OPT_SYSimported) { + OPP_err(135); + } + OPP_ConstExpression(&x); + if (__IN(x->typ->form, 0x70)) { + sf = x->conval->intval; + if (sf < 0 || sf > 1) { + OPP_err(220); + sf = 0; + } + } else { + OPP_err(51); + sf = 0; + } + *sysflag = (int)sf; + OPP_CheckSym(23); + } else { + *sysflag = default_; + } +} + +static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned) +{ + OPT_Object fld = NIL, first = NIL, last = NIL, base = NIL; + OPT_Struct ftyp = NIL; + INTEGER sysflag; + *typ = OPT_NewStr(15, 4); + (*typ)->BaseTyp = NIL; + OPP_CheckSysFlag(&sysflag, -1); + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPP_qualident(&base); + if ((base->mode == 5 && base->typ->comp == 4)) { + if (base->typ == *banned) { + OPP_err(58); + } else { + base->typ->pvused = 1; + (*typ)->BaseTyp = base->typ; + (*typ)->extlev = base->typ->extlev + 1; + (*typ)->sysflag = base->typ->sysflag; + } + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + OPP_CheckSym(22); + } + if (sysflag >= 0) { + (*typ)->sysflag = sysflag; + } + OPT_OpenScope(0, NIL); + first = NIL; + last = NIL; + for (;;) { + if (OPP_sym == 38) { + for (;;) { + if (OPP_sym == 38) { + if ((*typ)->BaseTyp != NIL) { + OPT_FindField(OPS_name, (*typ)->BaseTyp, &fld); + if (fld != NIL) { + OPP_err(1); + } + } + OPT_Insert(OPS_name, &fld); + OPP_CheckMark(&fld->vis); + fld->mode = 4; + fld->link = NIL; + fld->typ = OPT_undftyp; + if (first == NIL) { + first = fld; + } + if (last == NIL) { + (*typ)->link = fld; + } else { + last->link = fld; + } + last = fld; + } else { + OPP_err(38); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(19); + } else { + break; + } + } + OPP_CheckSym(20); + OPP_Type(&ftyp, &*banned); + ftyp->pvused = 1; + if (ftyp->comp == 3) { + ftyp = OPT_undftyp; + OPP_err(88); + } + while (first != NIL) { + first->typ = ftyp; + first = first->link; + } + } + if (OPP_sym == 39) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(39); + } else { + break; + } + } + OPT_CloseScope(); +} + +static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned) +{ + OPT_Node x = NIL; + LONGINT n; + INTEGER sysflag; + OPP_CheckSysFlag(&sysflag, 0); + if (OPP_sym == 25) { + *typ = OPT_NewStr(15, 3); + (*typ)->mno = 0; + (*typ)->sysflag = sysflag; + OPS_Get(&OPP_sym); + OPP_Type(&(*typ)->BaseTyp, &*banned); + (*typ)->BaseTyp->pvused = 1; + if ((*typ)->BaseTyp->comp == 3) { + (*typ)->n = (*typ)->BaseTyp->n + 1; + } else { + (*typ)->n = 0; + } + } else { + *typ = OPT_NewStr(15, 2); + (*typ)->sysflag = sysflag; + OPP_ConstExpression(&x); + if (__IN(x->typ->form, 0x70)) { + n = x->conval->intval; + if (n <= 0 || n > OPM_MaxIndex) { + OPP_err(63); + n = 1; + } + } else { + OPP_err(51); + n = 1; + } + (*typ)->n = n; + if (OPP_sym == 25) { + OPS_Get(&OPP_sym); + OPP_Type(&(*typ)->BaseTyp, &*banned); + (*typ)->BaseTyp->pvused = 1; + } else if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + if (OPP_sym != 25) { + OPP_ArrayType(&(*typ)->BaseTyp, &*banned); + } + } else { + OPP_err(35); + } + if ((*typ)->BaseTyp->comp == 3) { + (*typ)->BaseTyp = OPT_undftyp; + OPP_err(88); + } + } +} + +static void OPP_PointerType (OPT_Struct *typ) +{ + OPT_Object id = NIL; + *typ = OPT_NewStr(13, 1); + OPP_CheckSysFlag(&(*typ)->sysflag, 0); + OPP_CheckSym(28); + if (OPP_sym == 38) { + OPT_Find(&id); + if (id == NIL) { + if (OPP_nofFwdPtr < 64) { + OPP_FwdPtr[__X(OPP_nofFwdPtr, ((LONGINT)(64)))] = *typ; + OPP_nofFwdPtr += 1; + } else { + OPP_err(224); + } + (*typ)->link = OPT_NewObj(); + __COPY(OPS_name, (*typ)->link->name, ((LONGINT)(256))); + (*typ)->BaseTyp = OPT_undftyp; + OPS_Get(&OPP_sym); + } else { + OPP_qualident(&id); + if (id->mode == 5) { + if (__IN(id->typ->comp, 0x1c)) { + (*typ)->BaseTyp = id->typ; + } else { + (*typ)->BaseTyp = OPT_undftyp; + OPP_err(57); + } + } else { + (*typ)->BaseTyp = OPT_undftyp; + OPP_err(52); + } + } + } else { + OPP_Type(&(*typ)->BaseTyp, &OPT_notyp); + if (!__IN((*typ)->BaseTyp->comp, 0x1c)) { + (*typ)->BaseTyp = OPT_undftyp; + OPP_err(57); + } + } +} + +static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp) +{ + SHORTINT mode; + OPT_Object par = NIL, first = NIL, last = NIL, res = NIL; + OPT_Struct typ = NIL; + first = NIL; + last = *firstPar; + if (OPP_sym == 38 || OPP_sym == 60) { + for (;;) { + if (OPP_sym == 60) { + OPS_Get(&OPP_sym); + mode = 2; + } else { + mode = 1; + } + for (;;) { + if (OPP_sym == 38) { + OPT_Insert(OPS_name, &par); + OPS_Get(&OPP_sym); + par->mode = mode; + par->link = NIL; + if (first == NIL) { + first = par; + } + if (*firstPar == NIL) { + *firstPar = par; + } else { + last->link = par; + } + last = par; + } else { + OPP_err(38); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(19); + } else if (OPP_sym == 60) { + OPP_err(19); + OPS_Get(&OPP_sym); + } else { + break; + } + } + OPP_CheckSym(20); + OPP_Type(&typ, &OPT_notyp); + if (mode == 1) { + typ->pvused = 1; + } + while (first != NIL) { + first->typ = typ; + first = first->link; + } + if (OPP_sym == 39) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(39); + } else { + break; + } + } + } + OPP_CheckSym(22); + if (OPP_sym == 20) { + OPS_Get(&OPP_sym); + *resTyp = OPT_undftyp; + if (OPP_sym == 38) { + OPP_qualident(&res); + if (res->mode == 5) { + if (res->typ->form < 15) { + *resTyp = res->typ; + } else { + OPP_err(54); + } + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + } else { + *resTyp = OPT_notyp; + } +} + +static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned) +{ + OPT_Object id = NIL; + *typ = OPT_undftyp; + if (OPP_sym < 30) { + OPP_err(12); + do { + OPS_Get(&OPP_sym); + } while (!(OPP_sym >= 30)); + } + if (OPP_sym == 38) { + OPP_qualident(&id); + if (id->mode == 5) { + if (id->typ != *banned) { + *typ = id->typ; + } else { + OPP_err(58); + } + } else { + OPP_err(52); + } + } else if (OPP_sym == 54) { + OPS_Get(&OPP_sym); + OPP_ArrayType(&*typ, &*banned); + } else if (OPP_sym == 55) { + OPS_Get(&OPP_sym); + OPP_RecordType(&*typ, &*banned); + OPB_Inittd(&OPP_TDinit, &OPP_lastTDinit, *typ); + OPP_CheckSym(41); + } else if (OPP_sym == 56) { + OPS_Get(&OPP_sym); + OPP_PointerType(&*typ); + } else if (OPP_sym == 61) { + OPS_Get(&OPP_sym); + *typ = OPT_NewStr(14, 1); + OPP_CheckSysFlag(&(*typ)->sysflag, 0); + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPT_OpenScope(OPP_level, NIL); + OPP_FormalParameters(&(*typ)->link, &(*typ)->BaseTyp); + OPT_CloseScope(); + } else { + (*typ)->BaseTyp = OPT_notyp; + (*typ)->link = NIL; + } + } else { + OPP_err(12); + } + for (;;) { + if (((OPP_sym >= 39 && OPP_sym <= 42) || OPP_sym == 22) || OPP_sym == 64) { + break; + } + OPP_err(15); + if (OPP_sym == 38) { + break; + } + OPS_Get(&OPP_sym); + } +} + +static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned) +{ + OPP_TypeDecl(&*typ, &*banned); + if (((((*typ)->form == 13 && (*typ)->BaseTyp == OPT_undftyp)) && (*typ)->strobj == NIL)) { + OPP_err(0); + } +} + +static void OPP_selector (OPT_Node *x) +{ + OPT_Object obj = NIL, proc = NIL; + OPT_Node y = NIL; + OPT_Struct typ = NIL; + OPS_Name name; + for (;;) { + if (OPP_sym == 31) { + OPS_Get(&OPP_sym); + for (;;) { + if (((*x)->typ != NIL && (*x)->typ->form == 13)) { + OPB_DeRef(&*x); + } + OPP_Expression(&y); + OPB_Index(&*x, y); + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else { + break; + } + } + OPP_CheckSym(23); + } else if (OPP_sym == 18) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + __COPY(OPS_name, name, ((LONGINT)(256))); + OPS_Get(&OPP_sym); + if ((*x)->typ != NIL) { + if ((*x)->typ->form == 13) { + OPB_DeRef(&*x); + } + if ((*x)->typ->comp == 4) { + OPT_FindField(name, (*x)->typ, &obj); + OPB_Field(&*x, obj); + if ((obj != NIL && obj->mode == 13)) { + if (OPP_sym == 17) { + OPS_Get(&OPP_sym); + y = (*x)->left; + if (y->class == 3) { + y = y->left; + } + if (y->obj != NIL) { + proc = OPT_topScope; + while ((proc->link != NIL && proc->link->mode != 13)) { + proc = proc->left; + } + if (proc->link == NIL || proc->link->link != y->obj) { + OPP_err(75); + } + typ = y->obj->typ; + if (typ->form == 13) { + typ = typ->BaseTyp; + } + OPT_FindField((*x)->obj->name, typ->BaseTyp, &proc); + if (proc != NIL) { + (*x)->subcl = 1; + } else { + OPP_err(74); + } + } else { + OPP_err(75); + } + } + if ((obj->typ != OPT_notyp && OPP_sym != 30)) { + OPP_err(30); + } + } + } else { + OPP_err(53); + } + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + } else if (OPP_sym == 17) { + OPS_Get(&OPP_sym); + OPB_DeRef(&*x); + } else if ((((((OPP_sym == 30 && (*x)->class < 7)) && (*x)->typ->form != 14)) && ((*x)->obj == NIL || (*x)->obj->mode != 13))) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPP_qualident(&obj); + if (obj->mode == 5) { + OPB_TypTest(&*x, obj, 1); + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + OPP_CheckSym(22); + } else { + break; + } + } +} + +static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar) +{ + OPT_Node apar = NIL, last = NIL; + *aparlist = NIL; + last = NIL; + if (OPP_sym != 22) { + for (;;) { + OPP_Expression(&apar); + if (fpar != NIL) { + OPB_Param(apar, fpar); + OPB_Link(&*aparlist, &last, apar); + fpar = fpar->link; + } else { + OPP_err(64); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if ((30 <= OPP_sym && OPP_sym <= 38)) { + OPP_err(19); + } else { + break; + } + } + } + if (fpar != NIL) { + OPP_err(65); + } +} + +static void OPP_StandProcCall (OPT_Node *x) +{ + OPT_Node y = NIL; + SHORTINT m; + INTEGER n; + m = (int)(*x)->obj->adr; + n = 0; + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + if (OPP_sym != 22) { + for (;;) { + if (n == 0) { + OPP_Expression(&*x); + OPB_StPar0(&*x, m); + n = 1; + } else if (n == 1) { + OPP_Expression(&y); + OPB_StPar1(&*x, y, m); + n = 2; + } else { + OPP_Expression(&y); + OPB_StParN(&*x, y, m, n); + n += 1; + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if ((30 <= OPP_sym && OPP_sym <= 38)) { + OPP_err(19); + } else { + break; + } + } + OPP_CheckSym(22); + } else { + OPS_Get(&OPP_sym); + } + OPB_StFct(&*x, m, n); + } else { + OPP_err(30); + } + if ((OPP_level > 0 && (m == 1 || m == 30))) { + OPT_topScope->link->leaf = 0; + } +} + +static void OPP_Element (OPT_Node *x) +{ + OPT_Node y = NIL; + OPP_Expression(&*x); + if (OPP_sym == 21) { + OPS_Get(&OPP_sym); + OPP_Expression(&y); + OPB_SetRange(&*x, y); + } else { + OPB_SetElem(&*x); + } +} + +static void OPP_Sets (OPT_Node *x) +{ + OPT_Node y = NIL; + if (OPP_sym != 24) { + OPP_Element(&*x); + for (;;) { + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if ((30 <= OPP_sym && OPP_sym <= 38)) { + OPP_err(19); + } else { + break; + } + OPP_Element(&y); + OPB_Op(6, &*x, y); + } + } else { + *x = OPB_EmptySet(); + } + OPP_CheckSym(24); +} + +static void OPP_Factor (OPT_Node *x) +{ + OPT_Object fpar = NIL, id = NIL; + OPT_Node apar = NIL; + if (OPP_sym < 30) { + OPP_err(13); + do { + OPS_Get(&OPP_sym); + } while (!(OPP_sym >= 30)); + } + if (OPP_sym == 38) { + OPP_qualident(&id); + *x = OPB_NewLeaf(id); + OPP_selector(&*x); + if (((*x)->class == 9 && (*x)->obj->mode == 8)) { + OPP_StandProcCall(&*x); + } else if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPB_PrepCall(&*x, &fpar); + OPP_ActualParameters(&apar, fpar); + OPB_Call(&*x, apar, fpar); + OPP_CheckSym(22); + if (OPP_level > 0) { + OPT_topScope->link->leaf = 0; + } + } + } else if (OPP_sym == 35) { + switch (OPS_numtyp) { + case 1: + *x = OPB_NewIntConst(OPS_intval); + (*x)->typ = OPT_chartyp; + break; + case 2: + *x = OPB_NewIntConst(OPS_intval); + break; + case 3: + *x = OPB_NewRealConst(OPS_realval, OPT_realtyp); + break; + case 4: + *x = OPB_NewRealConst(OPS_lrlval, OPT_lrltyp); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPP.Factor, OPS.numtyp = ", (LONGINT)44); + OPM_LogWNum(OPS_numtyp, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + OPS_Get(&OPP_sym); + } else if (OPP_sym == 37) { + *x = OPB_NewString(OPS_str, OPS_intval); + OPS_Get(&OPP_sym); + } else if (OPP_sym == 36) { + *x = OPB_Nil(); + OPS_Get(&OPP_sym); + } else if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPP_Expression(&*x); + OPP_CheckSym(22); + } else if (OPP_sym == 31) { + OPS_Get(&OPP_sym); + OPP_err(30); + OPP_Expression(&*x); + OPP_CheckSym(22); + } else if (OPP_sym == 32) { + OPS_Get(&OPP_sym); + OPP_Sets(&*x); + } else if (OPP_sym == 33) { + OPS_Get(&OPP_sym); + OPP_Factor(&*x); + OPB_MOp(33, &*x); + } else { + OPP_err(13); + OPS_Get(&OPP_sym); + *x = NIL; + } + if (*x == NIL) { + *x = OPB_NewIntConst(((LONGINT)(1))); + (*x)->typ = OPT_undftyp; + } +} + +static void OPP_Term (OPT_Node *x) +{ + OPT_Node y = NIL; + SHORTINT mulop; + OPP_Factor(&*x); + while ((1 <= OPP_sym && OPP_sym <= 5)) { + mulop = OPP_sym; + OPS_Get(&OPP_sym); + OPP_Factor(&y); + OPB_Op(mulop, &*x, y); + } +} + +static void OPP_SimpleExpression (OPT_Node *x) +{ + OPT_Node y = NIL; + SHORTINT addop; + if (OPP_sym == 7) { + OPS_Get(&OPP_sym); + OPP_Term(&*x); + OPB_MOp(7, &*x); + } else if (OPP_sym == 6) { + OPS_Get(&OPP_sym); + OPP_Term(&*x); + OPB_MOp(6, &*x); + } else { + OPP_Term(&*x); + } + while ((6 <= OPP_sym && OPP_sym <= 8)) { + addop = OPP_sym; + OPS_Get(&OPP_sym); + OPP_Term(&y); + OPB_Op(addop, &*x, y); + } +} + +static void OPP_Expression (OPT_Node *x) +{ + OPT_Node y = NIL; + OPT_Object obj = NIL; + SHORTINT relation; + OPP_SimpleExpression(&*x); + if ((9 <= OPP_sym && OPP_sym <= 14)) { + relation = OPP_sym; + OPS_Get(&OPP_sym); + OPP_SimpleExpression(&y); + OPB_Op(relation, &*x, y); + } else if (OPP_sym == 15) { + OPS_Get(&OPP_sym); + OPP_SimpleExpression(&y); + OPB_In(&*x, y); + } else if (OPP_sym == 16) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPP_qualident(&obj); + if (obj->mode == 5) { + OPB_TypTest(&*x, obj, 0); + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + } +} + +static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec) +{ + OPT_Object obj = NIL; + *typ = OPT_undftyp; + *rec = NIL; + if (OPP_sym == 60) { + OPS_Get(&OPP_sym); + *mode = 2; + } else { + *mode = 1; + } + __COPY(OPS_name, name, ((LONGINT)(256))); + OPP_CheckSym(38); + OPP_CheckSym(20); + if (OPP_sym == 38) { + OPT_Find(&obj); + OPS_Get(&OPP_sym); + if (obj == NIL) { + OPP_err(0); + } else if (obj->mode != 5) { + OPP_err(72); + } else { + *typ = obj->typ; + *rec = *typ; + if ((*rec)->form == 13) { + *rec = (*rec)->BaseTyp; + } + if (!((((*mode == 1 && (*typ)->form == 13)) && (*rec)->comp == 4) || (*mode == 2 && (*typ)->comp == 4))) { + OPP_err(70); + *rec = NIL; + } + if ((*rec != NIL && (*rec)->mno != OPP_level)) { + OPP_err(72); + *rec = NIL; + } + } + } else { + OPP_err(38); + } + OPP_CheckSym(22); + if (*rec == NIL) { + *rec = OPT_NewStr(15, 4); + (*rec)->BaseTyp = NIL; + } +} + +static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b) +{ + BOOLEAN _o_result; + if ((b->form == 13 && x->form == 13)) { + b = b->BaseTyp; + x = x->BaseTyp; + } + if ((b->comp == 4 && x->comp == 4)) { + do { + x = x->BaseTyp; + } while (!(x == NIL || x == b)); + } + _o_result = x == b; + return _o_result; +} + +static struct ProcedureDeclaration__16 { + OPT_Node *x; + OPT_Object *proc, *fwd; + OPS_Name *name; + SHORTINT *mode, *vis; + BOOLEAN *forward; + struct ProcedureDeclaration__16 *lnk; +} *ProcedureDeclaration__16_s; + +static void Body__17 (void); +static void GetCode__19 (void); +static void GetParams__21 (void); +static void TProcDecl__23 (void); + +static void GetCode__19 (void) +{ + OPT_ConstExt ext = NIL; + INTEGER n; + LONGINT c; + ext = OPT_NewExt(); + (*ProcedureDeclaration__16_s->proc)->conval->ext = ext; + n = 0; + if (OPP_sym == 37) { + while (OPS_str[__X(n, ((LONGINT)(256)))] != 0x00) { + (*ext)[__X(n + 1, ((LONGINT)(256)))] = OPS_str[__X(n, ((LONGINT)(256)))]; + n += 1; + } + (*ext)[0] = (CHAR)n; + OPS_Get(&OPP_sym); + } else { + for (;;) { + if (OPP_sym == 35) { + c = OPS_intval; + n += 1; + if ((c < 0 || c > 255) || n == 256) { + OPP_err(64); + c = 1; + n = 1; + } + OPS_Get(&OPP_sym); + (*ext)[__X(n, ((LONGINT)(256)))] = (CHAR)c; + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 35) { + OPP_err(19); + } else { + (*ext)[0] = (CHAR)n; + break; + } + } + } + (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1); +} + +static void GetParams__21 (void) +{ + (*ProcedureDeclaration__16_s->proc)->vis = *ProcedureDeclaration__16_s->vis; + (*ProcedureDeclaration__16_s->proc)->mode = *ProcedureDeclaration__16_s->mode; + (*ProcedureDeclaration__16_s->proc)->typ = OPT_notyp; + (*ProcedureDeclaration__16_s->proc)->conval = OPT_NewConst(); + (*ProcedureDeclaration__16_s->proc)->conval->setval = 0x0; + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPP_FormalParameters(&(*ProcedureDeclaration__16_s->proc)->link, &(*ProcedureDeclaration__16_s->proc)->typ); + } + if (*ProcedureDeclaration__16_s->fwd != NIL) { + OPB_CheckParameters((*ProcedureDeclaration__16_s->proc)->link, (*ProcedureDeclaration__16_s->fwd)->link, 1); + if ((*ProcedureDeclaration__16_s->proc)->typ != (*ProcedureDeclaration__16_s->fwd)->typ) { + OPP_err(117); + } + *ProcedureDeclaration__16_s->proc = *ProcedureDeclaration__16_s->fwd; + OPT_topScope = (*ProcedureDeclaration__16_s->proc)->scope; + if (*ProcedureDeclaration__16_s->mode == 10) { + (*ProcedureDeclaration__16_s->proc)->mode = 10; + } + } +} + +static void Body__17 (void) +{ + OPT_Node procdec = NIL, statseq = NIL; + LONGINT c; + c = OPM_errpos; + (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1); + OPP_CheckSym(39); + OPP_Block(&procdec, &statseq); + OPB_Enter(&procdec, statseq, *ProcedureDeclaration__16_s->proc); + *ProcedureDeclaration__16_s->x = procdec; + (*ProcedureDeclaration__16_s->x)->conval = OPT_NewConst(); + (*ProcedureDeclaration__16_s->x)->conval->intval = c; + if (OPP_sym == 38) { + if (__STRCMP(OPS_name, (*ProcedureDeclaration__16_s->proc)->name) != 0) { + OPP_err(4); + } + OPS_Get(&OPP_sym); + } else { + OPP_err(38); + } +} + +static void TProcDecl__23 (void) +{ + OPT_Object baseProc = NIL; + OPT_Struct objTyp = NIL, recTyp = NIL; + SHORTINT objMode; + OPS_Name objName; + OPS_Get(&OPP_sym); + *ProcedureDeclaration__16_s->mode = 13; + if (OPP_level > 0) { + OPP_err(73); + } + OPP_Receiver(&objMode, objName, &objTyp, &recTyp); + if (OPP_sym == 38) { + __COPY(OPS_name, *ProcedureDeclaration__16_s->name, ((LONGINT)(256))); + OPP_CheckMark(&*ProcedureDeclaration__16_s->vis); + OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp, &*ProcedureDeclaration__16_s->fwd); + OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp->BaseTyp, &baseProc); + if ((baseProc != NIL && baseProc->mode != 13)) { + baseProc = NIL; + } + if (*ProcedureDeclaration__16_s->fwd == baseProc) { + *ProcedureDeclaration__16_s->fwd = NIL; + } + if ((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mnolev != OPP_level)) { + *ProcedureDeclaration__16_s->fwd = NIL; + } + if ((((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mode == 13)) && !__IN(1, (*ProcedureDeclaration__16_s->fwd)->conval->setval))) { + *ProcedureDeclaration__16_s->proc = OPT_NewObj(); + (*ProcedureDeclaration__16_s->proc)->leaf = 1; + if ((*ProcedureDeclaration__16_s->fwd)->vis != *ProcedureDeclaration__16_s->vis) { + OPP_err(118); + } + } else { + if (*ProcedureDeclaration__16_s->fwd != NIL) { + OPP_err(1); + *ProcedureDeclaration__16_s->fwd = NIL; + } + OPT_OpenScope(0, NIL); + OPT_topScope->right = recTyp->link; + OPT_Insert(*ProcedureDeclaration__16_s->name, &*ProcedureDeclaration__16_s->proc); + recTyp->link = OPT_topScope->right; + OPT_CloseScope(); + } + OPP_level += 1; + OPT_OpenScope(OPP_level, *ProcedureDeclaration__16_s->proc); + OPT_Insert(objName, &(*ProcedureDeclaration__16_s->proc)->link); + (*ProcedureDeclaration__16_s->proc)->link->mode = objMode; + (*ProcedureDeclaration__16_s->proc)->link->typ = objTyp; + GetParams__21(); + if (baseProc != NIL) { + if (objMode != baseProc->link->mode || !OPP_Extends(objTyp, baseProc->link->typ)) { + OPP_err(115); + } + OPB_CheckParameters((*ProcedureDeclaration__16_s->proc)->link->link, baseProc->link->link, 0); + if ((*ProcedureDeclaration__16_s->proc)->typ != baseProc->typ) { + OPP_err(117); + } + if ((((((baseProc->vis == 1 && (*ProcedureDeclaration__16_s->proc)->vis == 0)) && recTyp->strobj != NIL)) && recTyp->strobj->vis == 1)) { + OPP_err(109); + } + (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(2); + } + if (!*ProcedureDeclaration__16_s->forward) { + Body__17(); + } + OPP_level -= 1; + OPT_CloseScope(); + } else { + OPP_err(38); + } +} + +static void OPP_ProcedureDeclaration (OPT_Node *x) +{ + OPT_Object proc = NIL, fwd = NIL; + OPS_Name name; + SHORTINT mode, vis; + BOOLEAN forward; + struct ProcedureDeclaration__16 _s; + _s.x = x; + _s.proc = &proc; + _s.fwd = &fwd; + _s.name = (void*)name; + _s.mode = &mode; + _s.vis = &vis; + _s.forward = &forward; + _s.lnk = ProcedureDeclaration__16_s; + ProcedureDeclaration__16_s = &_s; + proc = NIL; + forward = 0; + *x = NIL; + mode = 6; + if ((OPP_sym != 38 && OPP_sym != 30)) { + if (OPP_sym == 1) { + } else if (OPP_sym == 17) { + forward = 1; + } else if (OPP_sym == 6) { + mode = 10; + } else if (OPP_sym == 7) { + mode = 9; + } else { + OPP_err(38); + } + if ((__IN(mode, 0x0600) && !OPT_SYSimported)) { + OPP_err(135); + } + OPS_Get(&OPP_sym); + } + if (OPP_sym == 30) { + TProcDecl__23(); + } else if (OPP_sym == 38) { + OPT_Find(&fwd); + __COPY(OPS_name, name, ((LONGINT)(256))); + OPP_CheckMark(&vis); + if ((vis != 0 && mode == 6)) { + mode = 7; + } + if ((fwd != NIL && (fwd->mnolev != OPP_level || fwd->mode == 8))) { + fwd = NIL; + } + if ((((fwd != NIL && __IN(fwd->mode, 0xc0))) && !__IN(1, fwd->conval->setval))) { + proc = OPT_NewObj(); + proc->leaf = 1; + if (fwd->vis != vis) { + OPP_err(118); + } + } else { + if (fwd != NIL) { + OPP_err(1); + fwd = NIL; + } + OPT_Insert(name, &proc); + } + if ((mode != 6 && OPP_level > 0)) { + OPP_err(73); + } + OPP_level += 1; + OPT_OpenScope(OPP_level, proc); + proc->link = NIL; + GetParams__21(); + if (mode == 9) { + GetCode__19(); + } else if (!forward) { + Body__17(); + } + OPP_level -= 1; + OPT_CloseScope(); + } else { + OPP_err(38); + } + ProcedureDeclaration__16_s = _s.lnk; +} + +static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab) +{ + OPT_Node x = NIL, y = NIL, lastlab = NIL; + INTEGER i, f; + LONGINT xval, yval; + *lab = NIL; + lastlab = NIL; + for (;;) { + OPP_ConstExpression(&x); + f = x->typ->form; + if (__IN(f, 0x78)) { + xval = x->conval->intval; + } else { + OPP_err(61); + xval = 1; + } + if (__IN(f, 0x70)) { + if (LabelForm < f) { + OPP_err(60); + } + } else if (LabelForm != f) { + OPP_err(60); + } + if (OPP_sym == 21) { + OPS_Get(&OPP_sym); + OPP_ConstExpression(&y); + yval = y->conval->intval; + if (((int)y->typ->form != f && !((__IN(f, 0x70) && __IN(y->typ->form, 0x70))))) { + OPP_err(60); + } + if (yval < xval) { + OPP_err(63); + yval = xval; + } + } else { + yval = xval; + } + x->conval->intval2 = yval; + i = *n; + if (i < 128) { + for (;;) { + if (i == 0) { + break; + } + if (tab[__X(i - 1, ((LONGINT)(128)))].low <= yval) { + if (tab[__X(i - 1, ((LONGINT)(128)))].high >= xval) { + OPP_err(62); + } + break; + } + tab[__X(i, ((LONGINT)(128)))] = tab[__X(i - 1, ((LONGINT)(128)))]; + i -= 1; + } + tab[__X(i, ((LONGINT)(128)))].low = xval; + tab[__X(i, ((LONGINT)(128)))].high = yval; + *n += 1; + } else { + OPP_err(213); + } + OPB_Link(&*lab, &lastlab, x); + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 35 || OPP_sym == 38) { + OPP_err(19); + } else { + break; + } + } +} + +static struct StatSeq__30 { + LONGINT *pos; + struct StatSeq__30 *lnk; +} *StatSeq__30_s; + +static void CasePart__31 (OPT_Node *x); +static void CheckBool__33 (OPT_Node *x); +static void SetPos__35 (OPT_Node x); + +static void CasePart__31 (OPT_Node *x) +{ + INTEGER n; + LONGINT low, high; + BOOLEAN e; + OPP_CaseTable tab; + OPT_Node cases = NIL, lab = NIL, y = NIL, lastcase = NIL; + OPP_Expression(&*x); + *StatSeq__30_s->pos = OPM_errpos; + if ((*x)->class == 8 || (*x)->class == 9) { + OPP_err(126); + } else if (!__IN((*x)->typ->form, 0x78)) { + OPP_err(125); + } + OPP_CheckSym(25); + cases = NIL; + lastcase = NIL; + n = 0; + for (;;) { + if (OPP_sym < 40) { + OPP_CaseLabelList(&lab, (*x)->typ->form, &n, tab); + OPP_CheckSym(20); + OPP_StatSeq(&y); + OPB_Construct(17, &lab, y); + OPB_Link(&cases, &lastcase, lab); + } + if (OPP_sym == 40) { + OPS_Get(&OPP_sym); + } else { + break; + } + } + if (n > 0) { + low = tab[0].low; + high = tab[__X(n - 1, ((LONGINT)(128)))].high; + if (high - low > 512) { + OPP_err(209); + } + } else { + low = 1; + high = 0; + } + e = OPP_sym == 42; + if (e) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&y); + } else { + y = NIL; + OPM_Mark(-307, OPM_curpos); + } + OPB_Construct(16, &cases, y); + OPB_Construct(21, &*x, cases); + cases->conval = OPT_NewConst(); + cases->conval->intval = low; + cases->conval->intval2 = high; + if (e) { + cases->conval->setval = 0x02; + } else { + cases->conval->setval = 0x0; + } +} + +static void SetPos__35 (OPT_Node x) +{ + x->conval = OPT_NewConst(); + x->conval->intval = *StatSeq__30_s->pos; +} + +static void CheckBool__33 (OPT_Node *x) +{ + if ((*x)->class == 8 || (*x)->class == 9) { + OPP_err(126); + *x = OPB_NewBoolConst(0); + } else if ((*x)->typ->form != 2) { + OPP_err(120); + *x = OPB_NewBoolConst(0); + } + *StatSeq__30_s->pos = OPM_errpos; +} + +static void OPP_StatSeq (OPT_Node *stat) +{ + OPT_Object fpar = NIL, id = NIL, t = NIL, obj = NIL; + OPT_Struct idtyp = NIL; + BOOLEAN e; + OPT_Node s = NIL, x = NIL, y = NIL, z = NIL, apar = NIL, last = NIL, lastif = NIL; + LONGINT pos; + OPS_Name name; + struct StatSeq__30 _s; + _s.pos = &pos; + _s.lnk = StatSeq__30_s; + StatSeq__30_s = &_s; + *stat = NIL; + last = NIL; + for (;;) { + x = NIL; + if (OPP_sym < 38) { + OPP_err(14); + do { + OPS_Get(&OPP_sym); + } while (!(OPP_sym >= 38)); + } + if (OPP_sym == 38) { + OPP_qualident(&id); + x = OPB_NewLeaf(id); + OPP_selector(&x); + if (OPP_sym == 34) { + OPS_Get(&OPP_sym); + OPP_Expression(&y); + OPB_Assign(&x, y); + } else if (OPP_sym == 9) { + OPP_err(34); + OPS_Get(&OPP_sym); + OPP_Expression(&y); + OPB_Assign(&x, y); + } else if ((x->class == 9 && x->obj->mode == 8)) { + OPP_StandProcCall(&x); + if ((x != NIL && x->typ != OPT_notyp)) { + OPP_err(55); + } + } else { + OPB_PrepCall(&x, &fpar); + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPP_ActualParameters(&apar, fpar); + OPP_CheckSym(22); + } else { + apar = NIL; + if (fpar != NIL) { + OPP_err(65); + } + } + OPB_Call(&x, apar, fpar); + if (x->typ != OPT_notyp) { + OPP_err(55); + } + if (OPP_level > 0) { + OPT_topScope->link->leaf = 0; + } + } + pos = OPM_errpos; + } else if (OPP_sym == 45) { + OPS_Get(&OPP_sym); + OPP_Expression(&x); + CheckBool__33(&x); + OPP_CheckSym(26); + OPP_StatSeq(&y); + OPB_Construct(15, &x, y); + SetPos__35(x); + lastif = x; + while (OPP_sym == 43) { + OPS_Get(&OPP_sym); + OPP_Expression(&y); + CheckBool__33(&y); + OPP_CheckSym(26); + OPP_StatSeq(&z); + OPB_Construct(15, &y, z); + SetPos__35(y); + OPB_Link(&x, &lastif, y); + } + if (OPP_sym == 42) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&y); + } else { + y = NIL; + } + OPB_Construct(20, &x, y); + OPP_CheckSym(41); + OPB_OptIf(&x); + pos = OPM_errpos; + } else if (OPP_sym == 46) { + OPS_Get(&OPP_sym); + CasePart__31(&x); + OPP_CheckSym(41); + } else if (OPP_sym == 47) { + OPS_Get(&OPP_sym); + OPP_Expression(&x); + CheckBool__33(&x); + OPP_CheckSym(27); + OPP_StatSeq(&y); + OPB_Construct(22, &x, y); + OPP_CheckSym(41); + } else if (OPP_sym == 48) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&x); + if (OPP_sym == 44) { + OPS_Get(&OPP_sym); + OPP_Expression(&y); + CheckBool__33(&y); + } else { + OPP_err(44); + } + OPB_Construct(23, &x, y); + } else if (OPP_sym == 49) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPP_qualident(&id); + if (!__IN(id->typ->form, 0x70)) { + OPP_err(68); + } + OPP_CheckSym(34); + OPP_Expression(&y); + pos = OPM_errpos; + x = OPB_NewLeaf(id); + OPB_Assign(&x, y); + SetPos__35(x); + OPP_CheckSym(28); + OPP_Expression(&y); + pos = OPM_errpos; + if (y->class != 7) { + __MOVE("@@", name, 3); + OPT_Insert(name, &t); + __MOVE("@for", t->name, 5); + t->mode = 1; + t->typ = x->left->typ; + obj = OPT_topScope->scope; + if (obj == NIL) { + OPT_topScope->scope = t; + } else { + while (obj->link != NIL) { + obj = obj->link; + } + obj->link = t; + } + z = OPB_NewLeaf(t); + OPB_Assign(&z, y); + SetPos__35(z); + OPB_Link(&*stat, &last, z); + y = OPB_NewLeaf(t); + } else if (y->typ->form < 4 || y->typ->form > x->left->typ->form) { + OPP_err(113); + } + OPB_Link(&*stat, &last, x); + if (OPP_sym == 29) { + OPS_Get(&OPP_sym); + OPP_ConstExpression(&z); + } else { + z = OPB_NewIntConst(((LONGINT)(1))); + } + pos = OPM_errpos; + x = OPB_NewLeaf(id); + if (z->conval->intval > 0) { + OPB_Op(12, &x, y); + } else if (z->conval->intval < 0) { + OPB_Op(14, &x, y); + } else { + OPP_err(63); + OPB_Op(14, &x, y); + } + OPP_CheckSym(27); + OPP_StatSeq(&s); + y = OPB_NewLeaf(id); + OPB_StPar1(&y, z, 13); + SetPos__35(y); + if (s == NIL) { + s = y; + } else { + z = s; + while (z->link != NIL) { + z = z->link; + } + z->link = y; + } + OPP_CheckSym(41); + OPB_Construct(22, &x, s); + } else { + OPP_err(38); + } + } else if (OPP_sym == 50) { + OPS_Get(&OPP_sym); + OPP_LoopLevel += 1; + OPP_StatSeq(&x); + OPP_LoopLevel -= 1; + OPB_Construct(24, &x, NIL); + OPP_CheckSym(41); + pos = OPM_errpos; + } else if (OPP_sym == 51) { + OPS_Get(&OPP_sym); + idtyp = NIL; + x = NIL; + for (;;) { + if (OPP_sym == 38) { + OPP_qualident(&id); + y = OPB_NewLeaf(id); + if ((((id != NIL && id->typ->form == 13)) && (id->mode == 2 || !id->leaf))) { + OPP_err(245); + } + OPP_CheckSym(20); + if (OPP_sym == 38) { + OPP_qualident(&t); + if (t->mode == 5) { + if (id != NIL) { + idtyp = id->typ; + OPB_TypTest(&y, t, 0); + id->typ = t->typ; + } else { + OPP_err(130); + } + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + } else { + OPP_err(38); + } + pos = OPM_errpos; + OPP_CheckSym(27); + OPP_StatSeq(&s); + OPB_Construct(15, &y, s); + SetPos__35(y); + if (idtyp != NIL) { + id->typ = idtyp; + idtyp = NIL; + } + if (x == NIL) { + x = y; + lastif = x; + } else { + OPB_Link(&x, &lastif, y); + } + if (OPP_sym == 40) { + OPS_Get(&OPP_sym); + } else { + break; + } + } + e = OPP_sym == 42; + if (e) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&s); + } else { + s = NIL; + } + OPB_Construct(27, &x, s); + OPP_CheckSym(41); + if (e) { + x->subcl = 1; + } + } else if (OPP_sym == 52) { + OPS_Get(&OPP_sym); + if (OPP_LoopLevel == 0) { + OPP_err(46); + } + OPB_Construct(25, &x, NIL); + pos = OPM_errpos; + } else if (OPP_sym == 53) { + OPS_Get(&OPP_sym); + if (OPP_sym < 39) { + OPP_Expression(&x); + } + if (OPP_level > 0) { + OPB_Return(&x, OPT_topScope->link); + } else { + OPB_Return(&x, NIL); + } + pos = OPM_errpos; + } + if (x != NIL) { + SetPos__35(x); + OPB_Link(&*stat, &last, x); + } + if (OPP_sym == 39) { + OPS_Get(&OPP_sym); + } else if (OPP_sym <= 38 || (45 <= OPP_sym && OPP_sym <= 53)) { + OPP_err(39); + } else { + break; + } + } + StatSeq__30_s = _s.lnk; +} + +static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq) +{ + OPT_Struct typ = NIL; + OPT_Object obj = NIL, first = NIL, last = NIL; + OPT_Node x = NIL, lastdec = NIL; + INTEGER i; + first = NIL; + last = NIL; + OPP_nofFwdPtr = 0; + for (;;) { + if (OPP_sym == 58) { + OPS_Get(&OPP_sym); + while (OPP_sym == 38) { + OPT_Insert(OPS_name, &obj); + OPP_CheckMark(&obj->vis); + obj->typ = OPT_sinttyp; + obj->mode = 1; + if (OPP_sym == 9) { + OPS_Get(&OPP_sym); + OPP_ConstExpression(&x); + } else if (OPP_sym == 34) { + OPP_err(9); + OPS_Get(&OPP_sym); + OPP_ConstExpression(&x); + } else { + OPP_err(9); + x = OPB_NewIntConst(((LONGINT)(1))); + } + obj->mode = 3; + obj->typ = x->typ; + obj->conval = x->conval; + OPP_CheckSym(39); + } + } + if (OPP_sym == 59) { + OPS_Get(&OPP_sym); + while (OPP_sym == 38) { + OPT_Insert(OPS_name, &obj); + obj->mode = 5; + obj->typ = OPT_undftyp; + OPP_CheckMark(&obj->vis); + if (OPP_sym == 9) { + OPS_Get(&OPP_sym); + OPP_TypeDecl(&obj->typ, &obj->typ); + } else if (OPP_sym == 34 || OPP_sym == 20) { + OPP_err(9); + OPS_Get(&OPP_sym); + OPP_TypeDecl(&obj->typ, &obj->typ); + } else { + OPP_err(9); + } + if (obj->typ->strobj == NIL) { + obj->typ->strobj = obj; + } + if (__IN(obj->typ->comp, 0x1c)) { + i = 0; + while (i < OPP_nofFwdPtr) { + typ = OPP_FwdPtr[__X(i, ((LONGINT)(64)))]; + i += 1; + if (__STRCMP(typ->link->name, obj->name) == 0) { + typ->BaseTyp = obj->typ; + typ->link->name[0] = 0x00; + } + } + } + OPP_CheckSym(39); + } + } + if (OPP_sym == 60) { + OPS_Get(&OPP_sym); + while (OPP_sym == 38) { + for (;;) { + if (OPP_sym == 38) { + OPT_Insert(OPS_name, &obj); + OPP_CheckMark(&obj->vis); + obj->mode = 1; + obj->link = NIL; + obj->leaf = obj->vis == 0; + obj->typ = OPT_undftyp; + if (first == NIL) { + first = obj; + } + if (last == NIL) { + OPT_topScope->scope = obj; + } else { + last->link = obj; + } + last = obj; + } else { + OPP_err(38); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(19); + } else { + break; + } + } + OPP_CheckSym(20); + OPP_Type(&typ, &OPT_notyp); + typ->pvused = 1; + if (typ->comp == 3) { + typ = OPT_undftyp; + OPP_err(88); + } + while (first != NIL) { + first->typ = typ; + first = first->link; + } + OPP_CheckSym(39); + } + } + if (OPP_sym < 58 || OPP_sym > 60) { + break; + } + } + i = 0; + while (i < OPP_nofFwdPtr) { + if (OPP_FwdPtr[__X(i, ((LONGINT)(64)))]->link->name[0] != 0x00) { + OPP_err(128); + } + OPP_FwdPtr[__X(i, ((LONGINT)(64)))] = NIL; + i += 1; + } + OPT_topScope->adr = OPM_errpos; + *procdec = NIL; + lastdec = NIL; + while (OPP_sym == 61) { + OPS_Get(&OPP_sym); + OPP_ProcedureDeclaration(&x); + if (x != NIL) { + if (lastdec == NIL) { + *procdec = x; + } else { + lastdec->link = x; + } + lastdec = x; + } + OPP_CheckSym(39); + } + if (OPP_sym == 57) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&*statseq); + } else { + *statseq = NIL; + } + if ((OPP_level == 0 && OPP_TDinit != NIL)) { + OPP_lastTDinit->link = *statseq; + *statseq = OPP_TDinit; + } + OPP_CheckSym(41); +} + +void OPP_Module (OPT_Node *prog, SET opt) +{ + OPS_Name impName, aliasName; + OPT_Node procdec = NIL, statseq = NIL; + LONGINT c; + BOOLEAN done; + OPS_Init(); + OPP_LoopLevel = 0; + OPP_level = 0; + OPS_Get(&OPP_sym); + if (OPP_sym == 63) { + OPS_Get(&OPP_sym); + } else { + OPP_err(16); + } + if (OPP_sym == 38) { + OPM_LogWStr((CHAR*)"compiling ", (LONGINT)11); + OPM_LogWStr(OPS_name, ((LONGINT)(256))); + OPM_LogW('.'); + OPT_Init(OPS_name, opt); + OPS_Get(&OPP_sym); + OPP_CheckSym(39); + if (OPP_sym == 62) { + OPS_Get(&OPP_sym); + for (;;) { + if (OPP_sym == 38) { + __COPY(OPS_name, aliasName, ((LONGINT)(256))); + __COPY(aliasName, impName, ((LONGINT)(256))); + OPS_Get(&OPP_sym); + if (OPP_sym == 34) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + __COPY(OPS_name, impName, ((LONGINT)(256))); + OPS_Get(&OPP_sym); + } else { + OPP_err(38); + } + } + OPT_Import(aliasName, impName, &done); + } else { + OPP_err(38); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(19); + } else { + break; + } + } + OPP_CheckSym(39); + } + if (OPM_noerr) { + OPP_TDinit = NIL; + OPP_lastTDinit = NIL; + c = OPM_errpos; + OPP_Block(&procdec, &statseq); + OPB_Enter(&procdec, statseq, NIL); + *prog = procdec; + (*prog)->conval = OPT_NewConst(); + (*prog)->conval->intval = c; + if (OPP_sym == 38) { + if (__STRCMP(OPS_name, OPT_SelfName) != 0) { + OPP_err(4); + } + OPS_Get(&OPP_sym); + } else { + OPP_err(38); + } + if (OPP_sym != 18) { + OPP_err(18); + } + } + } else { + OPP_err(38); + } + OPP_TDinit = NIL; + OPP_lastTDinit = NIL; +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(OPP_TDinit); + P(OPP_lastTDinit); + __ENUMP(OPP_FwdPtr, 64, P); +} + +__TDESC(OPP__1, 1, 0) = {__TDFLDS("", 16), {-8}}; + +export void *OPP__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPB); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPS); + __MODULE_IMPORT(OPT); + __REGMOD("OPP", EnumPtrs); + __INITYP(OPP__1, OPP__1, 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-88/OPP.h b/bootstrap/unix-88/OPP.h new file mode 100644 index 00000000..30cf0643 --- /dev/null +++ b/bootstrap/unix-88/OPP.h @@ -0,0 +1,17 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPP__h +#define OPP__h + +#define LARGE +#include "SYSTEM.h" +#include "OPT.h" + + + + +import void OPP_Module (OPT_Node *prog, SET opt); +import void *OPP__init(void); + + +#endif diff --git a/bootstrap/unix-88/OPS.c b/bootstrap/unix-88/OPS.c new file mode 100644 index 00000000..bb08e1f5 --- /dev/null +++ b/bootstrap/unix-88/OPS.c @@ -0,0 +1,624 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "OPM.h" + +typedef + CHAR OPS_Name[256]; + +typedef + CHAR OPS_String[256]; + + +export OPS_Name OPS_name; +export OPS_String OPS_str; +export INTEGER OPS_numtyp; +export LONGINT OPS_intval; +export REAL OPS_realval; +export LONGREAL OPS_lrlval; +static CHAR OPS_ch; + + +export void OPS_Get (SHORTINT *sym); +static void OPS_Identifier (SHORTINT *sym); +export void OPS_Init (void); +static void OPS_Number (void); +static void OPS_Str (SHORTINT *sym); +static void OPS_err (INTEGER n); + + +static void OPS_err (INTEGER n) +{ + OPM_err(n); +} + +static void OPS_Str (SHORTINT *sym) +{ + INTEGER i; + CHAR och; + i = 0; + och = OPS_ch; + for (;;) { + OPM_Get(&OPS_ch); + if (OPS_ch == och) { + break; + } + if (OPS_ch < ' ') { + OPS_err(3); + break; + } + if (i == 255) { + OPS_err(241); + break; + } + OPS_str[i] = OPS_ch; + i += 1; + } + OPM_Get(&OPS_ch); + OPS_str[i] = 0x00; + OPS_intval = i + 1; + if (OPS_intval == 2) { + *sym = 35; + OPS_numtyp = 1; + OPS_intval = (int)OPS_str[0]; + } else { + *sym = 37; + } +} + +static void OPS_Identifier (SHORTINT *sym) +{ + INTEGER i; + i = 0; + do { + OPS_name[i] = OPS_ch; + i += 1; + OPM_Get(&OPS_ch); + } while (!(((OPS_ch < '0' || ('9' < OPS_ch && __CAP(OPS_ch) < 'A')) || 'Z' < __CAP(OPS_ch)) || i == 256)); + if (i == 256) { + OPS_err(240); + i -= 1; + } + OPS_name[i] = 0x00; + *sym = 38; +} + +static struct Number__6 { + struct Number__6 *lnk; +} *Number__6_s; + +static INTEGER Ord__7 (CHAR ch, BOOLEAN hex); +static LONGREAL Ten__9 (INTEGER e); + +static LONGREAL Ten__9 (INTEGER e) +{ + LONGREAL _o_result; + LONGREAL x, p; + x = (LONGREAL)1; + p = (LONGREAL)10; + while (e > 0) { + if (__ODD(e)) { + x = x * p; + } + e = __ASHR(e, 1); + if (e > 0) { + p = p * p; + } + } + _o_result = x; + return _o_result; +} + +static INTEGER Ord__7 (CHAR ch, BOOLEAN hex) +{ + INTEGER _o_result; + if (ch <= '9') { + _o_result = (int)ch - 48; + return _o_result; + } else if (hex) { + _o_result = ((int)ch - 65) + 10; + return _o_result; + } else { + OPS_err(2); + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +static void OPS_Number (void) +{ + INTEGER i, m, n, d, e; + CHAR dig[24]; + LONGREAL f; + CHAR expCh; + BOOLEAN neg; + struct Number__6 _s; + _s.lnk = Number__6_s; + Number__6_s = &_s; + i = 0; + m = 0; + n = 0; + d = 0; + for (;;) { + if (('0' <= OPS_ch && OPS_ch <= '9') || (((d == 0 && 'A' <= OPS_ch)) && OPS_ch <= 'F')) { + if (m > 0 || OPS_ch != '0') { + if (n < 24) { + dig[n] = OPS_ch; + n += 1; + } + m += 1; + } + OPM_Get(&OPS_ch); + i += 1; + } else if (OPS_ch == '.') { + OPM_Get(&OPS_ch); + if (OPS_ch == '.') { + OPS_ch = 0x7f; + break; + } else if (d == 0) { + d = i; + } else { + OPS_err(2); + } + } else { + break; + } + } + if (d == 0) { + if (n == m) { + OPS_intval = 0; + i = 0; + if (OPS_ch == 'X') { + OPM_Get(&OPS_ch); + OPS_numtyp = 1; + if (n <= 2) { + while (i < n) { + OPS_intval = __ASHL(OPS_intval, 4) + (LONGINT)Ord__7(dig[i], 1); + i += 1; + } + } else { + OPS_err(203); + } + } else if (OPS_ch == 'H') { + OPM_Get(&OPS_ch); + OPS_numtyp = 2; + if (n <= 8) { + if ((n == 8 && dig[0] > '7')) { + OPS_intval = -1; + } + while (i < n) { + OPS_intval = __ASHL(OPS_intval, 4) + (LONGINT)Ord__7(dig[i], 1); + i += 1; + } + } else { + OPS_err(203); + } + } else { + OPS_numtyp = 2; + while (i < n) { + d = Ord__7(dig[i], 0); + i += 1; + if (OPS_intval <= __DIV(9223372036854775807 - (LONGINT)d, 10)) { + OPS_intval = OPS_intval * 10 + (LONGINT)d; + } else { + OPS_err(203); + } + } + } + } else { + OPS_err(203); + } + } else { + f = (LONGREAL)0; + e = 0; + expCh = 'E'; + while (n > 0) { + n -= 1; + f = (Ord__7(dig[n], 0) + f) / (LONGREAL)(LONGREAL)10; + } + if (OPS_ch == 'E' || OPS_ch == 'D') { + expCh = OPS_ch; + OPM_Get(&OPS_ch); + neg = 0; + if (OPS_ch == '-') { + neg = 1; + OPM_Get(&OPS_ch); + } else if (OPS_ch == '+') { + OPM_Get(&OPS_ch); + } + if (('0' <= OPS_ch && OPS_ch <= '9')) { + do { + n = Ord__7(OPS_ch, 0); + OPM_Get(&OPS_ch); + if (e <= __DIV(2147483647 - n, 10)) { + e = e * 10 + n; + } else { + OPS_err(203); + } + } while (!(OPS_ch < '0' || '9' < OPS_ch)); + if (neg) { + e = -e; + } + } else { + OPS_err(2); + } + } + e -= (i - d) - m; + if (expCh == 'E') { + OPS_numtyp = 3; + if ((-37 < e && e <= 38)) { + if (e < 0) { + OPS_realval = (f / (LONGREAL)Ten__9(-e)); + } else { + OPS_realval = (f * Ten__9(e)); + } + } else { + OPS_err(203); + } + } else { + OPS_numtyp = 4; + if ((-307 < e && e <= 308)) { + if (e < 0) { + OPS_lrlval = f / (LONGREAL)Ten__9(-e); + } else { + OPS_lrlval = f * Ten__9(e); + } + } else { + OPS_err(203); + } + } + } + Number__6_s = _s.lnk; +} + +static struct Get__1 { + struct Get__1 *lnk; +} *Get__1_s; + +static void Comment__2 (void); + +static void Comment__2 (void) +{ + OPM_Get(&OPS_ch); + for (;;) { + for (;;) { + while (OPS_ch == '(') { + OPM_Get(&OPS_ch); + if (OPS_ch == '*') { + Comment__2(); + } + } + if (OPS_ch == '*') { + OPM_Get(&OPS_ch); + break; + } + if (OPS_ch == 0x00) { + break; + } + OPM_Get(&OPS_ch); + } + if (OPS_ch == ')') { + OPM_Get(&OPS_ch); + break; + } + if (OPS_ch == 0x00) { + OPS_err(5); + break; + } + } +} + +void OPS_Get (SHORTINT *sym) +{ + SHORTINT s; + struct Get__1 _s; + _s.lnk = Get__1_s; + Get__1_s = &_s; + OPM_errpos = OPM_curpos - 1; + while (OPS_ch <= ' ') { + if (OPS_ch == 0x00) { + *sym = 64; + return; + } else { + OPM_Get(&OPS_ch); + } + } + switch (OPS_ch) { + case '\"': case '\'': + OPS_Str(&s); + break; + case '#': + s = 10; + OPM_Get(&OPS_ch); + break; + case '&': + s = 5; + OPM_Get(&OPS_ch); + break; + case '(': + OPM_Get(&OPS_ch); + if (OPS_ch == '*') { + Comment__2(); + OPS_Get(&s); + } else { + s = 30; + } + break; + case ')': + s = 22; + OPM_Get(&OPS_ch); + break; + case '*': + s = 1; + OPM_Get(&OPS_ch); + break; + case '+': + s = 6; + OPM_Get(&OPS_ch); + break; + case ',': + s = 19; + OPM_Get(&OPS_ch); + break; + case '-': + s = 7; + OPM_Get(&OPS_ch); + break; + case '.': + OPM_Get(&OPS_ch); + if (OPS_ch == '.') { + OPM_Get(&OPS_ch); + s = 21; + } else { + s = 18; + } + break; + case '/': + s = 2; + OPM_Get(&OPS_ch); + break; + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + OPS_Number(); + s = 35; + break; + case ':': + OPM_Get(&OPS_ch); + if (OPS_ch == '=') { + OPM_Get(&OPS_ch); + s = 34; + } else { + s = 20; + } + break; + case ';': + s = 39; + OPM_Get(&OPS_ch); + break; + case '<': + OPM_Get(&OPS_ch); + if (OPS_ch == '=') { + OPM_Get(&OPS_ch); + s = 12; + } else { + s = 11; + } + break; + case '=': + s = 9; + OPM_Get(&OPS_ch); + break; + case '>': + OPM_Get(&OPS_ch); + if (OPS_ch == '=') { + OPM_Get(&OPS_ch); + s = 14; + } else { + s = 13; + } + break; + case 'A': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "ARRAY") == 0) { + s = 54; + } + break; + case 'B': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "BEGIN") == 0) { + s = 57; + } else if (__STRCMP(OPS_name, "BY") == 0) { + s = 29; + } + break; + case 'C': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "CASE") == 0) { + s = 46; + } else if (__STRCMP(OPS_name, "CONST") == 0) { + s = 58; + } + break; + case 'D': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "DO") == 0) { + s = 27; + } else if (__STRCMP(OPS_name, "DIV") == 0) { + s = 3; + } + break; + case 'E': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "END") == 0) { + s = 41; + } else if (__STRCMP(OPS_name, "ELSE") == 0) { + s = 42; + } else if (__STRCMP(OPS_name, "ELSIF") == 0) { + s = 43; + } else if (__STRCMP(OPS_name, "EXIT") == 0) { + s = 52; + } + break; + case 'F': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "FOR") == 0) { + s = 49; + } + break; + case 'I': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "IF") == 0) { + s = 45; + } else if (__STRCMP(OPS_name, "IN") == 0) { + s = 15; + } else if (__STRCMP(OPS_name, "IS") == 0) { + s = 16; + } else if (__STRCMP(OPS_name, "IMPORT") == 0) { + s = 62; + } + break; + case 'L': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "LOOP") == 0) { + s = 50; + } + break; + case 'M': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "MOD") == 0) { + s = 4; + } else if (__STRCMP(OPS_name, "MODULE") == 0) { + s = 63; + } + break; + case 'N': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "NIL") == 0) { + s = 36; + } + break; + case 'O': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "OR") == 0) { + s = 8; + } else if (__STRCMP(OPS_name, "OF") == 0) { + s = 25; + } + break; + case 'P': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "PROCEDURE") == 0) { + s = 61; + } else if (__STRCMP(OPS_name, "POINTER") == 0) { + s = 56; + } + break; + case 'R': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "RECORD") == 0) { + s = 55; + } else if (__STRCMP(OPS_name, "REPEAT") == 0) { + s = 48; + } else if (__STRCMP(OPS_name, "RETURN") == 0) { + s = 53; + } + break; + case 'T': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "THEN") == 0) { + s = 26; + } else if (__STRCMP(OPS_name, "TO") == 0) { + s = 28; + } else if (__STRCMP(OPS_name, "TYPE") == 0) { + s = 59; + } + break; + case 'U': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "UNTIL") == 0) { + s = 44; + } + break; + case 'V': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "VAR") == 0) { + s = 60; + } + break; + case 'W': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "WHILE") == 0) { + s = 47; + } else if (__STRCMP(OPS_name, "WITH") == 0) { + s = 51; + } + break; + case 'G': case 'H': case 'J': case 'K': case 'Q': + case 'S': case 'X': case 'Y': case 'Z': + OPS_Identifier(&s); + break; + case '[': + s = 31; + OPM_Get(&OPS_ch); + break; + case ']': + s = 23; + OPM_Get(&OPS_ch); + break; + case '^': + s = 17; + OPM_Get(&OPS_ch); + break; + case 'a': case 'b': case 'c': case 'd': case 'e': + case 'f': case 'g': case 'h': case 'i': case 'j': + case 'k': case 'l': case 'm': case 'n': case 'o': + case 'p': case 'q': case 'r': case 's': case 't': + case 'u': case 'v': case 'w': case 'x': case 'y': + case 'z': + OPS_Identifier(&s); + break; + case '{': + s = 32; + OPM_Get(&OPS_ch); + break; + case '|': + s = 40; + OPM_Get(&OPS_ch); + break; + case '}': + s = 24; + OPM_Get(&OPS_ch); + break; + case '~': + s = 33; + OPM_Get(&OPS_ch); + break; + case 0x7f: + s = 21; + OPM_Get(&OPS_ch); + break; + default: + s = 0; + OPM_Get(&OPS_ch); + break; + } + *sym = s; + Get__1_s = _s.lnk; +} + +void OPS_Init (void) +{ + OPS_ch = ' '; +} + + +export void *OPS__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPM); + __REGMOD("OPS", 0); + __REGCMD("Init", OPS_Init); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-88/OPS.h b/bootstrap/unix-88/OPS.h new file mode 100644 index 00000000..eab85912 --- /dev/null +++ b/bootstrap/unix-88/OPS.h @@ -0,0 +1,29 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tspkaSfF */ + +#ifndef OPS__h +#define OPS__h + +#define LARGE +#include "SYSTEM.h" + +typedef + CHAR OPS_Name[256]; + +typedef + CHAR OPS_String[256]; + + +import OPS_Name OPS_name; +import OPS_String OPS_str; +import INTEGER OPS_numtyp; +import LONGINT OPS_intval; +import REAL OPS_realval; +import LONGREAL OPS_lrlval; + + +import void OPS_Get (SHORTINT *sym); +import void OPS_Init (void); +import void *OPS__init(void); + + +#endif diff --git a/bootstrap/unix-88/OPT.c b/bootstrap/unix-88/OPT.c new file mode 100644 index 00000000..5f8854a1 --- /dev/null +++ b/bootstrap/unix-88/OPT.c @@ -0,0 +1,1859 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "OPM.h" +#include "OPS.h" + +typedef + struct OPT_ConstDesc *OPT_Const; + +typedef + OPS_String *OPT_ConstExt; + +typedef + struct OPT_ConstDesc { + OPT_ConstExt ext; + LONGINT intval, intval2; + SET setval; + LONGREAL realval; + } OPT_ConstDesc; + +typedef + struct OPT_ExpCtxt { + LONGINT reffp; + INTEGER ref; + SHORTINT nofm; + SHORTINT locmno[64]; + } OPT_ExpCtxt; + +typedef + struct OPT_StrDesc *OPT_Struct; + +typedef + struct OPT_ObjDesc *OPT_Object; + +typedef + struct OPT_ImpCtxt { + LONGINT nextTag, reffp; + INTEGER nofr, minr, nofm; + BOOLEAN self; + OPT_Struct ref[255]; + OPT_Object old[255]; + LONGINT pvfp[255]; + SHORTINT glbmno[64]; + } OPT_ImpCtxt; + +typedef + struct OPT_NodeDesc *OPT_Node; + +typedef + struct OPT_NodeDesc { + OPT_Node left, right, link; + SHORTINT class, subcl; + BOOLEAN readonly; + OPT_Struct typ; + OPT_Object obj; + OPT_Const conval; + } OPT_NodeDesc; + +typedef + struct OPT_ObjDesc { + OPT_Object left, right, link, scope; + OPS_Name name; + BOOLEAN leaf; + SHORTINT mode, mnolev, vis, history; + BOOLEAN used, fpdone; + LONGINT fprint; + OPT_Struct typ; + OPT_Const conval; + LONGINT adr, linkadr; + INTEGER x; + } OPT_ObjDesc; + +typedef + struct OPT_StrDesc { + SHORTINT form, comp, mno, extlev; + INTEGER ref, sysflag; + LONGINT n, size, align, txtpos; + BOOLEAN allocated, pbused, pvused, fpdone, idfpdone; + LONGINT idfp, pbfp, pvfp; + OPT_Struct BaseTyp; + OPT_Object link, strobj; + } OPT_StrDesc; + + +export void (*OPT_typSize)(OPT_Struct); +export OPT_Object OPT_topScope; +export OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp; +export SHORTINT OPT_nofGmod; +export OPT_Object OPT_GlbMod[64]; +export OPS_Name OPT_SelfName; +export BOOLEAN OPT_SYSimported; +static OPT_Object OPT_universe, OPT_syslink; +static OPT_ImpCtxt OPT_impCtxt; +static OPT_ExpCtxt OPT_expCtxt; +static LONGINT OPT_nofhdfld; +static BOOLEAN OPT_newsf, OPT_findpc, OPT_extsf, OPT_sfpresent, OPT_symExtended, OPT_symNew; + +export LONGINT *OPT_ConstDesc__typ; +export LONGINT *OPT_ObjDesc__typ; +export LONGINT *OPT_StrDesc__typ; +export LONGINT *OPT_NodeDesc__typ; +export LONGINT *OPT_ImpCtxt__typ; +export LONGINT *OPT_ExpCtxt__typ; + +export void OPT_Close (void); +export void OPT_CloseScope (void); +static void OPT_DebugStruct (OPT_Struct btyp); +static void OPT_EnterBoolConst (OPS_Name name, LONGINT value); +static void OPT_EnterProc (OPS_Name name, INTEGER num); +static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res); +export void OPT_Export (BOOLEAN *ext, BOOLEAN *new); +export void OPT_FPrintErr (OPT_Object obj, INTEGER errcode); +static void OPT_FPrintName (LONGINT *fp, CHAR *name, LONGINT name__len); +export void OPT_FPrintObj (OPT_Object obj); +static void OPT_FPrintSign (LONGINT *fp, OPT_Struct result, OPT_Object par); +export void OPT_FPrintStr (OPT_Struct typ); +export void OPT_Find (OPT_Object *res); +export void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res); +export void OPT_FindImport (OPT_Object mod, OPT_Object *res); +export void OPT_IdFPrint (OPT_Struct typ); +export void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done); +static void OPT_InConstant (LONGINT f, OPT_Const conval); +static OPT_Object OPT_InFld (void); +static void OPT_InMod (SHORTINT *mno); +static void OPT_InName (CHAR *name, LONGINT name__len); +static OPT_Object OPT_InObj (SHORTINT mno); +static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par); +static void OPT_InStruct (OPT_Struct *typ); +static OPT_Object OPT_InTProc (SHORTINT mno); +export void OPT_Init (OPS_Name name, SET opt); +static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form); +export void OPT_Insert (OPS_Name name, OPT_Object *obj); +export void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old); +export OPT_Const OPT_NewConst (void); +export OPT_ConstExt OPT_NewExt (void); +export OPT_Node OPT_NewNode (SHORTINT class); +export OPT_Object OPT_NewObj (void); +export OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp); +export void OPT_OpenScope (SHORTINT level, OPT_Object owner); +static void OPT_OutConstant (OPT_Object obj); +static void OPT_OutFlds (OPT_Object fld, LONGINT adr, BOOLEAN visible); +static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr); +static void OPT_OutMod (INTEGER mno); +static void OPT_OutName (CHAR *name, LONGINT name__len); +static void OPT_OutObj (OPT_Object obj); +static void OPT_OutSign (OPT_Struct result, OPT_Object par); +static void OPT_OutStr (OPT_Struct typ); +static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj); +static void OPT_err (INTEGER n); + + +static void OPT_err (INTEGER n) +{ + OPM_err(n); +} + +OPT_Const OPT_NewConst (void) +{ + OPT_Const _o_result; + OPT_Const const_ = NIL; + __NEW(const_, OPT_ConstDesc); + _o_result = const_; + return _o_result; +} + +OPT_Object OPT_NewObj (void) +{ + OPT_Object _o_result; + OPT_Object obj = NIL; + __NEW(obj, OPT_ObjDesc); + _o_result = obj; + return _o_result; +} + +OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp) +{ + OPT_Struct _o_result; + OPT_Struct typ = NIL; + __NEW(typ, OPT_StrDesc); + typ->form = form; + typ->comp = comp; + typ->ref = 255; + if (form != 0) { + typ->txtpos = OPM_errpos; + } + typ->size = -1; + typ->BaseTyp = OPT_undftyp; + _o_result = typ; + return _o_result; +} + +OPT_Node OPT_NewNode (SHORTINT class) +{ + OPT_Node _o_result; + OPT_Node node = NIL; + __NEW(node, OPT_NodeDesc); + node->class = class; + _o_result = node; + return _o_result; +} + +OPT_ConstExt OPT_NewExt (void) +{ + OPT_ConstExt _o_result; + OPT_ConstExt ext = NIL; + ext = __NEWARR(NIL, ((LONGINT)(1)), 1, 1, 0, (LONGINT)256); + _o_result = ext; + return _o_result; +} + +void OPT_OpenScope (SHORTINT level, OPT_Object owner) +{ + OPT_Object head = NIL; + head = OPT_NewObj(); + head->mode = 12; + head->mnolev = level; + head->link = owner; + if (owner != NIL) { + owner->scope = head; + } + head->left = OPT_topScope; + head->right = NIL; + head->scope = NIL; + OPT_topScope = head; +} + +void OPT_CloseScope (void) +{ + OPT_topScope = OPT_topScope->left; +} + +void OPT_Init (OPS_Name name, SET opt) +{ + OPT_topScope = OPT_universe; + OPT_OpenScope(0, NIL); + OPT_SYSimported = 0; + __COPY(name, OPT_SelfName, ((LONGINT)(256))); + __COPY(name, OPT_topScope->name, ((LONGINT)(256))); + OPT_GlbMod[0] = OPT_topScope; + OPT_nofGmod = 1; + OPT_newsf = __IN(4, opt); + OPT_findpc = __IN(8, opt); + OPT_extsf = OPT_newsf || __IN(9, opt); + OPT_sfpresent = 1; +} + +void OPT_Close (void) +{ + INTEGER i; + OPT_CloseScope(); + i = 0; + while (i < 64) { + OPT_GlbMod[__X(i, ((LONGINT)(64)))] = NIL; + i += 1; + } + i = 16; + while (i < 255) { + OPT_impCtxt.ref[__X(i, ((LONGINT)(255)))] = NIL; + OPT_impCtxt.old[__X(i, ((LONGINT)(255)))] = NIL; + i += 1; + } +} + +void OPT_FindImport (OPT_Object mod, OPT_Object *res) +{ + OPT_Object obj = NIL; + obj = mod->scope; + for (;;) { + if (obj == NIL) { + break; + } + if (__STRCMP(OPS_name, obj->name) < 0) { + obj = obj->left; + } else if (__STRCMP(OPS_name, obj->name) > 0) { + obj = obj->right; + } else { + if ((obj->mode == 5 && obj->vis == 0)) { + obj = NIL; + } else { + obj->used = 1; + } + break; + } + } + *res = obj; +} + +void OPT_Find (OPT_Object *res) +{ + OPT_Object obj = NIL, head = NIL; + head = OPT_topScope; + for (;;) { + obj = head->right; + for (;;) { + if (obj == NIL) { + break; + } + if (__STRCMP(OPS_name, obj->name) < 0) { + obj = obj->left; + } else if (__STRCMP(OPS_name, obj->name) > 0) { + obj = obj->right; + } else { + break; + } + } + if (obj != NIL) { + break; + } + head = head->left; + if (head == NIL) { + break; + } + } + *res = obj; +} + +void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res) +{ + OPT_Object obj = NIL; + while (typ != NIL) { + obj = typ->link; + while (obj != NIL) { + if (__STRCMP(name, obj->name) < 0) { + obj = obj->left; + } else if (__STRCMP(name, obj->name) > 0) { + obj = obj->right; + } else { + *res = obj; + return; + } + } + typ = typ->BaseTyp; + } + *res = NIL; +} + +void OPT_Insert (OPS_Name name, OPT_Object *obj) +{ + OPT_Object ob0 = NIL, ob1 = NIL; + BOOLEAN left; + SHORTINT mnolev; + ob0 = OPT_topScope; + ob1 = ob0->right; + left = 0; + for (;;) { + if (ob1 != NIL) { + if (__STRCMP(name, ob1->name) < 0) { + ob0 = ob1; + ob1 = ob0->left; + left = 1; + } else if (__STRCMP(name, ob1->name) > 0) { + ob0 = ob1; + ob1 = ob0->right; + left = 0; + } else { + OPT_err(1); + ob0 = ob1; + ob1 = ob0->right; + } + } else { + ob1 = OPT_NewObj(); + ob1->leaf = 1; + if (left) { + ob0->left = ob1; + } else { + ob0->right = ob1; + } + ob1->left = NIL; + ob1->right = NIL; + __COPY(name, ob1->name, ((LONGINT)(256))); + mnolev = OPT_topScope->mnolev; + ob1->mnolev = mnolev; + break; + } + } + *obj = ob1; +} + +static void OPT_FPrintName (LONGINT *fp, CHAR *name, LONGINT name__len) +{ + INTEGER i; + CHAR ch; + i = 0; + do { + ch = name[__X(i, name__len)]; + OPM_FPrint(&*fp, (int)ch); + i += 1; + } while (!(ch == 0x00)); +} + +static void OPT_DebugStruct (OPT_Struct btyp) +{ + OPM_LogWLn(); + if (btyp == NIL) { + OPM_LogWStr((CHAR*)"btyp is nil", (LONGINT)12); + OPM_LogWLn(); + } + OPM_LogWStr((CHAR*)"btyp^.strobji^.name = ", (LONGINT)23); + OPM_LogWStr(btyp->strobj->name, ((LONGINT)(256))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.form = ", (LONGINT)14); + OPM_LogWNum(btyp->form, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.comp = ", (LONGINT)14); + OPM_LogWNum(btyp->comp, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.mno = ", (LONGINT)13); + OPM_LogWNum(btyp->mno, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.extlev = ", (LONGINT)16); + OPM_LogWNum(btyp->extlev, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.size = ", (LONGINT)14); + OPM_LogWNum(btyp->size, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.align = ", (LONGINT)15); + OPM_LogWNum(btyp->align, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.txtpos = ", (LONGINT)16); + OPM_LogWNum(btyp->txtpos, ((LONGINT)(0))); + OPM_LogWLn(); +} + +static void OPT_FPrintSign (LONGINT *fp, OPT_Struct result, OPT_Object par) +{ + OPT_IdFPrint(result); + OPM_FPrint(&*fp, result->idfp); + while (par != NIL) { + OPM_FPrint(&*fp, par->mode); + OPT_IdFPrint(par->typ); + OPM_FPrint(&*fp, par->typ->idfp); + par = par->link; + } +} + +void OPT_IdFPrint (OPT_Struct typ) +{ + OPT_Struct btyp = NIL; + OPT_Object strobj = NIL; + LONGINT idfp; + INTEGER f, c; + if (!typ->idfpdone) { + typ->idfpdone = 1; + idfp = 0; + f = typ->form; + c = typ->comp; + OPM_FPrint(&idfp, f); + OPM_FPrint(&idfp, c); + btyp = typ->BaseTyp; + strobj = typ->strobj; + if ((strobj != NIL && strobj->name[0] != 0x00)) { + OPT_FPrintName(&idfp, (void*)OPT_GlbMod[__X(typ->mno, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + OPT_FPrintName(&idfp, (void*)strobj->name, ((LONGINT)(256))); + } + if ((f == 13 || (c == 4 && btyp != NIL)) || c == 3) { + OPT_IdFPrint(btyp); + OPM_FPrint(&idfp, btyp->idfp); + } else if (c == 2) { + OPT_IdFPrint(btyp); + OPM_FPrint(&idfp, btyp->idfp); + OPM_FPrint(&idfp, typ->n); + } else if (f == 14) { + OPT_FPrintSign(&idfp, btyp, typ->link); + } + typ->idfp = idfp; + } +} + +static struct FPrintStr__12 { + LONGINT *pbfp, *pvfp; + struct FPrintStr__12 *lnk; +} *FPrintStr__12_s; + +static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible); +static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr); +static void FPrintTProcs__17 (OPT_Object obj); + +static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr) +{ + LONGINT i, j, n; + OPT_Struct btyp = NIL; + if (typ->comp == 4) { + FPrintFlds__13(typ->link, adr, 0); + } else if (typ->comp == 2) { + btyp = typ->BaseTyp; + n = typ->n; + while (btyp->comp == 2) { + n = btyp->n * n; + btyp = btyp->BaseTyp; + } + if (btyp->form == 13 || btyp->comp == 4) { + j = OPT_nofhdfld; + FPrintHdFld__15(btyp, fld, adr); + if (j != OPT_nofhdfld) { + i = 1; + while ((i < n && OPT_nofhdfld <= 2048)) { + adr += btyp->size; + FPrintHdFld__15(btyp, fld, adr); + i += 1; + } + } + } + } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) { + OPM_FPrint(&*FPrintStr__12_s->pvfp, ((LONGINT)(13))); + OPM_FPrint(&*FPrintStr__12_s->pvfp, adr); + OPT_nofhdfld += 1; + } +} + +static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible) +{ + while ((fld != NIL && fld->mode == 4)) { + if ((fld->vis != 0 && visible)) { + OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->vis); + OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)fld->name, ((LONGINT)(256))); + OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->adr); + OPT_FPrintStr(fld->typ); + OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->typ->pbfp); + OPM_FPrint(&*FPrintStr__12_s->pvfp, fld->typ->pvfp); + } else { + FPrintHdFld__15(fld->typ, fld, fld->adr + adr); + } + fld = fld->link; + } +} + +static void FPrintTProcs__17 (OPT_Object obj) +{ + if (obj != NIL) { + FPrintTProcs__17(obj->left); + if (obj->mode == 13) { + if (obj->vis != 0) { + OPM_FPrint(&*FPrintStr__12_s->pbfp, ((LONGINT)(13))); + OPM_FPrint(&*FPrintStr__12_s->pbfp, __ASHR(obj->adr, 16)); + OPT_FPrintSign(&*FPrintStr__12_s->pbfp, obj->typ, obj->link); + OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)obj->name, ((LONGINT)(256))); + } + } + FPrintTProcs__17(obj->right); + } +} + +void OPT_FPrintStr (OPT_Struct typ) +{ + INTEGER f, c; + OPT_Struct btyp = NIL; + OPT_Object strobj = NIL, bstrobj = NIL; + LONGINT pbfp, pvfp; + struct FPrintStr__12 _s; + _s.pbfp = &pbfp; + _s.pvfp = &pvfp; + _s.lnk = FPrintStr__12_s; + FPrintStr__12_s = &_s; + if (!typ->fpdone) { + OPT_IdFPrint(typ); + pbfp = typ->idfp; + if (typ->sysflag != 0) { + OPM_FPrint(&pbfp, typ->sysflag); + } + pvfp = pbfp; + typ->pbfp = pbfp; + typ->pvfp = pvfp; + typ->fpdone = 1; + f = typ->form; + c = typ->comp; + btyp = typ->BaseTyp; + if (f == 13) { + strobj = typ->strobj; + bstrobj = btyp->strobj; + if (((strobj == NIL || strobj->name[0] == 0x00) || bstrobj == NIL) || bstrobj->name[0] == 0x00) { + OPT_FPrintStr(btyp); + OPM_FPrint(&pbfp, btyp->pbfp); + pvfp = pbfp; + } + } else if (f == 14) { + } else if (__IN(c, 0x0c)) { + OPT_FPrintStr(btyp); + OPM_FPrint(&pbfp, btyp->pvfp); + pvfp = pbfp; + } else { + if (btyp != NIL) { + OPT_FPrintStr(btyp); + OPM_FPrint(&pbfp, btyp->pbfp); + OPM_FPrint(&pvfp, btyp->pvfp); + } + OPM_FPrint(&pvfp, typ->size); + OPM_FPrint(&pvfp, typ->align); + OPM_FPrint(&pvfp, typ->n); + OPT_nofhdfld = 0; + FPrintFlds__13(typ->link, ((LONGINT)(0)), 1); + if (OPT_nofhdfld > 2048) { + OPM_Mark(225, typ->txtpos); + } + FPrintTProcs__17(typ->link); + OPM_FPrint(&pvfp, pbfp); + strobj = typ->strobj; + if (strobj == NIL || strobj->name[0] == 0x00) { + pbfp = pvfp; + } + } + typ->pbfp = pbfp; + typ->pvfp = pvfp; + } + FPrintStr__12_s = _s.lnk; +} + +void OPT_FPrintObj (OPT_Object obj) +{ + LONGINT fprint; + INTEGER f, m; + REAL rval; + OPT_ConstExt ext = NIL; + if (!obj->fpdone) { + fprint = 0; + obj->fpdone = 1; + OPM_FPrint(&fprint, obj->mode); + if (obj->mode == 3) { + f = obj->typ->form; + OPM_FPrint(&fprint, f); + switch (f) { + case 2: case 3: case 4: case 5: case 6: + OPM_FPrint(&fprint, obj->conval->intval); + break; + case 9: + OPM_FPrintSet(&fprint, obj->conval->setval); + break; + case 7: + rval = obj->conval->realval; + OPM_FPrintReal(&fprint, rval); + break; + case 8: + OPM_FPrintLReal(&fprint, obj->conval->realval); + break; + case 10: + OPT_FPrintName(&fprint, (void*)*obj->conval->ext, ((LONGINT)(256))); + break; + case 11: + break; + default: + OPT_err(127); + break; + } + } else if (obj->mode == 1) { + OPM_FPrint(&fprint, obj->vis); + OPT_FPrintStr(obj->typ); + OPM_FPrint(&fprint, obj->typ->pbfp); + } else if (__IN(obj->mode, 0x0480)) { + OPT_FPrintSign(&fprint, obj->typ, obj->link); + } else if (obj->mode == 9) { + OPT_FPrintSign(&fprint, obj->typ, obj->link); + ext = obj->conval->ext; + m = (int)(*ext)[0]; + f = 1; + OPM_FPrint(&fprint, m); + while (f <= m) { + OPM_FPrint(&fprint, (int)(*ext)[__X(f, ((LONGINT)(256)))]); + f += 1; + } + } else if (obj->mode == 5) { + OPT_FPrintStr(obj->typ); + OPM_FPrint(&fprint, obj->typ->pbfp); + } + obj->fprint = fprint; + } +} + +void OPT_FPrintErr (OPT_Object obj, INTEGER errcode) +{ + INTEGER i, j; + CHAR ch; + if (obj->mnolev != 0) { + __COPY(OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, OPM_objname, ((LONGINT)(64))); + i = 0; + while (OPM_objname[__X(i, ((LONGINT)(64)))] != 0x00) { + i += 1; + } + OPM_objname[__X(i, ((LONGINT)(64)))] = '.'; + j = 0; + i += 1; + do { + ch = obj->name[__X(j, ((LONGINT)(256)))]; + OPM_objname[__X(i, ((LONGINT)(64)))] = ch; + j += 1; + i += 1; + } while (!(ch == 0x00)); + } else { + __COPY(obj->name, OPM_objname, ((LONGINT)(64))); + } + if (errcode == 249) { + if (OPM_noerr) { + OPT_err(errcode); + } + } else if (errcode == 253) { + if ((((!OPT_symNew && !OPT_symExtended)) && !OPT_extsf)) { + OPT_err(errcode); + } + OPT_symExtended = 1; + } else { + if ((!OPT_symNew && !OPT_newsf)) { + OPT_err(errcode); + } + OPT_symNew = 1; + } +} + +void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old) +{ + OPT_Object ob0 = NIL, ob1 = NIL; + BOOLEAN left; + if (*root == NIL) { + *root = obj; + *old = NIL; + } else { + ob0 = *root; + ob1 = ob0->right; + left = 0; + if (__STRCMP(obj->name, ob0->name) < 0) { + ob1 = ob0->left; + left = 1; + } else if (__STRCMP(obj->name, ob0->name) > 0) { + ob1 = ob0->right; + left = 0; + } else { + *old = ob0; + return; + } + for (;;) { + if (ob1 != NIL) { + if (__STRCMP(obj->name, ob1->name) < 0) { + ob0 = ob1; + ob1 = ob1->left; + left = 1; + } else if (__STRCMP(obj->name, ob1->name) > 0) { + ob0 = ob1; + ob1 = ob1->right; + left = 0; + } else { + *old = ob1; + break; + } + } else { + ob1 = obj; + if (left) { + ob0->left = ob1; + } else { + ob0->right = ob1; + } + ob1->left = NIL; + ob1->right = NIL; + *old = NIL; + break; + } + } + } +} + +static void OPT_InName (CHAR *name, LONGINT name__len) +{ + INTEGER i; + CHAR ch; + i = 0; + do { + OPM_SymRCh(&ch); + name[__X(i, name__len)] = ch; + i += 1; + } while (!(ch == 0x00)); +} + +static void OPT_InMod (SHORTINT *mno) +{ + OPT_Object head = NIL; + OPS_Name name; + LONGINT mn; + SHORTINT i; + mn = OPM_SymRInt(); + if (mn == 0) { + *mno = OPT_impCtxt.glbmno[0]; + } else { + if (mn == 16) { + OPT_InName((void*)name, ((LONGINT)(256))); + if ((__STRCMP(name, OPT_SelfName) == 0 && !OPT_impCtxt.self)) { + OPT_err(154); + } + i = 0; + while ((i < OPT_nofGmod && __STRCMP(name, OPT_GlbMod[__X(i, ((LONGINT)(64)))]->name) != 0)) { + i += 1; + } + if (i < OPT_nofGmod) { + *mno = i; + } else { + head = OPT_NewObj(); + head->mode = 12; + __COPY(name, head->name, ((LONGINT)(256))); + *mno = OPT_nofGmod; + head->mnolev = -*mno; + if (OPT_nofGmod < 64) { + OPT_GlbMod[__X(*mno, ((LONGINT)(64)))] = head; + OPT_nofGmod += 1; + } else { + OPT_err(227); + } + } + OPT_impCtxt.glbmno[__X(OPT_impCtxt.nofm, ((LONGINT)(64)))] = *mno; + OPT_impCtxt.nofm += 1; + } else { + *mno = OPT_impCtxt.glbmno[__X(-mn, ((LONGINT)(64)))]; + } + } +} + +static void OPT_InConstant (LONGINT f, OPT_Const conval) +{ + CHAR ch; + INTEGER i; + OPT_ConstExt ext = NIL; + REAL rval; + switch (f) { + case 1: case 3: case 2: + OPM_SymRCh(&ch); + conval->intval = (int)ch; + break; + case 4: case 5: case 6: + conval->intval = OPM_SymRInt(); + break; + case 9: + OPM_SymRSet(&conval->setval); + break; + case 7: + OPM_SymRReal(&rval); + conval->realval = rval; + conval->intval = -1; + break; + case 8: + OPM_SymRLReal(&conval->realval); + conval->intval = -1; + break; + case 10: + ext = OPT_NewExt(); + conval->ext = ext; + i = 0; + do { + OPM_SymRCh(&ch); + (*ext)[__X(i, ((LONGINT)(256)))] = ch; + i += 1; + } while (!(ch == 0x00)); + conval->intval2 = i; + conval->intval = -1; + break; + case 11: + conval->intval = 0; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPT.InConstant(), f = ", (LONGINT)41); + OPM_LogWNum(f, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } +} + +static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par) +{ + OPT_Object last = NIL, new = NIL; + LONGINT tag; + OPT_InStruct(&*res); + tag = OPM_SymRInt(); + last = NIL; + while (tag != 18) { + new = OPT_NewObj(); + new->mnolev = -mno; + if (last == NIL) { + *par = new; + } else { + last->link = new; + } + if (tag == 23) { + new->mode = 1; + } else { + new->mode = 2; + } + OPT_InStruct(&new->typ); + new->adr = OPM_SymRInt(); + OPT_InName((void*)new->name, ((LONGINT)(256))); + last = new; + tag = OPM_SymRInt(); + } +} + +static OPT_Object OPT_InFld (void) +{ + OPT_Object _o_result; + LONGINT tag; + OPT_Object obj = NIL; + tag = OPT_impCtxt.nextTag; + obj = OPT_NewObj(); + if (tag <= 26) { + obj->mode = 4; + if (tag == 26) { + obj->vis = 2; + } else { + obj->vis = 1; + } + OPT_InStruct(&obj->typ); + OPT_InName((void*)obj->name, ((LONGINT)(256))); + obj->adr = OPM_SymRInt(); + } else { + obj->mode = 4; + if (tag == 27) { + __MOVE("@ptr", obj->name, 5); + } else { + __MOVE("@proc", obj->name, 6); + } + obj->typ = OPT_undftyp; + obj->vis = 0; + obj->adr = OPM_SymRInt(); + } + _o_result = obj; + return _o_result; +} + +static OPT_Object OPT_InTProc (SHORTINT mno) +{ + OPT_Object _o_result; + LONGINT tag; + OPT_Object obj = NIL; + tag = OPT_impCtxt.nextTag; + obj = OPT_NewObj(); + obj->mnolev = -mno; + if (tag == 29) { + obj->mode = 13; + obj->conval = OPT_NewConst(); + obj->conval->intval = -1; + OPT_InSign(mno, &obj->typ, &obj->link); + obj->vis = 1; + OPT_InName((void*)obj->name, ((LONGINT)(256))); + obj->adr = __ASHL(OPM_SymRInt(), 16); + } else { + obj->mode = 13; + __MOVE("@tproc", obj->name, 7); + obj->link = OPT_NewObj(); + obj->typ = OPT_undftyp; + obj->vis = 0; + obj->adr = __ASHL(OPM_SymRInt(), 16); + } + _o_result = obj; + return _o_result; +} + +static void OPT_InStruct (OPT_Struct *typ) +{ + SHORTINT mno; + INTEGER ref; + LONGINT tag; + OPS_Name name; + OPT_Struct t = NIL; + OPT_Object obj = NIL, last = NIL, fld = NIL, old = NIL, dummy = NIL; + tag = OPM_SymRInt(); + if (tag != 34) { + *typ = OPT_impCtxt.ref[__X(-tag, ((LONGINT)(255)))]; + } else { + ref = OPT_impCtxt.nofr; + OPT_impCtxt.nofr += 1; + if (ref < OPT_impCtxt.minr) { + OPT_impCtxt.minr = ref; + } + OPT_InMod(&mno); + OPT_InName((void*)name, ((LONGINT)(256))); + obj = OPT_NewObj(); + if (name[0] == 0x00) { + if (OPT_impCtxt.self) { + old = NIL; + } else { + __MOVE("@", obj->name, 2); + OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old); + obj->name[0] = 0x00; + } + *typ = OPT_NewStr(0, 1); + } else { + __COPY(name, obj->name, ((LONGINT)(256))); + OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old); + if (old != NIL) { + OPT_FPrintObj(old); + OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] = old->typ->pvfp; + if (OPT_impCtxt.self) { + *typ = OPT_NewStr(0, 1); + } else { + *typ = old->typ; + (*typ)->link = NIL; + (*typ)->sysflag = 0; + (*typ)->fpdone = 0; + (*typ)->idfpdone = 0; + } + } else { + *typ = OPT_NewStr(0, 1); + } + } + OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))] = *typ; + OPT_impCtxt.old[__X(ref, ((LONGINT)(255)))] = old; + (*typ)->ref = ref + 255; + (*typ)->mno = mno; + (*typ)->allocated = 1; + (*typ)->strobj = obj; + obj->mode = 5; + obj->typ = *typ; + obj->mnolev = -mno; + obj->vis = 0; + tag = OPM_SymRInt(); + if (tag == 35) { + (*typ)->sysflag = (int)OPM_SymRInt(); + tag = OPM_SymRInt(); + } + switch (tag) { + case 36: + (*typ)->form = 13; + (*typ)->size = OPM_PointerSize; + (*typ)->n = 0; + OPT_InStruct(&(*typ)->BaseTyp); + break; + case 37: + (*typ)->form = 15; + (*typ)->comp = 2; + OPT_InStruct(&(*typ)->BaseTyp); + (*typ)->n = OPM_SymRInt(); + (*OPT_typSize)(*typ); + break; + case 38: + (*typ)->form = 15; + (*typ)->comp = 3; + OPT_InStruct(&(*typ)->BaseTyp); + if ((*typ)->BaseTyp->comp == 3) { + (*typ)->n = (*typ)->BaseTyp->n + 1; + } else { + (*typ)->n = 0; + } + (*OPT_typSize)(*typ); + break; + case 39: + (*typ)->form = 15; + (*typ)->comp = 4; + OPT_InStruct(&(*typ)->BaseTyp); + if ((*typ)->BaseTyp == OPT_notyp) { + (*typ)->BaseTyp = NIL; + } + (*typ)->extlev = 0; + t = (*typ)->BaseTyp; + while (t != NIL) { + (*typ)->extlev += 1; + t = t->BaseTyp; + } + (*typ)->size = OPM_SymRInt(); + (*typ)->align = OPM_SymRInt(); + (*typ)->n = OPM_SymRInt(); + OPT_impCtxt.nextTag = OPM_SymRInt(); + last = NIL; + while ((OPT_impCtxt.nextTag >= 25 && OPT_impCtxt.nextTag <= 28)) { + fld = OPT_InFld(); + fld->mnolev = -mno; + if (last != NIL) { + last->link = fld; + } + last = fld; + OPT_InsertImport(fld, &(*typ)->link, &dummy); + OPT_impCtxt.nextTag = OPM_SymRInt(); + } + while (OPT_impCtxt.nextTag != 18) { + fld = OPT_InTProc(mno); + OPT_InsertImport(fld, &(*typ)->link, &dummy); + OPT_impCtxt.nextTag = OPM_SymRInt(); + } + break; + case 40: + (*typ)->form = 14; + (*typ)->size = OPM_ProcSize; + OPT_InSign(mno, &(*typ)->BaseTyp, &(*typ)->link); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.InStruct, tag = ", (LONGINT)39); + OPM_LogWNum(tag, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + if (ref == OPT_impCtxt.minr) { + while (ref < OPT_impCtxt.nofr) { + t = OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))]; + OPT_FPrintStr(t); + obj = t->strobj; + if (obj->name[0] != 0x00) { + OPT_FPrintObj(obj); + } + old = OPT_impCtxt.old[__X(ref, ((LONGINT)(255)))]; + if (old != NIL) { + t->strobj = old; + if (OPT_impCtxt.self) { + if (old->mnolev < 0) { + if (old->history != 5) { + if (old->fprint != obj->fprint) { + old->history = 2; + } else if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) { + old->history = 3; + } + } + } else if (old->fprint != obj->fprint) { + old->history = 2; + } else if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) { + old->history = 3; + } else if (old->vis == 0) { + old->history = 1; + } else { + old->history = 0; + } + } else { + if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) { + old->history = 5; + } + if (old->fprint != obj->fprint) { + OPT_FPrintErr(old, 249); + } + } + } else if (OPT_impCtxt.self) { + obj->history = 4; + } else { + obj->history = 1; + } + ref += 1; + } + OPT_impCtxt.minr = 255; + } + } +} + +static OPT_Object OPT_InObj (SHORTINT mno) +{ + OPT_Object _o_result; + INTEGER i, s; + CHAR ch; + OPT_Object obj = NIL, old = NIL; + OPT_Struct typ = NIL; + LONGINT tag; + OPT_ConstExt ext = NIL; + tag = OPT_impCtxt.nextTag; + if (tag == 19) { + OPT_InStruct(&typ); + obj = typ->strobj; + if (!OPT_impCtxt.self) { + obj->vis = 1; + } + } else { + obj = OPT_NewObj(); + obj->mnolev = -mno; + obj->vis = 1; + if (tag <= 13) { + obj->mode = 3; + obj->typ = OPT_impCtxt.ref[__X(tag, ((LONGINT)(255)))]; + obj->conval = OPT_NewConst(); + OPT_InConstant(tag, obj->conval); + } else if (tag >= 31) { + obj->conval = OPT_NewConst(); + obj->conval->intval = -1; + OPT_InSign(mno, &obj->typ, &obj->link); + switch (tag) { + case 31: + obj->mode = 7; + break; + case 32: + obj->mode = 10; + break; + case 33: + obj->mode = 9; + ext = OPT_NewExt(); + obj->conval->ext = ext; + s = (int)OPM_SymRInt(); + (*ext)[0] = (CHAR)s; + i = 1; + while (i <= s) { + OPM_SymRCh(&(*ext)[__X(i, ((LONGINT)(256)))]); + i += 1; + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.InObj, tag = ", (LONGINT)36); + OPM_LogWNum(tag, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } else if (tag == 20) { + obj->mode = 5; + OPT_InStruct(&obj->typ); + } else { + obj->mode = 1; + if (tag == 22) { + obj->vis = 2; + } + OPT_InStruct(&obj->typ); + } + OPT_InName((void*)obj->name, ((LONGINT)(256))); + } + OPT_FPrintObj(obj); + if ((obj->mode == 1 && (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00))) { + OPM_FPrint(&OPT_impCtxt.reffp, obj->typ->ref - 255); + } + if (tag != 19) { + OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old); + if (OPT_impCtxt.self) { + if (old != NIL) { + if (old->vis == 0) { + old->history = 4; + } else { + OPT_FPrintObj(old); + if (obj->fprint != old->fprint) { + old->history = 2; + } else if (obj->typ->pvfp != old->typ->pvfp) { + old->history = 3; + } else { + old->history = 1; + } + } + } else { + obj->history = 4; + } + } + } else { + if (OPT_impCtxt.self) { + if (obj->vis == 0) { + obj->history = 4; + } else if (obj->history == 0) { + obj->history = 1; + } + } + } + _o_result = obj; + return _o_result; +} + +void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done) +{ + OPT_Object obj = NIL; + SHORTINT mno; + OPS_Name aliasName__copy; + __DUPARR(aliasName, OPS_Name); + if (__STRCMP(name, "SYSTEM") == 0) { + OPT_SYSimported = 1; + OPT_Insert(aliasName, &obj); + obj->mode = 11; + obj->mnolev = 0; + obj->scope = OPT_syslink; + obj->typ = OPT_notyp; + } else { + OPT_impCtxt.nofr = 16; + OPT_impCtxt.minr = 255; + OPT_impCtxt.nofm = 0; + OPT_impCtxt.self = __STRCMP(aliasName, "@self") == 0; + OPT_impCtxt.reffp = 0; + OPM_OldSym((void*)name, ((LONGINT)(256)), &*done); + if (*done) { + OPT_InMod(&mno); + OPT_impCtxt.nextTag = OPM_SymRInt(); + while (!OPM_eofSF()) { + obj = OPT_InObj(mno); + OPT_impCtxt.nextTag = OPM_SymRInt(); + } + OPT_Insert(aliasName, &obj); + obj->mode = 11; + obj->scope = OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right; + OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->link = obj; + obj->mnolev = -mno; + obj->typ = OPT_notyp; + OPM_CloseOldSym(); + } else if (OPT_impCtxt.self) { + OPT_newsf = 1; + OPT_extsf = 1; + OPT_sfpresent = 0; + } else { + OPT_err(152); + } + } +} + +static void OPT_OutName (CHAR *name, LONGINT name__len) +{ + INTEGER i; + CHAR ch; + i = 0; + do { + ch = name[__X(i, name__len)]; + OPM_SymWCh(ch); + i += 1; + } while (!(ch == 0x00)); +} + +static void OPT_OutMod (INTEGER mno) +{ + if (OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))] < 0) { + OPM_SymWInt(((LONGINT)(16))); + OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))] = OPT_expCtxt.nofm; + OPT_expCtxt.nofm += 1; + OPT_OutName((void*)OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + } else { + OPM_SymWInt(-OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))]); + } +} + +static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr) +{ + LONGINT i, j, n; + OPT_Struct btyp = NIL; + if (typ->comp == 4) { + OPT_OutFlds(typ->link, adr, 0); + } else if (typ->comp == 2) { + btyp = typ->BaseTyp; + n = typ->n; + while (btyp->comp == 2) { + n = btyp->n * n; + btyp = btyp->BaseTyp; + } + if (btyp->form == 13 || btyp->comp == 4) { + j = OPT_nofhdfld; + OPT_OutHdFld(btyp, fld, adr); + if (j != OPT_nofhdfld) { + i = 1; + while ((i < n && OPT_nofhdfld <= 2048)) { + adr += btyp->size; + OPT_OutHdFld(btyp, fld, adr); + i += 1; + } + } + } + } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) { + OPM_SymWInt(((LONGINT)(27))); + OPM_SymWInt(adr); + OPT_nofhdfld += 1; + } +} + +static void OPT_OutFlds (OPT_Object fld, LONGINT adr, BOOLEAN visible) +{ + while ((fld != NIL && fld->mode == 4)) { + if ((fld->vis != 0 && visible)) { + if (fld->vis == 2) { + OPM_SymWInt(((LONGINT)(26))); + } else { + OPM_SymWInt(((LONGINT)(25))); + } + OPT_OutStr(fld->typ); + OPT_OutName((void*)fld->name, ((LONGINT)(256))); + OPM_SymWInt(fld->adr); + } else { + OPT_OutHdFld(fld->typ, fld, fld->adr + adr); + } + fld = fld->link; + } +} + +static void OPT_OutSign (OPT_Struct result, OPT_Object par) +{ + OPT_OutStr(result); + while (par != NIL) { + if (par->mode == 1) { + OPM_SymWInt(((LONGINT)(23))); + } else { + OPM_SymWInt(((LONGINT)(24))); + } + OPT_OutStr(par->typ); + OPM_SymWInt(par->adr); + OPT_OutName((void*)par->name, ((LONGINT)(256))); + par = par->link; + } + OPM_SymWInt(((LONGINT)(18))); +} + +static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj) +{ + if (obj != NIL) { + OPT_OutTProcs(typ, obj->left); + if (obj->mode == 13) { + if ((((typ->BaseTyp != NIL && __ASHR(obj->adr, 16) < typ->BaseTyp->n)) && obj->vis == 0)) { + OPM_Mark(109, typ->txtpos); + } + if (obj->vis != 0) { + if (obj->vis != 0) { + OPM_SymWInt(((LONGINT)(29))); + OPT_OutSign(obj->typ, obj->link); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + OPM_SymWInt(__ASHR(obj->adr, 16)); + } else { + OPM_SymWInt(((LONGINT)(30))); + OPM_SymWInt(__ASHR(obj->adr, 16)); + } + } + } + OPT_OutTProcs(typ, obj->right); + } +} + +static void OPT_OutStr (OPT_Struct typ) +{ + OPT_Object strobj = NIL; + if (typ->ref < OPT_expCtxt.ref) { + OPM_SymWInt(-typ->ref); + } else { + OPM_SymWInt(((LONGINT)(34))); + typ->ref = OPT_expCtxt.ref; + OPT_expCtxt.ref += 1; + if (OPT_expCtxt.ref >= 255) { + OPT_err(228); + } + OPT_OutMod(typ->mno); + strobj = typ->strobj; + if ((strobj != NIL && strobj->name[0] != 0x00)) { + OPT_OutName((void*)strobj->name, ((LONGINT)(256))); + switch (strobj->history) { + case 2: + OPT_FPrintErr(strobj, 252); + break; + case 3: + OPT_FPrintErr(strobj, 251); + break; + case 5: + OPT_FPrintErr(strobj, 249); + break; + default: + break; + } + } else { + OPM_SymWCh(0x00); + } + if (typ->sysflag != 0) { + OPM_SymWInt(((LONGINT)(35))); + OPM_SymWInt(typ->sysflag); + } + switch (typ->form) { + case 13: + OPM_SymWInt(((LONGINT)(36))); + OPT_OutStr(typ->BaseTyp); + break; + case 14: + OPM_SymWInt(((LONGINT)(40))); + OPT_OutSign(typ->BaseTyp, typ->link); + break; + case 15: + switch (typ->comp) { + case 2: + OPM_SymWInt(((LONGINT)(37))); + OPT_OutStr(typ->BaseTyp); + OPM_SymWInt(typ->n); + break; + case 3: + OPM_SymWInt(((LONGINT)(38))); + OPT_OutStr(typ->BaseTyp); + break; + case 4: + OPM_SymWInt(((LONGINT)(39))); + if (typ->BaseTyp == NIL) { + OPT_OutStr(OPT_notyp); + } else { + OPT_OutStr(typ->BaseTyp); + } + OPM_SymWInt(typ->size); + OPM_SymWInt(typ->align); + OPM_SymWInt(typ->n); + OPT_nofhdfld = 0; + OPT_OutFlds(typ->link, ((LONGINT)(0)), 1); + if (OPT_nofhdfld > 2048) { + OPM_Mark(223, typ->txtpos); + } + OPT_OutTProcs(typ, typ->link); + OPM_SymWInt(((LONGINT)(18))); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.OutStr, typ^.comp = ", (LONGINT)43); + OPM_LogWNum(typ->comp, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.OutStr, typ^.form = ", (LONGINT)43); + OPM_LogWNum(typ->form, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } +} + +static void OPT_OutConstant (OPT_Object obj) +{ + INTEGER f; + REAL rval; + f = obj->typ->form; + OPM_SymWInt(f); + switch (f) { + case 2: case 3: + OPM_SymWCh((CHAR)obj->conval->intval); + break; + case 4: case 5: case 6: + OPM_SymWInt(obj->conval->intval); + break; + case 9: + OPM_SymWSet(obj->conval->setval); + break; + case 7: + rval = obj->conval->realval; + OPM_SymWReal(rval); + break; + case 8: + OPM_SymWLReal(obj->conval->realval); + break; + case 10: + OPT_OutName((void*)*obj->conval->ext, ((LONGINT)(256))); + break; + case 11: + break; + default: + OPT_err(127); + break; + } +} + +static void OPT_OutObj (OPT_Object obj) +{ + INTEGER i, j; + OPT_ConstExt ext = NIL; + if (obj != NIL) { + OPT_OutObj(obj->left); + if (__IN(obj->mode, 0x06ea)) { + if (obj->history == 4) { + OPT_FPrintErr(obj, 250); + } else if (obj->vis != 0) { + switch (obj->history) { + case 0: + OPT_FPrintErr(obj, 253); + break; + case 1: + break; + case 2: + OPT_FPrintErr(obj, 252); + break; + case 3: + OPT_FPrintErr(obj, 251); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.OutObj, obj^.history = ", (LONGINT)46); + OPM_LogWNum(obj->history, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + switch (obj->mode) { + case 3: + OPT_OutConstant(obj); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + break; + case 5: + if (obj->typ->strobj == obj) { + OPM_SymWInt(((LONGINT)(19))); + OPT_OutStr(obj->typ); + } else { + OPM_SymWInt(((LONGINT)(20))); + OPT_OutStr(obj->typ); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + } + break; + case 1: + if (obj->vis == 2) { + OPM_SymWInt(((LONGINT)(22))); + } else { + OPM_SymWInt(((LONGINT)(21))); + } + OPT_OutStr(obj->typ); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + if (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00) { + OPM_FPrint(&OPT_expCtxt.reffp, obj->typ->ref); + } + break; + case 7: + OPM_SymWInt(((LONGINT)(31))); + OPT_OutSign(obj->typ, obj->link); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + break; + case 10: + OPM_SymWInt(((LONGINT)(32))); + OPT_OutSign(obj->typ, obj->link); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + break; + case 9: + OPM_SymWInt(((LONGINT)(33))); + OPT_OutSign(obj->typ, obj->link); + ext = obj->conval->ext; + j = (int)(*ext)[0]; + i = 1; + OPM_SymWInt(j); + while (i <= j) { + OPM_SymWCh((*ext)[__X(i, ((LONGINT)(256)))]); + i += 1; + } + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.OutObj, obj.mode = ", (LONGINT)42); + OPM_LogWNum(obj->mode, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } + } + OPT_OutObj(obj->right); + } +} + +void OPT_Export (BOOLEAN *ext, BOOLEAN *new) +{ + INTEGER i; + SHORTINT nofmod; + BOOLEAN done; + OPT_symExtended = 0; + OPT_symNew = 0; + nofmod = OPT_nofGmod; + OPT_Import((CHAR*)"@self", OPT_SelfName, &done); + OPT_nofGmod = nofmod; + if (OPM_noerr) { + OPM_NewSym((void*)OPT_SelfName, ((LONGINT)(256))); + if (OPM_noerr) { + OPM_SymWInt(((LONGINT)(16))); + OPT_OutName((void*)OPT_SelfName, ((LONGINT)(256))); + OPT_expCtxt.reffp = 0; + OPT_expCtxt.ref = 16; + OPT_expCtxt.nofm = 1; + OPT_expCtxt.locmno[0] = 0; + i = 1; + while (i < 64) { + OPT_expCtxt.locmno[__X(i, ((LONGINT)(64)))] = -1; + i += 1; + } + OPT_OutObj(OPT_topScope->right); + *ext = (OPT_sfpresent && OPT_symExtended); + *new = !OPT_sfpresent || OPT_symNew; + if (OPM_forceNewSym) { + *new = 1; + } + if ((((OPM_noerr && OPT_sfpresent)) && OPT_impCtxt.reffp != OPT_expCtxt.reffp)) { + *new = 1; + if (!OPT_extsf) { + OPT_err(155); + } + } + OPT_newsf = 0; + OPT_symNew = 0; + if (!OPM_noerr || OPT_findpc) { + OPM_DeleteNewSym(); + } + } + } +} + +static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form) +{ + *typ = OPT_NewStr(form, 1); + (*typ)->ref = form; + (*typ)->size = OPM_ByteSize; + (*typ)->allocated = 1; + (*typ)->strobj = OPT_NewObj(); + (*typ)->pbfp = form; + (*typ)->pvfp = form; + (*typ)->fpdone = 1; + (*typ)->idfp = form; + (*typ)->idfpdone = 1; +} + +static void OPT_EnterBoolConst (OPS_Name name, LONGINT value) +{ + OPT_Object obj = NIL; + OPS_Name name__copy; + __DUPARR(name, OPS_Name); + OPT_Insert(name, &obj); + obj->conval = OPT_NewConst(); + obj->mode = 3; + obj->typ = OPT_booltyp; + obj->conval->intval = value; +} + +static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res) +{ + OPT_Object obj = NIL; + OPT_Struct typ = NIL; + OPS_Name name__copy; + __DUPARR(name, OPS_Name); + OPT_Insert(name, &obj); + typ = OPT_NewStr(form, 1); + obj->mode = 5; + obj->typ = typ; + obj->vis = 1; + typ->strobj = obj; + typ->size = size; + typ->ref = form; + typ->allocated = 1; + typ->pbfp = form; + typ->pvfp = form; + typ->fpdone = 1; + typ->idfp = form; + typ->idfpdone = 1; + *res = typ; +} + +static void OPT_EnterProc (OPS_Name name, INTEGER num) +{ + OPT_Object obj = NIL; + OPS_Name name__copy; + __DUPARR(name, OPS_Name); + OPT_Insert(name, &obj); + obj->mode = 8; + obj->typ = OPT_notyp; + obj->adr = num; +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(OPT_topScope); + P(OPT_undftyp); + P(OPT_bytetyp); + P(OPT_booltyp); + P(OPT_chartyp); + P(OPT_sinttyp); + P(OPT_inttyp); + P(OPT_linttyp); + P(OPT_realtyp); + P(OPT_lrltyp); + P(OPT_settyp); + P(OPT_stringtyp); + P(OPT_niltyp); + P(OPT_notyp); + P(OPT_sysptrtyp); + __ENUMP(OPT_GlbMod, 64, P); + P(OPT_universe); + P(OPT_syslink); + __ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 6216, 1, P); +} + +__TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 40), {0, -16}}; +__TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 344), {0, 8, 16, 24, 304, 312, -56}}; +__TDESC(OPT_StrDesc, 1, 3) = {__TDFLDS("StrDesc", 104), {80, 88, 96, -32}}; +__TDESC(OPT_NodeDesc, 1, 6) = {__TDFLDS("NodeDesc", 56), {0, 8, 16, 32, 40, 48, -56}}; +__TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 6216), {32, 40, 48, 56, 64, 72, 80, 88, 96, 104, 112, 120, 128, 136, 144, 152, + 160, 168, 176, 184, 192, 200, 208, 216, 224, 232, 240, 248, 256, 264, 272, 280, + 288, 296, 304, 312, 320, 328, 336, 344, 352, 360, 368, 376, 384, 392, 400, 408, + 416, 424, 432, 440, 448, 456, 464, 472, 480, 488, 496, 504, 512, 520, 528, 536, + 544, 552, 560, 568, 576, 584, 592, 600, 608, 616, 624, 632, 640, 648, 656, 664, + 672, 680, 688, 696, 704, 712, 720, 728, 736, 744, 752, 760, 768, 776, 784, 792, + 800, 808, 816, 824, 832, 840, 848, 856, 864, 872, 880, 888, 896, 904, 912, 920, + 928, 936, 944, 952, 960, 968, 976, 984, 992, 1000, 1008, 1016, 1024, 1032, 1040, 1048, + 1056, 1064, 1072, 1080, 1088, 1096, 1104, 1112, 1120, 1128, 1136, 1144, 1152, 1160, 1168, 1176, + 1184, 1192, 1200, 1208, 1216, 1224, 1232, 1240, 1248, 1256, 1264, 1272, 1280, 1288, 1296, 1304, + 1312, 1320, 1328, 1336, 1344, 1352, 1360, 1368, 1376, 1384, 1392, 1400, 1408, 1416, 1424, 1432, + 1440, 1448, 1456, 1464, 1472, 1480, 1488, 1496, 1504, 1512, 1520, 1528, 1536, 1544, 1552, 1560, + 1568, 1576, 1584, 1592, 1600, 1608, 1616, 1624, 1632, 1640, 1648, 1656, 1664, 1672, 1680, 1688, + 1696, 1704, 1712, 1720, 1728, 1736, 1744, 1752, 1760, 1768, 1776, 1784, 1792, 1800, 1808, 1816, + 1824, 1832, 1840, 1848, 1856, 1864, 1872, 1880, 1888, 1896, 1904, 1912, 1920, 1928, 1936, 1944, + 1952, 1960, 1968, 1976, 1984, 1992, 2000, 2008, 2016, 2024, 2032, 2040, 2048, 2056, 2064, 2072, + 2080, 2088, 2096, 2104, 2112, 2120, 2128, 2136, 2144, 2152, 2160, 2168, 2176, 2184, 2192, 2200, + 2208, 2216, 2224, 2232, 2240, 2248, 2256, 2264, 2272, 2280, 2288, 2296, 2304, 2312, 2320, 2328, + 2336, 2344, 2352, 2360, 2368, 2376, 2384, 2392, 2400, 2408, 2416, 2424, 2432, 2440, 2448, 2456, + 2464, 2472, 2480, 2488, 2496, 2504, 2512, 2520, 2528, 2536, 2544, 2552, 2560, 2568, 2576, 2584, + 2592, 2600, 2608, 2616, 2624, 2632, 2640, 2648, 2656, 2664, 2672, 2680, 2688, 2696, 2704, 2712, + 2720, 2728, 2736, 2744, 2752, 2760, 2768, 2776, 2784, 2792, 2800, 2808, 2816, 2824, 2832, 2840, + 2848, 2856, 2864, 2872, 2880, 2888, 2896, 2904, 2912, 2920, 2928, 2936, 2944, 2952, 2960, 2968, + 2976, 2984, 2992, 3000, 3008, 3016, 3024, 3032, 3040, 3048, 3056, 3064, 3072, 3080, 3088, 3096, + 3104, 3112, 3120, 3128, 3136, 3144, 3152, 3160, 3168, 3176, 3184, 3192, 3200, 3208, 3216, 3224, + 3232, 3240, 3248, 3256, 3264, 3272, 3280, 3288, 3296, 3304, 3312, 3320, 3328, 3336, 3344, 3352, + 3360, 3368, 3376, 3384, 3392, 3400, 3408, 3416, 3424, 3432, 3440, 3448, 3456, 3464, 3472, 3480, + 3488, 3496, 3504, 3512, 3520, 3528, 3536, 3544, 3552, 3560, 3568, 3576, 3584, 3592, 3600, 3608, + 3616, 3624, 3632, 3640, 3648, 3656, 3664, 3672, 3680, 3688, 3696, 3704, 3712, 3720, 3728, 3736, + 3744, 3752, 3760, 3768, 3776, 3784, 3792, 3800, 3808, 3816, 3824, 3832, 3840, 3848, 3856, 3864, + 3872, 3880, 3888, 3896, 3904, 3912, 3920, 3928, 3936, 3944, 3952, 3960, 3968, 3976, 3984, 3992, + 4000, 4008, 4016, 4024, 4032, 4040, 4048, 4056, 4064, 4072, 4080, 4088, 4096, 4104, -4088}}; +__TDESC(OPT_ExpCtxt, 1, 0) = {__TDFLDS("ExpCtxt", 80), {-8}}; + +export void *OPT__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPS); + __REGMOD("OPT", EnumPtrs); + __REGCMD("Close", OPT_Close); + __REGCMD("CloseScope", OPT_CloseScope); + __INITYP(OPT_ConstDesc, OPT_ConstDesc, 0); + __INITYP(OPT_ObjDesc, OPT_ObjDesc, 0); + __INITYP(OPT_StrDesc, OPT_StrDesc, 0); + __INITYP(OPT_NodeDesc, OPT_NodeDesc, 0); + __INITYP(OPT_ImpCtxt, OPT_ImpCtxt, 0); + __INITYP(OPT_ExpCtxt, OPT_ExpCtxt, 0); +/* BEGIN */ + OPT_topScope = NIL; + OPT_OpenScope(0, NIL); + OPM_errpos = 0; + OPT_InitStruct(&OPT_undftyp, 0); + OPT_InitStruct(&OPT_notyp, 12); + OPT_InitStruct(&OPT_stringtyp, 10); + OPT_InitStruct(&OPT_niltyp, 11); + OPT_undftyp->BaseTyp = OPT_undftyp; + OPT_EnterTyp((CHAR*)"BYTE", 1, OPM_ByteSize, &OPT_bytetyp); + OPT_EnterTyp((CHAR*)"PTR", 13, OPM_PointerSize, &OPT_sysptrtyp); + OPT_EnterProc((CHAR*)"ADR", 20); + OPT_EnterProc((CHAR*)"CC", 21); + OPT_EnterProc((CHAR*)"LSH", 22); + OPT_EnterProc((CHAR*)"ROT", 23); + OPT_EnterProc((CHAR*)"GET", 24); + OPT_EnterProc((CHAR*)"PUT", 25); + OPT_EnterProc((CHAR*)"GETREG", 26); + OPT_EnterProc((CHAR*)"PUTREG", 27); + OPT_EnterProc((CHAR*)"BIT", 28); + OPT_EnterProc((CHAR*)"VAL", 29); + OPT_EnterProc((CHAR*)"NEW", 30); + OPT_EnterProc((CHAR*)"MOVE", 31); + OPT_syslink = OPT_topScope->right; + OPT_universe = OPT_topScope; + OPT_topScope->right = NIL; + OPT_EnterTyp((CHAR*)"CHAR", 3, OPM_CharSize, &OPT_chartyp); + OPT_EnterTyp((CHAR*)"SET", 9, OPM_SetSize, &OPT_settyp); + OPT_EnterTyp((CHAR*)"REAL", 7, OPM_RealSize, &OPT_realtyp); + OPT_EnterTyp((CHAR*)"INTEGER", 5, OPM_IntSize, &OPT_inttyp); + OPT_EnterTyp((CHAR*)"LONGINT", 6, OPM_LIntSize, &OPT_linttyp); + OPT_EnterTyp((CHAR*)"LONGREAL", 8, OPM_LRealSize, &OPT_lrltyp); + OPT_EnterTyp((CHAR*)"SHORTINT", 4, OPM_SIntSize, &OPT_sinttyp); + OPT_EnterTyp((CHAR*)"BOOLEAN", 2, OPM_BoolSize, &OPT_booltyp); + OPT_EnterBoolConst((CHAR*)"FALSE", ((LONGINT)(0))); + OPT_EnterBoolConst((CHAR*)"TRUE", ((LONGINT)(1))); + OPT_EnterProc((CHAR*)"HALT", 0); + OPT_EnterProc((CHAR*)"NEW", 1); + OPT_EnterProc((CHAR*)"ABS", 2); + OPT_EnterProc((CHAR*)"CAP", 3); + OPT_EnterProc((CHAR*)"ORD", 4); + OPT_EnterProc((CHAR*)"ENTIER", 5); + OPT_EnterProc((CHAR*)"ODD", 6); + OPT_EnterProc((CHAR*)"MIN", 7); + OPT_EnterProc((CHAR*)"MAX", 8); + OPT_EnterProc((CHAR*)"CHR", 9); + OPT_EnterProc((CHAR*)"SHORT", 10); + OPT_EnterProc((CHAR*)"LONG", 11); + OPT_EnterProc((CHAR*)"SIZE", 12); + OPT_EnterProc((CHAR*)"INC", 13); + OPT_EnterProc((CHAR*)"DEC", 14); + OPT_EnterProc((CHAR*)"INCL", 15); + OPT_EnterProc((CHAR*)"EXCL", 16); + OPT_EnterProc((CHAR*)"LEN", 17); + OPT_EnterProc((CHAR*)"COPY", 18); + OPT_EnterProc((CHAR*)"ASH", 19); + OPT_EnterProc((CHAR*)"ASSERT", 32); + OPT_impCtxt.ref[0] = OPT_undftyp; + OPT_impCtxt.ref[1] = OPT_bytetyp; + OPT_impCtxt.ref[2] = OPT_booltyp; + OPT_impCtxt.ref[3] = OPT_chartyp; + OPT_impCtxt.ref[4] = OPT_sinttyp; + OPT_impCtxt.ref[5] = OPT_inttyp; + OPT_impCtxt.ref[6] = OPT_linttyp; + OPT_impCtxt.ref[7] = OPT_realtyp; + OPT_impCtxt.ref[8] = OPT_lrltyp; + OPT_impCtxt.ref[9] = OPT_settyp; + OPT_impCtxt.ref[10] = OPT_stringtyp; + OPT_impCtxt.ref[11] = OPT_niltyp; + OPT_impCtxt.ref[12] = OPT_notyp; + OPT_impCtxt.ref[13] = OPT_sysptrtyp; + __ENDMOD; +} diff --git a/bootstrap/unix-88/OPT.h b/bootstrap/unix-88/OPT.h new file mode 100644 index 00000000..4c3442b5 --- /dev/null +++ b/bootstrap/unix-88/OPT.h @@ -0,0 +1,106 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPT__h +#define OPT__h + +#define LARGE +#include "SYSTEM.h" +#include "OPS.h" + +typedef + struct OPT_ConstDesc *OPT_Const; + +typedef + OPS_String *OPT_ConstExt; + +typedef + struct OPT_ConstDesc { + OPT_ConstExt ext; + LONGINT intval, intval2; + SET setval; + LONGREAL realval; + } OPT_ConstDesc; + +typedef + struct OPT_NodeDesc *OPT_Node; + +typedef + struct OPT_StrDesc *OPT_Struct; + +typedef + struct OPT_ObjDesc *OPT_Object; + +typedef + struct OPT_NodeDesc { + OPT_Node left, right, link; + SHORTINT class, subcl; + BOOLEAN readonly; + OPT_Struct typ; + OPT_Object obj; + OPT_Const conval; + } OPT_NodeDesc; + +typedef + struct OPT_ObjDesc { + OPT_Object left, right, link, scope; + OPS_Name name; + BOOLEAN leaf; + SHORTINT mode, mnolev, vis, history; + BOOLEAN used, fpdone; + LONGINT fprint; + OPT_Struct typ; + OPT_Const conval; + LONGINT adr, linkadr; + INTEGER x; + } OPT_ObjDesc; + +typedef + struct OPT_StrDesc { + SHORTINT form, comp, mno, extlev; + INTEGER ref, sysflag; + LONGINT n, size, align, txtpos; + BOOLEAN allocated, pbused, pvused; + char _prvt0[8]; + LONGINT pbfp, pvfp; + OPT_Struct BaseTyp; + OPT_Object link, strobj; + } OPT_StrDesc; + + +import void (*OPT_typSize)(OPT_Struct); +import OPT_Object OPT_topScope; +import OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp; +import SHORTINT OPT_nofGmod; +import OPT_Object OPT_GlbMod[64]; +import OPS_Name OPT_SelfName; +import BOOLEAN OPT_SYSimported; + +import LONGINT *OPT_ConstDesc__typ; +import LONGINT *OPT_ObjDesc__typ; +import LONGINT *OPT_StrDesc__typ; +import LONGINT *OPT_NodeDesc__typ; + +import void OPT_Close (void); +import void OPT_CloseScope (void); +import void OPT_Export (BOOLEAN *ext, BOOLEAN *new); +import void OPT_FPrintErr (OPT_Object obj, INTEGER errcode); +import void OPT_FPrintObj (OPT_Object obj); +import void OPT_FPrintStr (OPT_Struct typ); +import void OPT_Find (OPT_Object *res); +import void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res); +import void OPT_FindImport (OPT_Object mod, OPT_Object *res); +import void OPT_IdFPrint (OPT_Struct typ); +import void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done); +import void OPT_Init (OPS_Name name, SET opt); +import void OPT_Insert (OPS_Name name, OPT_Object *obj); +import void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old); +import OPT_Const OPT_NewConst (void); +import OPT_ConstExt OPT_NewExt (void); +import OPT_Node OPT_NewNode (SHORTINT class); +import OPT_Object OPT_NewObj (void); +import OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp); +import void OPT_OpenScope (SHORTINT level, OPT_Object owner); +import void *OPT__init(void); + + +#endif diff --git a/bootstrap/unix-88/OPV.c b/bootstrap/unix-88/OPV.c new file mode 100644 index 00000000..627e325b --- /dev/null +++ b/bootstrap/unix-88/OPV.c @@ -0,0 +1,1689 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "OPC.h" +#include "OPM.h" +#include "OPS.h" +#include "OPT.h" + +typedef + struct OPV_ExitInfo { + INTEGER level, label; + } OPV_ExitInfo; + + +static BOOLEAN OPV_assert, OPV_inxchk, OPV_mainprog, OPV_ansi; +static INTEGER OPV_stamp; +static LONGINT OPV_recno; +static OPV_ExitInfo OPV_exit; +static INTEGER OPV_nofExitLabels; +static BOOLEAN OPV_naturalAlignment; + +export LONGINT *OPV_ExitInfo__typ; + +static void OPV_ActualPar (OPT_Node n, OPT_Object fp); +export void OPV_AdrAndSize (OPT_Object topScope); +static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc); +static void OPV_Convert (OPT_Node n, INTEGER form, INTEGER prec); +static void OPV_DefineTDescs (OPT_Node n); +static void OPV_Entier (OPT_Node n, INTEGER prec); +static void OPV_GetTProcNum (OPT_Object obj); +static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc); +static BOOLEAN OPV_ImplicitReturn (OPT_Node n); +static void OPV_Index (OPT_Node n, OPT_Node d, INTEGER prec, INTEGER dim); +export void OPV_Init (void); +static void OPV_InitTDescs (OPT_Node n); +static void OPV_Len (OPT_Node n, LONGINT dim); +export void OPV_Module (OPT_Node prog); +static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max); +static void OPV_NewArr (OPT_Node d, OPT_Node x); +static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp); +static BOOLEAN OPV_SideEffects (OPT_Node n); +static void OPV_Stamp (OPS_Name s); +static OPT_Object OPV_SuperProc (OPT_Node n); +static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported); +static void OPV_TraverseRecord (OPT_Struct typ); +export void OPV_TypSize (OPT_Struct typ); +static void OPV_TypeOf (OPT_Node n); +static void OPV_design (OPT_Node n, INTEGER prec); +static void OPV_expr (OPT_Node n, INTEGER prec); +static void OPV_stat (OPT_Node n, OPT_Object outerProc); + + +static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max) +{ + LONGINT _o_result; + LONGINT i; + if (size >= max) { + _o_result = max; + return _o_result; + } else { + i = 1; + while (i < size) { + i += i; + } + _o_result = i; + return _o_result; + } + __RETCHK; +} + +void OPV_TypSize (OPT_Struct typ) +{ + INTEGER f, c; + LONGINT offset, size, base, fbase, off0; + OPT_Object fld = NIL; + OPT_Struct btyp = NIL; + if (typ == OPT_undftyp) { + OPM_err(58); + } else if (typ->size == -1) { + f = typ->form; + c = typ->comp; + if (c == 4) { + btyp = typ->BaseTyp; + if (btyp == NIL) { + offset = 0; + base = OPM_RecAlign; + } else { + OPV_TypSize(btyp); + offset = btyp->size - (LONGINT)__ASHR(btyp->sysflag, 8); + base = btyp->align; + } + fld = typ->link; + while ((fld != NIL && fld->mode == 4)) { + btyp = fld->typ; + OPV_TypSize(btyp); + size = btyp->size; + fbase = OPC_Base(btyp); + OPC_Align(&offset, fbase); + fld->adr = offset; + offset += size; + if (fbase > base) { + base = fbase; + } + fld = fld->link; + } + off0 = offset; + if (offset == 0) { + offset = 1; + } + if (OPM_RecSize == 0) { + base = OPV_NaturalAlignment(offset, OPM_RecAlign); + } + OPC_Align(&offset, base); + if ((typ->strobj == NIL && __MASK(typ->align, -65536) == 0)) { + OPV_recno += 1; + base += __ASHL(OPV_recno, 16); + } + typ->size = offset; + typ->align = base; + typ->sysflag = __MASK(typ->sysflag, -256) + (int)__ASHL(offset - off0, 8); + } else if (c == 2) { + OPV_TypSize(typ->BaseTyp); + typ->size = typ->n * typ->BaseTyp->size; + } else if (f == 13) { + typ->size = OPM_PointerSize; + if (typ->BaseTyp == OPT_undftyp) { + OPM_Mark(128, typ->n); + } else { + OPV_TypSize(typ->BaseTyp); + } + } else if (f == 14) { + typ->size = OPM_ProcSize; + } else if (c == 3) { + btyp = typ->BaseTyp; + OPV_TypSize(btyp); + if (btyp->comp == 3) { + typ->size = btyp->size + 4; + } else { + typ->size = 8; + } + } + } +} + +void OPV_Init (void) +{ + OPV_stamp = 0; + OPV_recno = 0; + OPV_nofExitLabels = 0; + OPV_assert = __IN(7, OPM_opt); + OPV_inxchk = __IN(0, OPM_opt); + OPV_mainprog = __IN(10, OPM_opt); + OPV_ansi = __IN(6, OPM_opt); +} + +static void OPV_GetTProcNum (OPT_Object obj) +{ + LONGINT oldPos; + OPT_Struct typ = NIL; + OPT_Object redef = NIL; + oldPos = OPM_errpos; + OPM_errpos = obj->scope->adr; + typ = obj->link->typ; + if (typ->form == 13) { + typ = typ->BaseTyp; + } + OPT_FindField(obj->name, typ->BaseTyp, &redef); + if (redef != NIL) { + obj->adr = __ASHL(__ASHR(redef->adr, 16), 16); + if (!__IN(2, obj->conval->setval)) { + OPM_err(119); + } + } else { + obj->adr += __ASHL(typ->n, 16); + typ->n += 1; + } + OPM_errpos = oldPos; +} + +static void OPV_TraverseRecord (OPT_Struct typ) +{ + if (!typ->allocated) { + if (typ->BaseTyp != NIL) { + OPV_TraverseRecord(typ->BaseTyp); + typ->n = typ->BaseTyp->n; + } + typ->allocated = 1; + OPV_Traverse(typ->link, typ->strobj, 0); + } +} + +static void OPV_Stamp (OPS_Name s) +{ + INTEGER i, j, k; + CHAR n[10]; + OPV_stamp += 1; + i = 0; + j = OPV_stamp; + while (s[__X(i, ((LONGINT)(256)))] != 0x00) { + i += 1; + } + if (i > 25) { + i = 25; + } + s[__X(i, ((LONGINT)(256)))] = '_'; + s[__X(i + 1, ((LONGINT)(256)))] = '_'; + i += 2; + k = 0; + do { + n[__X(k, ((LONGINT)(10)))] = (CHAR)((int)__MOD(j, 10) + 48); + j = __DIV(j, 10); + k += 1; + } while (!(j == 0)); + do { + k -= 1; + s[__X(i, ((LONGINT)(256)))] = n[__X(k, ((LONGINT)(10)))]; + i += 1; + } while (!(k == 0)); + s[__X(i, ((LONGINT)(256)))] = 0x00; +} + +static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported) +{ + INTEGER mode; + OPT_Object scope = NIL; + OPT_Struct typ = NIL; + if (obj != NIL) { + OPV_Traverse(obj->left, outerScope, exported); + if (obj->name[0] == '@') { + obj->name[0] = '_'; + OPV_Stamp(obj->name); + } + obj->linkadr = 0; + mode = obj->mode; + if ((mode == 5 && (obj->vis != 0) == exported)) { + typ = obj->typ; + OPV_TypSize(obj->typ); + if (typ->form == 13) { + typ = typ->BaseTyp; + } + if (typ->comp == 4) { + OPV_TraverseRecord(typ); + } + } else if (mode == 13) { + OPV_GetTProcNum(obj); + } else if (mode == 1) { + OPV_TypSize(obj->typ); + } + if (!exported) { + if ((__IN(mode, 0x60) && obj->mnolev > 0)) { + OPV_Stamp(obj->name); + } + if (__IN(mode, 0x26)) { + obj->scope = outerScope; + } else if (__IN(mode, 0x26c0)) { + if (obj->conval->setval == 0x0) { + OPM_err(129); + } + scope = obj->scope; + scope->leaf = 1; + __COPY(obj->name, scope->name, ((LONGINT)(256))); + OPV_Stamp(scope->name); + if (mode == 9) { + obj->adr = 1; + } + if (scope->mnolev > 1) { + outerScope->leaf = 0; + } + OPV_Traverse(obj->scope->right, obj->scope, 0); + } + } + OPV_Traverse(obj->right, outerScope, exported); + } +} + +void OPV_AdrAndSize (OPT_Object topScope) +{ + OPM_errpos = topScope->adr; + topScope->leaf = 1; + OPV_Traverse(topScope->right, topScope, 1); + OPV_Traverse(topScope->right, topScope, 0); + OPT_chartyp->strobj->linkadr = 2; + OPT_settyp->strobj->linkadr = 2; + OPT_realtyp->strobj->linkadr = 2; + OPT_inttyp->strobj->linkadr = 2; + OPT_linttyp->strobj->linkadr = 2; + OPT_lrltyp->strobj->linkadr = 2; + OPT_sinttyp->strobj->linkadr = 2; + OPT_booltyp->strobj->linkadr = 2; + OPT_bytetyp->strobj->linkadr = 2; + OPT_sysptrtyp->strobj->linkadr = 2; +} + +static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp) +{ + INTEGER _o_result; + switch (class) { + case 7: case 0: case 2: case 4: case 9: + case 13: + _o_result = 10; + return _o_result; + break; + case 5: + if (__IN(3, OPM_opt)) { + _o_result = 10; + return _o_result; + } else { + _o_result = 9; + return _o_result; + } + break; + case 1: + if (__IN(comp, 0x0c)) { + _o_result = 10; + return _o_result; + } else { + _o_result = 9; + return _o_result; + } + break; + case 3: + _o_result = 9; + return _o_result; + break; + case 11: + switch (subclass) { + case 33: case 7: case 24: case 29: case 20: + _o_result = 9; + return _o_result; + break; + case 16: case 21: case 22: case 23: case 25: + _o_result = 10; + return _o_result; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence Nmop, subclass = ", (LONGINT)51); + OPM_LogWNum(subclass, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + break; + case 12: + switch (subclass) { + case 1: + if (form == 9) { + _o_result = 4; + return _o_result; + } else { + _o_result = 8; + return _o_result; + } + break; + case 2: + if (form == 9) { + _o_result = 3; + return _o_result; + } else { + _o_result = 8; + return _o_result; + } + break; + case 3: case 4: + _o_result = 10; + return _o_result; + break; + case 6: + if (form == 9) { + _o_result = 2; + return _o_result; + } else { + _o_result = 7; + return _o_result; + } + break; + case 7: + if (form == 9) { + _o_result = 4; + return _o_result; + } else { + _o_result = 7; + return _o_result; + } + break; + case 11: case 12: case 13: case 14: + _o_result = 6; + return _o_result; + break; + case 9: case 10: + _o_result = 5; + return _o_result; + break; + case 5: + _o_result = 1; + return _o_result; + break; + case 8: + _o_result = 0; + return _o_result; + break; + case 19: case 15: case 17: case 18: case 26: + case 27: case 28: + _o_result = 10; + return _o_result; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence Ndop, subclass = ", (LONGINT)51); + OPM_LogWNum(subclass, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + break; + case 10: + _o_result = 10; + return _o_result; + break; + case 8: case 6: + _o_result = 12; + return _o_result; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence, class = ", (LONGINT)43); + OPM_LogWNum(class, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + __RETCHK; +} + +static void OPV_Len (OPT_Node n, LONGINT dim) +{ + while ((n->class == 4 && n->typ->comp == 3)) { + dim += 1; + n = n->left; + } + if ((n->class == 3 && n->typ->comp == 3)) { + OPV_design(n->left, 10); + OPM_WriteString((CHAR*)"->len[", (LONGINT)7); + OPM_WriteInt(dim); + OPM_Write(']'); + } else { + OPC_Len(n->obj, n->typ, dim); + } +} + +static BOOLEAN OPV_SideEffects (OPT_Node n) +{ + BOOLEAN _o_result; + if (n != NIL) { + _o_result = (n->class == 13 || OPV_SideEffects(n->left)) || OPV_SideEffects(n->right); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +static void OPV_Entier (OPT_Node n, INTEGER prec) +{ + if (__IN(n->typ->form, 0x0180)) { + OPM_WriteString((CHAR*)"__ENTIER(", (LONGINT)10); + OPV_expr(n, -1); + OPM_Write(')'); + } else { + OPV_expr(n, prec); + } +} + +static void OPV_Convert (OPT_Node n, INTEGER form, INTEGER prec) +{ + INTEGER from; + from = n->typ->form; + if (form == 9) { + OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9); + OPV_Entier(n, -1); + OPM_Write(')'); + } else if (form == 6) { + if (from < 6) { + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + } + OPV_Entier(n, 9); + } else if (form == 5) { + if (from < 5) { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + OPV_expr(n, 9); + } else { + if (__IN(2, OPM_opt)) { + OPM_WriteString((CHAR*)"__SHORT", (LONGINT)8); + if (OPV_SideEffects(n)) { + OPM_Write('F'); + } + OPM_Write('('); + OPV_Entier(n, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(OPM_MaxInt + 1); + OPM_Write(')'); + } else { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + OPV_Entier(n, 9); + } + } + } else if (form == 4) { + if (__IN(2, OPM_opt)) { + OPM_WriteString((CHAR*)"__SHORT", (LONGINT)8); + if (OPV_SideEffects(n)) { + OPM_Write('F'); + } + OPM_Write('('); + OPV_Entier(n, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(OPM_MaxSInt + 1); + OPM_Write(')'); + } else { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + OPV_Entier(n, 9); + } + } else if (form == 3) { + if (__IN(2, OPM_opt)) { + OPM_WriteString((CHAR*)"__CHR", (LONGINT)6); + if (OPV_SideEffects(n)) { + OPM_Write('F'); + } + OPM_Write('('); + OPV_Entier(n, -1); + OPM_Write(')'); + } else { + OPM_WriteString((CHAR*)"(CHAR)", (LONGINT)7); + OPV_Entier(n, 9); + } + } else { + OPV_expr(n, prec); + } +} + +static void OPV_TypeOf (OPT_Node n) +{ + if (n->typ->form == 13) { + OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10); + OPV_expr(n, -1); + OPM_Write(')'); + } else if (__IN(n->class, 0x15)) { + OPC_Andent(n->typ); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } else if (n->class == 3) { + OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10); + OPV_expr(n->left, -1); + OPM_Write(')'); + } else if (n->class == 5) { + OPV_TypeOf(n->left); + } else if ((n->class == 11 && n->subcl == 29)) { + OPC_TypeOf(n->left->obj); + } else { + OPC_TypeOf(n->obj); + } +} + +static void OPV_Index (OPT_Node n, OPT_Node d, INTEGER prec, INTEGER dim) +{ + if (!OPV_inxchk || (n->right->class == 7 && (n->right->conval->intval == 0 || n->left->typ->comp != 3))) { + OPV_expr(n->right, prec); + } else { + if (OPV_SideEffects(n->right)) { + OPM_WriteString((CHAR*)"__XF(", (LONGINT)6); + } else { + OPM_WriteString((CHAR*)"__X(", (LONGINT)5); + } + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_Len(d, dim); + OPM_Write(')'); + } +} + +static void OPV_design (OPT_Node n, INTEGER prec) +{ + OPT_Object obj = NIL; + OPT_Struct typ = NIL; + INTEGER class, designPrec, comp; + OPT_Node d = NIL, x = NIL; + INTEGER dims, i, _for__26; + comp = n->typ->comp; + obj = n->obj; + class = n->class; + designPrec = OPV_Precedence(class, n->subcl, n->typ->form, comp); + if ((((((class == 0 && obj->mnolev > 0)) && (int)obj->mnolev != OPM_level)) && prec == 10)) { + designPrec = 9; + } + if (prec > designPrec) { + OPM_Write('('); + } + if (prec == 11) { + OPM_Write('*'); + } + switch (class) { + case 9: + OPC_Ident(n->obj); + break; + case 0: + OPC_CompleteIdent(n->obj); + break; + case 1: + if (!__IN(comp, 0x0c)) { + OPM_Write('*'); + } + OPC_CompleteIdent(n->obj); + break; + case 2: + if (n->left->class == 3) { + OPV_design(n->left->left, designPrec); + OPM_WriteString((CHAR*)"->", (LONGINT)3); + } else { + OPV_design(n->left, designPrec); + OPM_Write('.'); + } + OPC_Ident(n->obj); + break; + case 3: + if (n->typ->comp == 3) { + OPV_design(n->left, 10); + OPM_WriteString((CHAR*)"->data", (LONGINT)7); + } else { + OPM_Write('*'); + OPV_design(n->left, designPrec); + } + break; + case 4: + d = n->left; + if (d->typ->comp == 3) { + dims = 0; + while (d->class == 4) { + d = d->left; + dims += 1; + } + if (n->typ->comp == 3) { + OPM_Write('&'); + } + OPV_design(d, designPrec); + OPM_Write('['); + if (n->typ->comp == 3) { + OPM_Write('('); + } + i = dims; + x = n; + while (x != d) { + if (x->left != d) { + OPV_Index(x, d, 7, i); + OPM_WriteString((CHAR*)" + ", (LONGINT)4); + OPV_Len(d, i); + OPM_WriteString((CHAR*)" * (", (LONGINT)5); + i -= 1; + } else { + OPV_Index(x, d, -1, i); + } + x = x->left; + } + _for__26 = dims; + i = 1; + while (i <= _for__26) { + OPM_Write(')'); + i += 1; + } + if (n->typ->comp == 3) { + OPM_Write(')'); + while ((LONGINT)i < __ASHR(d->typ->size - 4, 2)) { + OPM_WriteString((CHAR*)" * ", (LONGINT)4); + OPV_Len(d, i); + i += 1; + } + } + OPM_Write(']'); + } else { + OPV_design(n->left, designPrec); + OPM_Write('['); + OPV_Index(n, n->left, -1, 0); + OPM_Write(']'); + } + break; + case 5: + typ = n->typ; + obj = n->left->obj; + if (__IN(3, OPM_opt)) { + if (typ->comp == 4) { + OPM_WriteString((CHAR*)"__GUARDR(", (LONGINT)10); + if ((int)obj->mnolev != OPM_level) { + OPM_WriteStringVar((void*)obj->scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"__curr->", (LONGINT)9); + OPC_Ident(obj); + } else { + OPC_Ident(obj); + } + } else { + if (typ->BaseTyp->strobj == NIL) { + OPM_WriteString((CHAR*)"__GUARDA(", (LONGINT)10); + } else { + OPM_WriteString((CHAR*)"__GUARDP(", (LONGINT)10); + } + OPV_expr(n->left, -1); + typ = typ->BaseTyp; + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(typ); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(typ->extlev); + OPM_Write(')'); + } else { + if (typ->comp == 4) { + OPM_WriteString((CHAR*)"*(", (LONGINT)3); + OPC_Ident(typ->strobj); + OPM_WriteString((CHAR*)"*)", (LONGINT)3); + OPC_CompleteIdent(obj); + } else { + OPM_Write('('); + OPC_Ident(typ->strobj); + OPM_Write(')'); + OPV_expr(n->left, designPrec); + } + } + break; + case 6: + if (__IN(3, OPM_opt)) { + if (n->left->class == 1) { + OPM_WriteString((CHAR*)"__GUARDEQR(", (LONGINT)12); + OPC_CompleteIdent(n->left->obj); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_TypeOf(n->left); + } else { + OPM_WriteString((CHAR*)"__GUARDEQP(", (LONGINT)12); + OPV_expr(n->left->left, -1); + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(n->left->typ->strobj); + OPM_Write(')'); + } else { + OPV_expr(n->left, -1); + } + break; + case 11: + if (n->subcl == 29) { + OPV_design(n->left, prec); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.design, class = ", (LONGINT)39); + OPM_LogWNum(class, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + if (prec > designPrec) { + OPM_Write(')'); + } +} + +static void OPV_ActualPar (OPT_Node n, OPT_Object fp) +{ + OPT_Struct typ = NIL, aptyp = NIL; + INTEGER comp, form, mode, prec, dim; + OPM_Write('('); + while (n != NIL) { + typ = fp->typ; + comp = typ->comp; + form = typ->form; + mode = fp->mode; + prec = -1; + if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) { + OPM_Write('('); + OPC_Ident(n->typ->strobj); + OPM_WriteString((CHAR*)"*)", (LONGINT)3); + prec = 10; + } + if (!__IN(n->typ->comp, 0x0c)) { + if (mode == 2) { + if ((OPV_ansi && typ != n->typ)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } + OPM_Write('&'); + prec = 9; + } else if (OPV_ansi) { + if ((__IN(comp, 0x0c) && n->class == 7)) { + OPM_WriteString((CHAR*)"(CHAR*)", (LONGINT)8); + } else if ((((form == 13 && typ != n->typ)) && n->typ != OPT_niltyp)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } + } else { + if ((__IN(form, 0x0180) && __IN(n->typ->form, 0x70))) { + OPM_WriteString((CHAR*)"(double)", (LONGINT)9); + prec = 9; + } else if ((form == 6 && n->typ->form < 6)) { + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + prec = 9; + } + } + } else if (OPV_ansi) { + if ((((mode == 2 && typ != n->typ)) && prec == -1)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } + } + if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) { + OPV_expr(n->left, prec); + } else if ((((((form == 6 && n->class == 7)) && n->conval->intval <= OPM_MaxInt)) && n->conval->intval >= OPM_MinInt)) { + OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12); + OPV_expr(n, prec); + OPM_WriteString((CHAR*)"))", (LONGINT)3); + } else { + OPV_expr(n, prec); + } + if ((comp == 4 && mode == 2)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_TypeOf(n); + } else if (comp == 3) { + if (n->class == 7) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + OPM_WriteInt(n->conval->intval2); + } else { + aptyp = n->typ; + dim = 0; + while ((typ->comp == 3 && typ->BaseTyp->form != 1)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_Len(n, dim); + typ = typ->BaseTyp; + aptyp = aptyp->BaseTyp; + dim += 1; + } + if ((typ->comp == 3 && typ->BaseTyp->form == 1)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + while (aptyp->comp == 3) { + OPV_Len(n, dim); + OPM_WriteString((CHAR*)" * ", (LONGINT)4); + dim += 1; + aptyp = aptyp->BaseTyp; + } + OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12); + OPM_WriteInt(aptyp->size); + OPM_WriteString((CHAR*)"))", (LONGINT)3); + } + } + } + n = n->link; + fp = fp->link; + if (n != NIL) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + } + } + OPM_Write(')'); +} + +static OPT_Object OPV_SuperProc (OPT_Node n) +{ + OPT_Object _o_result; + OPT_Object obj = NIL; + OPT_Struct typ = NIL; + typ = n->right->typ; + if (typ->form == 13) { + typ = typ->BaseTyp; + } + OPT_FindField(n->left->obj->name, typ->BaseTyp, &obj); + _o_result = obj; + return _o_result; +} + +static void OPV_expr (OPT_Node n, INTEGER prec) +{ + INTEGER class, subclass, form, exprPrec; + OPT_Struct typ = NIL; + OPT_Node l = NIL, r = NIL; + OPT_Object proc = NIL; + class = n->class; + subclass = n->subcl; + form = n->typ->form; + l = n->left; + r = n->right; + exprPrec = OPV_Precedence(class, subclass, form, n->typ->comp); + if ((exprPrec <= prec && __IN(class, 0x3ce0))) { + OPM_Write('('); + } + switch (class) { + case 7: + OPC_Constant(n->conval, form); + break; + case 10: + OPM_WriteString((CHAR*)"__SETRNG(", (LONGINT)10); + OPV_expr(l, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(r, -1); + OPM_Write(')'); + break; + case 11: + switch (subclass) { + case 33: + OPM_Write('!'); + OPV_expr(l, exprPrec); + break; + case 7: + if (form == 9) { + OPM_Write('~'); + } else { + OPM_Write('-'); + } + OPV_expr(l, exprPrec); + break; + case 16: + typ = n->obj->typ; + if (l->typ->comp == 4) { + OPM_WriteString((CHAR*)"__IS(", (LONGINT)6); + OPC_TypeOf(l->obj); + } else { + OPM_WriteString((CHAR*)"__ISP(", (LONGINT)7); + OPV_expr(l, -1); + typ = typ->BaseTyp; + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(typ); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(typ->extlev); + OPM_Write(')'); + break; + case 20: + OPV_Convert(l, form, exprPrec); + break; + case 21: + if (OPV_SideEffects(l)) { + if (l->typ->form < 7) { + if (l->typ->form < 6) { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + } + OPM_WriteString((CHAR*)"__ABSF(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ABSFD(", (LONGINT)9); + } + } else { + OPM_WriteString((CHAR*)"__ABS(", (LONGINT)7); + } + OPV_expr(l, -1); + OPM_Write(')'); + break; + case 22: + OPM_WriteString((CHAR*)"__CAP(", (LONGINT)7); + OPV_expr(l, -1); + OPM_Write(')'); + break; + case 23: + OPM_WriteString((CHAR*)"__ODD(", (LONGINT)7); + OPV_expr(l, -1); + OPM_Write(')'); + break; + case 24: + OPM_WriteString((CHAR*)"(LONGINT)(uintptr_t)", (LONGINT)21); + if (l->class == 1) { + OPC_CompleteIdent(l->obj); + } else { + if ((l->typ->form != 10 && !__IN(l->typ->comp, 0x0c))) { + OPM_Write('&'); + } + OPV_expr(l, exprPrec); + } + break; + case 29: + if ((((__IN(n->typ->form, 0x6240) && __IN(l->typ->form, 0x6240))) && n->typ->size == l->typ->size) || !__IN(l->class, 0x17)) { + OPM_Write('('); + OPC_Ident(n->typ->strobj); + OPM_Write(')'); + if (__IN(n->typ->form, 0x6000) || __IN(l->typ->form, 0x6000)) { + OPM_WriteString((CHAR*)"(uintptr_t)", (LONGINT)12); + } + OPV_expr(l, exprPrec); + } else { + if (__IN(n->typ->form, 0x6000) || __IN(l->typ->form, 0x6000)) { + OPM_WriteString((CHAR*)"__VALP(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__VAL(", (LONGINT)7); + } + OPC_Ident(n->typ->strobj); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(l, -1); + OPM_Write(')'); + } + break; + default: + OPM_err(200); + break; + } + break; + case 12: + switch (subclass) { + case 19: + OPV_Len(l, r->conval->intval); + break; + case 15: case 17: case 18: case 26: case 27: + case 28: case 3: case 4: + switch (subclass) { + case 15: + OPM_WriteString((CHAR*)"__IN(", (LONGINT)6); + break; + case 17: + if (r->class == 7) { + if (r->conval->intval >= 0) { + OPM_WriteString((CHAR*)"__ASHL(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ASHR(", (LONGINT)8); + } + } else if (OPV_SideEffects(r)) { + OPM_WriteString((CHAR*)"__ASHF(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ASH(", (LONGINT)7); + } + break; + case 18: + OPM_WriteString((CHAR*)"__MASK(", (LONGINT)8); + break; + case 26: + OPM_WriteString((CHAR*)"__BIT(", (LONGINT)7); + break; + case 27: + if (r->class == 7) { + if (r->conval->intval >= 0) { + OPM_WriteString((CHAR*)"__LSHL(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__LSHR(", (LONGINT)8); + } + } else { + OPM_WriteString((CHAR*)"__LSH(", (LONGINT)7); + } + break; + case 28: + if (r->class == 7) { + if (r->conval->intval >= 0) { + OPM_WriteString((CHAR*)"__ROTL(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ROTR(", (LONGINT)8); + } + } else { + OPM_WriteString((CHAR*)"__ROT(", (LONGINT)7); + } + break; + case 3: + if (OPV_SideEffects(n)) { + if (form < 6) { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + } + OPM_WriteString((CHAR*)"__DIVF(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__DIV(", (LONGINT)7); + } + break; + case 4: + if (form < 6) { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + } + if (OPV_SideEffects(n)) { + OPM_WriteString((CHAR*)"__MODF(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__MOD(", (LONGINT)7); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", (LONGINT)40); + OPM_LogWNum(subclass, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + OPV_expr(l, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if ((((__IN(subclass, 0x18020000) && r->class == 7)) && r->conval->intval < 0)) { + OPM_WriteInt(-r->conval->intval); + } else { + OPV_expr(r, -1); + } + if (__IN(subclass, 0x18000000)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(l->typ->strobj); + } + OPM_Write(')'); + break; + case 9: case 10: case 11: case 12: case 13: + case 14: + if (__IN(l->typ->form, 0x8400)) { + OPM_WriteString((CHAR*)"__STRCMP(", (LONGINT)10); + OPV_expr(l, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(r, -1); + OPM_Write(')'); + OPC_Cmp(subclass); + OPM_Write('0'); + } else { + OPV_expr(l, exprPrec); + OPC_Cmp(subclass); + typ = l->typ; + if ((((((typ->form == 13 && r->typ->form != 11)) && r->typ != typ)) && r->typ != OPT_sysptrtyp)) { + OPM_WriteString((CHAR*)"(void *) ", (LONGINT)10); + } + OPV_expr(r, exprPrec); + } + break; + default: + if (subclass == 5 || (form == 9 && (subclass == 1 || subclass == 7))) { + OPM_Write('('); + } + OPV_expr(l, exprPrec); + switch (subclass) { + case 1: + if (form == 9) { + OPM_WriteString((CHAR*)" & ", (LONGINT)4); + } else { + OPM_WriteString((CHAR*)" * ", (LONGINT)4); + } + break; + case 2: + if (form == 9) { + OPM_WriteString((CHAR*)" ^ ", (LONGINT)4); + } else { + OPM_WriteString((CHAR*)" / ", (LONGINT)4); + if (r->obj == NIL || __IN(r->obj->typ->form, 0x70)) { + OPM_Write('('); + OPC_Ident(n->typ->strobj); + OPM_Write(')'); + } + } + break; + case 5: + OPM_WriteString((CHAR*)" && ", (LONGINT)5); + break; + case 6: + if (form == 9) { + OPM_WriteString((CHAR*)" | ", (LONGINT)4); + } else { + OPM_WriteString((CHAR*)" + ", (LONGINT)4); + } + break; + case 7: + if (form == 9) { + OPM_WriteString((CHAR*)" & ~", (LONGINT)5); + } else { + OPM_WriteString((CHAR*)" - ", (LONGINT)4); + } + break; + case 8: + OPM_WriteString((CHAR*)" || ", (LONGINT)5); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", (LONGINT)40); + OPM_LogWNum(subclass, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + OPV_expr(r, exprPrec); + if (subclass == 5 || (form == 9 && (subclass == 1 || subclass == 7))) { + OPM_Write(')'); + } + break; + } + break; + case 13: + if ((l->obj != NIL && l->obj->mode == 13)) { + if (l->subcl == 1) { + proc = OPV_SuperProc(n); + } else { + OPM_WriteString((CHAR*)"__", (LONGINT)3); + proc = OPC_BaseTProc(l->obj); + } + OPC_Ident(proc); + n->obj = proc->link; + } else if (l->class == 9) { + OPV_design(l, 10); + } else { + OPV_design(l, 11); + } + OPV_ActualPar(r, n->obj); + break; + default: + OPV_design(n, prec); + break; + } + if ((exprPrec <= prec && __IN(class, 0x3ca0))) { + OPM_Write(')'); + } +} + +static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc) +{ + OPT_Node if_ = NIL; + OPT_Object obj = NIL; + OPT_Struct typ = NIL; + LONGINT adr; + if_ = n->left; + while (if_ != NIL) { + OPM_WriteString((CHAR*)"if ", (LONGINT)4); + OPV_expr(if_->left, 12); + OPM_Write(' '); + OPC_BegBlk(); + if ((n->class == 27 && if_->left->left != NIL)) { + obj = if_->left->left->obj; + typ = obj->typ; + adr = obj->adr; + if (typ->comp == 4) { + OPC_BegStat(); + OPC_Ident(if_->left->obj); + OPM_WriteString((CHAR*)" *", (LONGINT)3); + OPM_WriteString(obj->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"__ = (void*)", (LONGINT)13); + obj->adr = 0; + OPC_CompleteIdent(obj); + OPC_EndStat(); + } + obj->adr = 1; + obj->typ = if_->left->obj->typ; + OPV_stat(if_->right, outerProc); + obj->typ = typ; + obj->adr = adr; + } else { + OPV_stat(if_->right, outerProc); + } + if_ = if_->link; + if ((if_ != NIL || n->right != NIL) || withtrap) { + OPC_EndBlk0(); + OPM_WriteString((CHAR*)" else ", (LONGINT)7); + } else { + OPC_EndBlk(); + } + } + if (withtrap) { + OPM_WriteString((CHAR*)"__WITHCHK", (LONGINT)10); + OPC_EndStat(); + } else if (n->right != NIL) { + OPC_BegBlk(); + OPV_stat(n->right, outerProc); + OPC_EndBlk(); + } +} + +static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc) +{ + OPT_Node switchCase = NIL, label = NIL; + LONGINT low, high; + INTEGER form, i; + OPM_WriteString((CHAR*)"switch ", (LONGINT)8); + OPV_expr(n->left, 12); + OPM_Write(' '); + OPC_BegBlk(); + form = n->left->typ->form; + switchCase = n->right->left; + while (switchCase != NIL) { + label = switchCase->left; + i = 0; + while (label != NIL) { + low = label->conval->intval; + high = label->conval->intval2; + while (low <= high) { + if (i == 0) { + OPC_BegStat(); + } + OPC_Case(low, form); + low += 1; + i += 1; + if (i == 5) { + OPM_WriteLn(); + i = 0; + } + } + label = label->link; + } + if (i > 0) { + OPM_WriteLn(); + } + OPC_Indent(1); + OPV_stat(switchCase->right, outerProc); + OPC_BegStat(); + OPM_WriteString((CHAR*)"break", (LONGINT)6); + OPC_EndStat(); + OPC_Indent(-1); + switchCase = switchCase->link; + } + OPC_BegStat(); + OPM_WriteString((CHAR*)"default: ", (LONGINT)10); + if (n->right->conval->setval != 0x0) { + OPC_Indent(1); + OPM_WriteLn(); + OPV_stat(n->right->right, outerProc); + OPC_BegStat(); + OPM_WriteString((CHAR*)"break", (LONGINT)6); + OPC_Indent(-1); + } else { + OPM_WriteString((CHAR*)"__CASECHK", (LONGINT)10); + } + OPC_EndStat(); + OPC_EndBlk(); +} + +static BOOLEAN OPV_ImplicitReturn (OPT_Node n) +{ + BOOLEAN _o_result; + while ((n != NIL && n->class != 26)) { + n = n->link; + } + _o_result = n == NIL; + return _o_result; +} + +static void OPV_NewArr (OPT_Node d, OPT_Node x) +{ + OPT_Struct typ = NIL, base = NIL; + INTEGER nofdim, nofdyn; + typ = d->typ->BaseTyp; + base = typ; + nofdim = 0; + nofdyn = 0; + while (base->comp == 3) { + nofdim += 1; + nofdyn += 1; + base = base->BaseTyp; + } + OPV_design(d, -1); + OPM_WriteString((CHAR*)" = __NEWARR(", (LONGINT)13); + while (base->comp == 2) { + nofdim += 1; + base = base->BaseTyp; + } + if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) { + OPC_Ident(base->strobj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } else if (base->form == 13) { + OPM_WriteString((CHAR*)"POINTER__typ", (LONGINT)13); + } else { + OPM_WriteString((CHAR*)"NIL", (LONGINT)4); + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12); + OPM_WriteInt(base->size); + OPM_WriteString((CHAR*)"))", (LONGINT)3); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(OPC_Base(base)); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(nofdim); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(nofdyn); + while (typ != base) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (typ->comp == 3) { + if (x->class == 7) { + OPM_WriteString((CHAR*)"(LONGINT)(", (LONGINT)11); + OPV_expr(x, -1); + OPM_WriteString((CHAR*)")", (LONGINT)2); + } else { + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + OPV_expr(x, 10); + } + x = x->link; + } else { + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + OPM_WriteInt(typ->n); + } + typ = typ->BaseTyp; + } + OPM_Write(')'); +} + +static void OPV_DefineTDescs (OPT_Node n) +{ + while ((n != NIL && n->class == 14)) { + OPC_TDescDecl(n->typ); + n = n->link; + } +} + +static void OPV_InitTDescs (OPT_Node n) +{ + while ((n != NIL && n->class == 14)) { + OPC_InitTDesc(n->typ); + n = n->link; + } +} + +static void OPV_stat (OPT_Node n, OPT_Object outerProc) +{ + OPT_Object proc = NIL; + OPV_ExitInfo saved; + OPT_Node l = NIL, r = NIL; + while ((n != NIL && OPM_noerr)) { + OPM_errpos = n->conval->intval; + if (n->class != 14) { + OPC_BegStat(); + } + switch (n->class) { + case 18: + if (n->obj == NIL) { + OPM_level += 1; + OPV_stat(n->left, outerProc); + OPM_level -= 1; + OPC_GenEnumPtrs(OPT_topScope->scope); + OPV_DefineTDescs(n->right); + OPC_EnterBody(); + OPV_InitTDescs(n->right); + OPM_WriteString((CHAR*)"/* BEGIN */", (LONGINT)12); + OPM_WriteLn(); + OPV_stat(n->right, outerProc); + OPC_ExitBody(); + } else { + proc = n->obj; + OPC_TypeDefs(proc->scope->right, 0); + if (!proc->scope->leaf) { + OPC_DefineInter(proc); + } + OPM_level += 1; + OPV_stat(n->left, proc); + OPM_level -= 1; + OPC_EnterProc(proc); + OPV_stat(n->right, proc); + OPC_ExitProc(proc, 1, OPV_ImplicitReturn(n->right)); + } + break; + case 14: + break; + case 19: + switch (n->subcl) { + case 0: + l = n->left; + r = n->right; + if (l->typ->comp == 2) { + OPM_WriteString((CHAR*)"__MOVE(", (LONGINT)8); + OPV_expr(r, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(l, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (r->typ == OPT_stringtyp) { + OPM_WriteInt(r->conval->intval2); + } else { + OPM_WriteInt(r->typ->size); + } + OPM_Write(')'); + } else { + if ((((((l->typ->form == 13 && l->obj != NIL)) && l->obj->adr == 1)) && l->obj->mode == 1)) { + l->obj->adr = 0; + OPV_design(l, -1); + l->obj->adr = 1; + if (r->typ->form != 11) { + OPM_WriteString((CHAR*)" = (void*)", (LONGINT)11); + } else { + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + } + } else { + OPV_design(l, -1); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + } + if (l->typ == r->typ) { + OPV_expr(r, -1); + } else if ((((l->typ->form == 13 && r->typ->form != 11)) && l->typ->strobj != NIL)) { + OPM_Write('('); + OPC_Ident(l->typ->strobj); + OPM_Write(')'); + OPV_expr(r, -1); + } else if (l->typ->comp == 4) { + OPM_WriteString((CHAR*)"*(", (LONGINT)3); + OPC_Andent(l->typ); + OPM_WriteString((CHAR*)"*)&", (LONGINT)4); + OPV_expr(r, 9); + } else { + OPV_expr(r, -1); + } + } + break; + case 1: + if (n->left->typ->BaseTyp->comp == 4) { + OPM_WriteString((CHAR*)"__NEW(", (LONGINT)7); + OPV_design(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(n->left->typ->BaseTyp); + OPM_WriteString((CHAR*)")", (LONGINT)2); + } else if (__IN(n->left->typ->BaseTyp->comp, 0x0c)) { + OPV_NewArr(n->left, n->right); + } + break; + case 13: case 14: + OPV_expr(n->left, -1); + OPC_Increment(n->subcl == 14); + OPV_expr(n->right, -1); + break; + case 15: case 16: + OPV_expr(n->left, -1); + OPC_SetInclude(n->subcl == 16); + OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9); + OPV_expr(n->right, -1); + OPM_Write(')'); + break; + case 18: + OPM_WriteString((CHAR*)"__COPY(", (LONGINT)8); + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_Len(n->left, ((LONGINT)(0))); + OPM_Write(')'); + break; + case 31: + OPM_WriteString((CHAR*)"__MOVE(", (LONGINT)8); + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->right->link, -1); + OPM_Write(')'); + break; + case 24: + OPM_WriteString((CHAR*)"__GET(", (LONGINT)7); + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(n->left->typ->strobj); + OPM_Write(')'); + break; + case 25: + OPM_WriteString((CHAR*)"__PUT(", (LONGINT)7); + OPV_expr(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(n->right->typ->strobj); + OPM_Write(')'); + break; + case 26: case 27: + OPM_err(200); + break; + case 30: + OPM_WriteString((CHAR*)"__SYSNEW(", (LONGINT)10); + OPV_design(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->right, -1); + OPM_Write(')'); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.subcl = ", (LONGINT)40); + OPM_LogWNum(n->subcl, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + break; + case 13: + if ((n->left->obj != NIL && n->left->obj->mode == 13)) { + if (n->left->subcl == 1) { + proc = OPV_SuperProc(n); + } else { + OPM_WriteString((CHAR*)"__", (LONGINT)3); + proc = OPC_BaseTProc(n->left->obj); + } + OPC_Ident(proc); + n->obj = proc->link; + } else if (n->left->class == 9) { + OPV_design(n->left, 10); + } else { + OPV_design(n->left, 11); + } + OPV_ActualPar(n->right, n->obj); + break; + case 20: + if (n->subcl != 32) { + OPV_IfStat(n, 0, outerProc); + } else if (OPV_assert) { + OPM_WriteString((CHAR*)"__ASSERT(", (LONGINT)10); + OPV_expr(n->left->left->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(n->left->right->right->conval->intval); + OPM_Write(')'); + OPC_EndStat(); + } + break; + case 21: + OPV_exit.level += 1; + OPV_CaseStat(n, outerProc); + OPV_exit.level -= 1; + break; + case 22: + OPV_exit.level += 1; + OPM_WriteString((CHAR*)"while ", (LONGINT)7); + OPV_expr(n->left, 12); + OPM_Write(' '); + OPC_BegBlk(); + OPV_stat(n->right, outerProc); + OPC_EndBlk(); + OPV_exit.level -= 1; + break; + case 23: + OPV_exit.level += 1; + OPM_WriteString((CHAR*)"do ", (LONGINT)4); + OPC_BegBlk(); + OPV_stat(n->left, outerProc); + OPC_EndBlk0(); + OPM_WriteString((CHAR*)" while (!", (LONGINT)10); + OPV_expr(n->right, 9); + OPM_Write(')'); + OPV_exit.level -= 1; + break; + case 24: + saved = OPV_exit; + OPV_exit.level = 0; + OPV_exit.label = -1; + OPM_WriteString((CHAR*)"for (;;) ", (LONGINT)10); + OPC_BegBlk(); + OPV_stat(n->left, outerProc); + OPC_EndBlk(); + if (OPV_exit.label != -1) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"exit__", (LONGINT)7); + OPM_WriteInt(OPV_exit.label); + OPM_Write(':'); + OPC_EndStat(); + } + OPV_exit = saved; + break; + case 25: + if (OPV_exit.level == 0) { + OPM_WriteString((CHAR*)"break", (LONGINT)6); + } else { + if (OPV_exit.label == -1) { + OPV_exit.label = OPV_nofExitLabels; + OPV_nofExitLabels += 1; + } + OPM_WriteString((CHAR*)"goto exit__", (LONGINT)12); + OPM_WriteInt(OPV_exit.label); + } + break; + case 26: + if (OPM_level == 0) { + if (OPV_mainprog) { + OPM_WriteString((CHAR*)"__FINI", (LONGINT)7); + } else { + OPM_WriteString((CHAR*)"__ENDMOD", (LONGINT)9); + } + } else { + if (n->left != NIL) { + OPM_WriteString((CHAR*)"_o_result = ", (LONGINT)13); + if ((n->left->typ->form == 13 && n->obj->typ != n->left->typ)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + OPV_expr(n->left, 10); + } else { + OPV_expr(n->left, -1); + } + OPM_WriteString((CHAR*)";", (LONGINT)2); + OPM_WriteLn(); + OPC_BegStat(); + OPC_ExitProc(outerProc, 0, 0); + OPM_WriteString((CHAR*)"return _o_result", (LONGINT)17); + } else { + OPM_WriteString((CHAR*)"return", (LONGINT)7); + } + } + break; + case 27: + OPV_IfStat(n, n->subcl == 0, outerProc); + break; + case 28: + OPC_Halt(n->right->conval->intval); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.class = ", (LONGINT)40); + OPM_LogWNum(n->class, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + if (!__IN(n->class, 0x09744000)) { + OPC_EndStat(); + } + n = n->link; + } +} + +void OPV_Module (OPT_Node prog) +{ + if (!OPV_mainprog) { + OPC_GenHdr(prog->right); + OPC_GenHdrIncludes(); + } + OPC_GenBdy(prog->right); + OPV_stat(prog, NIL); +} + +__TDESC(OPV_ExitInfo, 1, 0) = {__TDFLDS("ExitInfo", 8), {-8}}; + +export void *OPV__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPC); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPS); + __MODULE_IMPORT(OPT); + __REGMOD("OPV", 0); + __REGCMD("Init", OPV_Init); + __INITYP(OPV_ExitInfo, OPV_ExitInfo, 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-88/OPV.h b/bootstrap/unix-88/OPV.h new file mode 100644 index 00000000..7f0a5b8a --- /dev/null +++ b/bootstrap/unix-88/OPV.h @@ -0,0 +1,20 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPV__h +#define OPV__h + +#define LARGE +#include "SYSTEM.h" +#include "OPT.h" + + + + +import void OPV_AdrAndSize (OPT_Object topScope); +import void OPV_Init (void); +import void OPV_Module (OPT_Node prog); +import void OPV_TypSize (OPT_Struct typ); +import void *OPV__init(void); + + +#endif diff --git a/bootstrap/unix-88/Platform.c b/bootstrap/unix-88/Platform.c new file mode 100644 index 00000000..9a892174 --- /dev/null +++ b/bootstrap/unix-88/Platform.c @@ -0,0 +1,793 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" + +typedef + CHAR (*Platform_ArgPtr)[1024]; + +typedef + Platform_ArgPtr (*Platform_ArgVec)[1024]; + +typedef + LONGINT (*Platform_ArgVecPtr)[1]; + +typedef + CHAR (*Platform_EnvPtr)[1024]; + +typedef + struct Platform_FileIdentity { + LONGINT volume, index, mtime; + } Platform_FileIdentity; + +typedef + void (*Platform_HaltProcedure)(LONGINT); + +typedef + void (*Platform_SignalHandler)(INTEGER); + + +export BOOLEAN Platform_LittleEndian; +export LONGINT Platform_MainStackFrame, Platform_HaltCode; +export INTEGER Platform_PID; +export CHAR Platform_CWD[256]; +export INTEGER Platform_ArgCount; +export LONGINT Platform_ArgVector; +static Platform_HaltProcedure Platform_HaltHandler; +static LONGINT Platform_TimeStart; +export INTEGER Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd; +export CHAR Platform_nl[3]; + +export LONGINT *Platform_FileIdentity__typ; + +export BOOLEAN Platform_Absent (INTEGER e); +export INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len); +export void Platform_AssertFail (LONGINT code); +export INTEGER Platform_Chdir (CHAR *n, LONGINT n__len); +export INTEGER Platform_Close (LONGINT h); +export BOOLEAN Platform_ConnectionFailed (INTEGER e); +export void Platform_Delay (LONGINT ms); +export BOOLEAN Platform_DifferentFilesystems (INTEGER e); +static void Platform_DisplayHaltCode (LONGINT code); +export INTEGER Platform_Error (void); +export void Platform_Exit (INTEGER code); +export void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len); +export void Platform_GetClock (LONGINT *t, LONGINT *d); +export void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len); +export void Platform_GetIntArg (INTEGER n, LONGINT *val); +export void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec); +export void Platform_Halt (LONGINT code); +export INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ); +export INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ); +export BOOLEAN Platform_Inaccessible (INTEGER e); +export void Platform_Init (INTEGER argc, LONGINT argvadr); +export void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d); +export INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h); +export BOOLEAN Platform_NoSuchDirectory (INTEGER e); +export LONGINT Platform_OSAllocate (LONGINT size); +export void Platform_OSFree (LONGINT address); +export INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h); +export INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h); +export INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n); +export INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n); +export INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len); +export BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2); +export BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2); +export INTEGER Platform_Seek (LONGINT h, LONGINT offset, INTEGER whence); +export void Platform_SetBadInstructionHandler (Platform_SignalHandler handler); +export void Platform_SetHalt (Platform_HaltProcedure p); +export void Platform_SetInterruptHandler (Platform_SignalHandler handler); +export void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source); +export void Platform_SetQuitHandler (Platform_SignalHandler handler); +export INTEGER Platform_Size (LONGINT h, LONGINT *l); +export INTEGER Platform_Sync (LONGINT h); +export INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len); +static void Platform_TestLittleEndian (void); +export LONGINT Platform_Time (void); +export BOOLEAN Platform_TimedOut (INTEGER e); +export BOOLEAN Platform_TooManyFiles (INTEGER e); +export INTEGER Platform_Truncate (LONGINT h, LONGINT l); +export INTEGER Platform_Unlink (CHAR *n, LONGINT n__len); +export INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l); +static void Platform_YMDHMStoClock (LONGINT ye, LONGINT mo, LONGINT da, LONGINT ho, LONGINT mi, LONGINT se, LONGINT *t, LONGINT *d); +static void Platform_errch (CHAR c); +static void Platform_errint (LONGINT l); +static void Platform_errln (void); +static void Platform_errposint (LONGINT l); +export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len); + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#define Platform_EACCES() EACCES +#define Platform_EAGAIN() EAGAIN +#define Platform_ECONNABORTED() ECONNABORTED +#define Platform_ECONNREFUSED() ECONNREFUSED +#define Platform_EHOSTUNREACH() EHOSTUNREACH +#define Platform_EMFILE() EMFILE +#define Platform_ENETUNREACH() ENETUNREACH +#define Platform_ENFILE() ENFILE +#define Platform_ENOENT() ENOENT +#define Platform_EROFS() EROFS +#define Platform_ETIMEDOUT() ETIMEDOUT +#define Platform_EXDEV() EXDEV +extern void Heap_InitHeap(); +#define Platform_HeapInitHeap() Heap_InitHeap() +#define Platform_allocate(size) (LONGINT)(uintptr_t)((void*)malloc((size_t)size)) +#define Platform_chdir(n, n__len) chdir((char*)n) +#define Platform_closefile(fd) close(fd) +#define Platform_err() errno +#define Platform_errc(c) write(1, &c, 1) +#define Platform_errstring(s, s__len) write(1, s, s__len-1) +#define Platform_exit(code) exit(code) +#define Platform_free(address) free((void*)(uintptr_t)address) +#define Platform_fstat(fd) fstat(fd, &s) +#define Platform_fsync(fd) fsync(fd) +#define Platform_ftruncate(fd, l) ftruncate(fd, l) +#define Platform_getcwd(cwd, cwd__len) getcwd((char*)cwd, cwd__len) +#define Platform_getenv(var, var__len) (Platform_EnvPtr)getenv((char*)var) +#define Platform_getpid() (INTEGER)getpid() +#define Platform_gettimeval() struct timeval tv; gettimeofday(&tv,0) +#define Platform_lseek(fd, o, w) lseek(fd, o, w) +#define Platform_nanosleep(s, ns) struct timespec req, rem; req.tv_sec = s; req.tv_nsec = ns; nanosleep(&req, &rem) +#define Platform_opennew(n, n__len) open((char*)n, O_CREAT | O_TRUNC | O_RDWR, 0664) +#define Platform_openro(n, n__len) open((char*)n, O_RDONLY) +#define Platform_openrw(n, n__len) open((char*)n, O_RDWR) +#define Platform_readfile(fd, p, l) read(fd, (void*)(uintptr_t)(p), l) +#define Platform_rename(o, o__len, n, n__len) rename((char*)o, (char*)n) +#define Platform_sectotm(s) struct tm *time = localtime((time_t*)&s) +#define Platform_seekcur() SEEK_CUR +#define Platform_seekend() SEEK_END +#define Platform_seekset() SEEK_SET +#define Platform_sethandler(s, h) SystemSetHandler(s, (uintptr_t)h) +#define Platform_stat(n, n__len) stat((char*)n, &s) +#define Platform_statdev() (LONGINT)s.st_dev +#define Platform_statino() (LONGINT)s.st_ino +#define Platform_statmtime() (LONGINT)s.st_mtime +#define Platform_statsize() (LONGINT)s.st_size +#define Platform_structstats() struct stat s +#define Platform_system(str, str__len) system((char*)str) +#define Platform_tmhour() (LONGINT)time->tm_hour +#define Platform_tmmday() (LONGINT)time->tm_mday +#define Platform_tmmin() (LONGINT)time->tm_min +#define Platform_tmmon() (LONGINT)time->tm_mon +#define Platform_tmsec() (LONGINT)time->tm_sec +#define Platform_tmyear() (LONGINT)time->tm_year +#define Platform_tvsec() tv.tv_sec +#define Platform_tvusec() tv.tv_usec +#define Platform_unlink(n, n__len) unlink((char*)n) +#define Platform_writefile(fd, p, l) write(fd, (void*)(uintptr_t)(p), l) + +BOOLEAN Platform_TooManyFiles (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_EMFILE() || e == Platform_ENFILE(); + return _o_result; +} + +BOOLEAN Platform_NoSuchDirectory (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_ENOENT(); + return _o_result; +} + +BOOLEAN Platform_DifferentFilesystems (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_EXDEV(); + return _o_result; +} + +BOOLEAN Platform_Inaccessible (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = (e == Platform_EACCES() || e == Platform_EROFS()) || e == Platform_EAGAIN(); + return _o_result; +} + +BOOLEAN Platform_Absent (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_ENOENT(); + return _o_result; +} + +BOOLEAN Platform_TimedOut (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_ETIMEDOUT(); + return _o_result; +} + +BOOLEAN Platform_ConnectionFailed (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = ((e == Platform_ECONNREFUSED() || e == Platform_ECONNABORTED()) || e == Platform_ENETUNREACH()) || e == Platform_EHOSTUNREACH(); + return _o_result; +} + +LONGINT Platform_OSAllocate (LONGINT size) +{ + LONGINT _o_result; + _o_result = Platform_allocate(size); + return _o_result; +} + +void Platform_OSFree (LONGINT address) +{ + Platform_free(address); +} + +void Platform_Init (INTEGER argc, LONGINT argvadr) +{ + Platform_ArgVecPtr av = NIL; + Platform_MainStackFrame = argvadr; + Platform_ArgCount = argc; + av = (Platform_ArgVecPtr)(uintptr_t)argvadr; + Platform_ArgVector = (*av)[0]; + Platform_HaltCode = -128; + Platform_HeapInitHeap(); +} + +BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len) +{ + BOOLEAN _o_result; + Platform_EnvPtr p = NIL; + __DUP(var, var__len, CHAR); + p = Platform_getenv(var, var__len); + if (p != NIL) { + __COPY(*p, val, val__len); + } + _o_result = p != NIL; + __DEL(var); + return _o_result; +} + +void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len) +{ + __DUP(var, var__len, CHAR); + if (!Platform_getEnv(var, var__len, (void*)val, val__len)) { + val[0] = 0x00; + } + __DEL(var); +} + +void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len) +{ + Platform_ArgVec av = NIL; + if (n < Platform_ArgCount) { + av = (Platform_ArgVec)(uintptr_t)Platform_ArgVector; + __COPY(*(*av)[__X(n, ((LONGINT)(1024)))], val, val__len); + } +} + +void Platform_GetIntArg (INTEGER n, LONGINT *val) +{ + CHAR s[64]; + LONGINT k, d, i; + s[0] = 0x00; + Platform_GetArg(n, (void*)s, ((LONGINT)(64))); + i = 0; + if (s[0] == '-') { + i = 1; + } + k = 0; + d = (int)s[__X(i, ((LONGINT)(64)))] - 48; + while ((d >= 0 && d <= 9)) { + k = k * 10 + d; + i += 1; + d = (int)s[__X(i, ((LONGINT)(64)))] - 48; + } + if (s[0] == '-') { + k = -k; + i -= 1; + } + if (i > 0) { + *val = k; + } +} + +INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len) +{ + INTEGER _o_result; + INTEGER i; + CHAR arg[256]; + __DUP(s, s__len, CHAR); + i = 0; + Platform_GetArg(i, (void*)arg, ((LONGINT)(256))); + while ((i < Platform_ArgCount && __STRCMP(s, arg) != 0)) { + i += 1; + Platform_GetArg(i, (void*)arg, ((LONGINT)(256))); + } + _o_result = i; + __DEL(s); + return _o_result; +} + +void Platform_SetInterruptHandler (Platform_SignalHandler handler) +{ + Platform_sethandler(2, handler); +} + +void Platform_SetQuitHandler (Platform_SignalHandler handler) +{ + Platform_sethandler(3, handler); +} + +void Platform_SetBadInstructionHandler (Platform_SignalHandler handler) +{ + Platform_sethandler(4, handler); +} + +static void Platform_YMDHMStoClock (LONGINT ye, LONGINT mo, LONGINT da, LONGINT ho, LONGINT mi, LONGINT se, LONGINT *t, LONGINT *d) +{ + *d = (__ASHL(__MOD(ye, 100), 9) + __ASHL(mo + 1, 5)) + da; + *t = (__ASHL(ho, 12) + __ASHL(mi, 6)) + se; +} + +void Platform_GetClock (LONGINT *t, LONGINT *d) +{ + Platform_gettimeval(); + Platform_sectotm(Platform_tvsec()); + Platform_YMDHMStoClock(Platform_tmyear(), Platform_tmmon(), Platform_tmmday(), Platform_tmhour(), Platform_tmmin(), Platform_tmsec(), &*t, &*d); +} + +void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec) +{ + Platform_gettimeval(); + *sec = Platform_tvsec(); + *usec = Platform_tvusec(); +} + +LONGINT Platform_Time (void) +{ + LONGINT _o_result; + LONGINT ms; + Platform_gettimeval(); + ms = __DIVF(Platform_tvusec(), 1000) + Platform_tvsec() * 1000; + _o_result = __MOD(ms - Platform_TimeStart, 2147483647); + return _o_result; +} + +void Platform_Delay (LONGINT ms) +{ + LONGINT s, ns; + s = __DIV(ms, 1000); + ns = __MOD(ms, 1000) * 1000000; + Platform_nanosleep(s, ns); +} + +INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len) +{ + INTEGER _o_result; + __DUP(cmd, cmd__len, CHAR); + _o_result = Platform_system(cmd, cmd__len); + __DEL(cmd); + return _o_result; +} + +INTEGER Platform_Error (void) +{ + INTEGER _o_result; + _o_result = Platform_err(); + return _o_result; +} + +INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h) +{ + INTEGER _o_result; + INTEGER fd; + fd = Platform_openro(n, n__len); + if (fd < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + *h = fd; + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h) +{ + INTEGER _o_result; + INTEGER fd; + fd = Platform_openrw(n, n__len); + if (fd < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + *h = fd; + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h) +{ + INTEGER _o_result; + INTEGER fd; + fd = Platform_opennew(n, n__len); + if (fd < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + *h = fd; + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Close (LONGINT h) +{ + INTEGER _o_result; + if (Platform_closefile(h) < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ) +{ + INTEGER _o_result; + Platform_structstats(); + if (Platform_fstat(h) < 0) { + _o_result = Platform_err(); + return _o_result; + } + (*identity).volume = Platform_statdev(); + (*identity).index = Platform_statino(); + (*identity).mtime = Platform_statmtime(); + _o_result = 0; + return _o_result; +} + +INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ) +{ + INTEGER _o_result; + __DUP(n, n__len, CHAR); + Platform_structstats(); + if (Platform_stat(n, n__len) < 0) { + _o_result = Platform_err(); + __DEL(n); + return _o_result; + } + (*identity).volume = Platform_statdev(); + (*identity).index = Platform_statino(); + (*identity).mtime = Platform_statmtime(); + _o_result = 0; + __DEL(n); + return _o_result; +} + +BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2) +{ + BOOLEAN _o_result; + _o_result = (i1.index == i2.index && i1.volume == i2.volume); + return _o_result; +} + +BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2) +{ + BOOLEAN _o_result; + _o_result = i1.mtime == i2.mtime; + return _o_result; +} + +void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source) +{ + (*target).mtime = source.mtime; +} + +void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d) +{ + Platform_sectotm(i.mtime); + Platform_YMDHMStoClock(Platform_tmyear(), Platform_tmmon(), Platform_tmmday(), Platform_tmhour(), Platform_tmmin(), Platform_tmsec(), &*t, &*d); +} + +INTEGER Platform_Size (LONGINT h, LONGINT *l) +{ + INTEGER _o_result; + Platform_structstats(); + if (Platform_fstat(h) < 0) { + _o_result = Platform_err(); + return _o_result; + } + *l = Platform_statsize(); + _o_result = 0; + return _o_result; +} + +INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n) +{ + INTEGER _o_result; + *n = Platform_readfile(h, p, l); + if (*n < 0) { + *n = 0; + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n) +{ + INTEGER _o_result; + *n = Platform_readfile(h, (LONGINT)(uintptr_t)b, b__len); + if (*n < 0) { + *n = 0; + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l) +{ + INTEGER _o_result; + LONGINT written; + written = Platform_writefile(h, p, l); + if (written < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Sync (LONGINT h) +{ + INTEGER _o_result; + if (Platform_fsync(h) < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Seek (LONGINT h, LONGINT offset, INTEGER whence) +{ + INTEGER _o_result; + if (Platform_lseek(h, offset, whence) < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Truncate (LONGINT h, LONGINT l) +{ + INTEGER _o_result; + if (Platform_ftruncate(h, l) < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Unlink (CHAR *n, LONGINT n__len) +{ + INTEGER _o_result; + if (Platform_unlink(n, n__len) < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Chdir (CHAR *n, LONGINT n__len) +{ + INTEGER _o_result; + INTEGER r; + r = Platform_chdir(n, n__len); + Platform_getcwd((void*)Platform_CWD, ((LONGINT)(256))); + if (r < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len) +{ + INTEGER _o_result; + if (Platform_rename(o, o__len, n, n__len) < 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +void Platform_Exit (INTEGER code) +{ + Platform_exit(code); +} + +static void Platform_errch (CHAR c) +{ + Platform_errc(c); +} + +static void Platform_errln (void) +{ + Platform_errch(0x0d); + Platform_errch(0x0a); +} + +static void Platform_errposint (LONGINT l) +{ + if (l > 10) { + Platform_errposint(__DIV(l, 10)); + } + Platform_errch((CHAR)(48 + __MOD(l, 10))); +} + +static void Platform_errint (LONGINT l) +{ + if (l < 0) { + Platform_errch('-'); + l = -l; + } + Platform_errposint(l); +} + +static void Platform_DisplayHaltCode (LONGINT code) +{ + switch (code) { + case -1: + Platform_errstring((CHAR*)"Assertion failure.", (LONGINT)19); + break; + case -2: + Platform_errstring((CHAR*)"Index out of range.", (LONGINT)20); + break; + case -3: + Platform_errstring((CHAR*)"Reached end of function without reaching RETURN.", (LONGINT)49); + break; + case -4: + Platform_errstring((CHAR*)"CASE statement: no matching label and no ELSE.", (LONGINT)47); + break; + case -5: + Platform_errstring((CHAR*)"Type guard failed.", (LONGINT)19); + break; + case -6: + Platform_errstring((CHAR*)"Implicit type guard in record assignment failed.", (LONGINT)49); + break; + case -7: + Platform_errstring((CHAR*)"Invalid case in WITH statement.", (LONGINT)32); + break; + case -8: + Platform_errstring((CHAR*)"Value out of range.", (LONGINT)20); + break; + case -9: + Platform_errstring((CHAR*)"Heap interrupted while locked, but lockdepth = 0 at unlock.", (LONGINT)60); + break; + case -10: + Platform_errstring((CHAR*)"NIL access.", (LONGINT)12); + break; + case -11: + Platform_errstring((CHAR*)"Alignment error.", (LONGINT)17); + break; + case -12: + Platform_errstring((CHAR*)"Divide by zero.", (LONGINT)16); + break; + case -13: + Platform_errstring((CHAR*)"Arithmetic overflow/underflow.", (LONGINT)31); + break; + case -14: + Platform_errstring((CHAR*)"Invalid function argument.", (LONGINT)27); + break; + case -15: + Platform_errstring((CHAR*)"Internal error, e.g. Type descriptor size mismatch.", (LONGINT)52); + break; + case -20: + Platform_errstring((CHAR*)"Too many, or negative number of, elements in dynamic array.", (LONGINT)60); + break; + default: + break; + } +} + +void Platform_Halt (LONGINT code) +{ + INTEGER e; + Platform_HaltCode = code; + if (Platform_HaltHandler != NIL) { + (*Platform_HaltHandler)(code); + } + Platform_errstring((CHAR*)"Terminated by Halt(", (LONGINT)20); + Platform_errint(code); + Platform_errstring((CHAR*)"). ", (LONGINT)4); + if (code < 0) { + Platform_DisplayHaltCode(code); + } + Platform_errln(); + Platform_exit(__VAL(INTEGER, code)); +} + +void Platform_AssertFail (LONGINT code) +{ + INTEGER e; + Platform_errstring((CHAR*)"Assertion failure.", (LONGINT)19); + if (code != 0) { + Platform_errstring((CHAR*)" ASSERT code ", (LONGINT)14); + Platform_errint(code); + Platform_errstring((CHAR*)".", (LONGINT)2); + } + Platform_errln(); + Platform_exit(__VAL(INTEGER, code)); +} + +void Platform_SetHalt (Platform_HaltProcedure p) +{ + Platform_HaltHandler = p; +} + +static void Platform_TestLittleEndian (void) +{ + INTEGER i; + i = 1; + __GET((LONGINT)(uintptr_t)&i, Platform_LittleEndian, BOOLEAN); +} + +__TDESC(Platform_FileIdentity, 1, 0) = {__TDFLDS("FileIdentity", 24), {-8}}; + +export void *Platform__init(void) +{ + __DEFMOD; + __REGMOD("Platform", 0); + __INITYP(Platform_FileIdentity, Platform_FileIdentity, 0); +/* BEGIN */ + Platform_TestLittleEndian(); + Platform_HaltCode = -128; + Platform_HaltHandler = NIL; + Platform_TimeStart = Platform_Time(); + Platform_CWD[0] = 0x00; + Platform_getcwd((void*)Platform_CWD, ((LONGINT)(256))); + Platform_PID = Platform_getpid(); + Platform_SeekSet = Platform_seekset(); + Platform_SeekCur = Platform_seekcur(); + Platform_SeekEnd = Platform_seekend(); + Platform_nl[0] = 0x0a; + Platform_nl[1] = 0x00; + __ENDMOD; +} diff --git a/bootstrap/unix-88/Platform.h b/bootstrap/unix-88/Platform.h new file mode 100644 index 00000000..7dca4035 --- /dev/null +++ b/bootstrap/unix-88/Platform.h @@ -0,0 +1,83 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Platform__h +#define Platform__h + +#define LARGE +#include "SYSTEM.h" + +typedef + struct Platform_FileIdentity { + LONGINT volume, index, mtime; + } Platform_FileIdentity; + +typedef + void (*Platform_HaltProcedure)(LONGINT); + +typedef + void (*Platform_SignalHandler)(INTEGER); + + +import BOOLEAN Platform_LittleEndian; +import LONGINT Platform_MainStackFrame, Platform_HaltCode; +import INTEGER Platform_PID; +import CHAR Platform_CWD[256]; +import INTEGER Platform_ArgCount; +import LONGINT Platform_ArgVector; +import INTEGER Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd; +import CHAR Platform_nl[3]; + +import LONGINT *Platform_FileIdentity__typ; + +import BOOLEAN Platform_Absent (INTEGER e); +import INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len); +import void Platform_AssertFail (LONGINT code); +import INTEGER Platform_Chdir (CHAR *n, LONGINT n__len); +import INTEGER Platform_Close (LONGINT h); +import BOOLEAN Platform_ConnectionFailed (INTEGER e); +import void Platform_Delay (LONGINT ms); +import BOOLEAN Platform_DifferentFilesystems (INTEGER e); +import INTEGER Platform_Error (void); +import void Platform_Exit (INTEGER code); +import void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len); +import void Platform_GetClock (LONGINT *t, LONGINT *d); +import void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len); +import void Platform_GetIntArg (INTEGER n, LONGINT *val); +import void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec); +import void Platform_Halt (LONGINT code); +import INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ); +import INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ); +import BOOLEAN Platform_Inaccessible (INTEGER e); +import void Platform_Init (INTEGER argc, LONGINT argvadr); +import void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d); +import INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h); +import BOOLEAN Platform_NoSuchDirectory (INTEGER e); +import LONGINT Platform_OSAllocate (LONGINT size); +import void Platform_OSFree (LONGINT address); +import INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h); +import INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h); +import INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n); +import INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n); +import INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len); +import BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2); +import BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2); +import INTEGER Platform_Seek (LONGINT h, LONGINT offset, INTEGER whence); +import void Platform_SetBadInstructionHandler (Platform_SignalHandler handler); +import void Platform_SetHalt (Platform_HaltProcedure p); +import void Platform_SetInterruptHandler (Platform_SignalHandler handler); +import void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source); +import void Platform_SetQuitHandler (Platform_SignalHandler handler); +import INTEGER Platform_Size (LONGINT h, LONGINT *l); +import INTEGER Platform_Sync (LONGINT h); +import INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len); +import LONGINT Platform_Time (void); +import BOOLEAN Platform_TimedOut (INTEGER e); +import BOOLEAN Platform_TooManyFiles (INTEGER e); +import INTEGER Platform_Truncate (LONGINT h, LONGINT l); +import INTEGER Platform_Unlink (CHAR *n, LONGINT n__len); +import INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l); +import BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len); +import void *Platform__init(void); + + +#endif diff --git a/bootstrap/unix-88/Reals.c b/bootstrap/unix-88/Reals.c new file mode 100644 index 00000000..edf27d40 --- /dev/null +++ b/bootstrap/unix-88/Reals.c @@ -0,0 +1,143 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" + + + + +export void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len); +export void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len); +export void Reals_ConvertHL (LONGREAL y, CHAR *d, LONGINT d__len); +export void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len); +export INTEGER Reals_Expo (REAL x); +export INTEGER Reals_ExpoL (LONGREAL x); +export REAL Reals_Ten (INTEGER e); +export LONGREAL Reals_TenL (INTEGER e); +static CHAR Reals_ToHex (INTEGER i); + + +REAL Reals_Ten (INTEGER e) +{ + REAL _o_result; + LONGREAL r, power; + r = (LONGREAL)1; + power = (LONGREAL)10; + while (e > 0) { + if (__ODD(e)) { + r = r * power; + } + power = power * power; + e = __ASHR(e, 1); + } + _o_result = r; + return _o_result; +} + +LONGREAL Reals_TenL (INTEGER e) +{ + LONGREAL _o_result; + LONGREAL r, power; + r = (LONGREAL)1; + power = (LONGREAL)10; + for (;;) { + if (__ODD(e)) { + r = r * power; + } + e = __ASHR(e, 1); + if (e <= 0) { + _o_result = r; + return _o_result; + } + power = power * power; + } + __RETCHK; +} + +INTEGER Reals_Expo (REAL x) +{ + INTEGER _o_result; + _o_result = (int)__MASK(__ASHR((LONGINT)(__VAL(INTEGER, x)), 23), -256); + return _o_result; +} + +INTEGER Reals_ExpoL (LONGREAL x) +{ + INTEGER _o_result; + INTEGER i; + LONGINT l; + __GET((LONGINT)(uintptr_t)&x + 4, i, INTEGER); + _o_result = (int)__MASK(__ASHR((LONGINT)i, 20), -2048); + return _o_result; +} + +void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len) +{ + LONGINT i, j, k; + if (x < (LONGREAL)0) { + x = -x; + } + k = 0; + i = __ENTIER(x); + while (k < (LONGINT)n) { + d[__X(k, d__len)] = (CHAR)(__MOD(i, 10) + 48); + i = __DIV(i, 10); + k += 1; + } +} + +void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len) +{ + Reals_ConvertL(x, n, (void*)d, d__len); +} + +static CHAR Reals_ToHex (INTEGER i) +{ + CHAR _o_result; + if (i < 10) { + _o_result = (CHAR)(i + 48); + return _o_result; + } else { + _o_result = (CHAR)(i + 55); + return _o_result; + } + __RETCHK; +} + +typedef + CHAR (*pc4__3)[4]; + +void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len) +{ + pc4__3 p = NIL; + INTEGER i; + p = (pc4__3)(uintptr_t)((LONGINT)(uintptr_t)&y); + i = 0; + while (i < 4) { + d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((int)(*p)[__X(i, ((LONGINT)(4)))], 4)); + d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((int)(*p)[__X(i, ((LONGINT)(4)))], -16)); + } +} + +typedef + CHAR (*pc8__5)[8]; + +void Reals_ConvertHL (LONGREAL y, CHAR *d, LONGINT d__len) +{ + pc8__5 p = NIL; + INTEGER i; + p = (pc8__5)(uintptr_t)((LONGINT)(uintptr_t)&y); + i = 0; + while (i < 8) { + d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((int)(*p)[__X(i, ((LONGINT)(8)))], 4)); + d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((int)(*p)[__X(i, ((LONGINT)(8)))], -16)); + } +} + + +export void *Reals__init(void) +{ + __DEFMOD; + __REGMOD("Reals", 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-88/Reals.h b/bootstrap/unix-88/Reals.h new file mode 100644 index 00000000..5febc0f1 --- /dev/null +++ b/bootstrap/unix-88/Reals.h @@ -0,0 +1,23 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Reals__h +#define Reals__h + +#define LARGE +#include "SYSTEM.h" + + + + +import void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len); +import void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len); +import void Reals_ConvertHL (LONGREAL y, CHAR *d, LONGINT d__len); +import void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len); +import INTEGER Reals_Expo (REAL x); +import INTEGER Reals_ExpoL (LONGREAL x); +import REAL Reals_Ten (INTEGER e); +import LONGREAL Reals_TenL (INTEGER e); +import void *Reals__init(void); + + +#endif diff --git a/bootstrap/unix-88/SYSTEM.c b/bootstrap/unix-88/SYSTEM.c new file mode 100644 index 00000000..0fcc5ee2 --- /dev/null +++ b/bootstrap/unix-88/SYSTEM.c @@ -0,0 +1,207 @@ +/* +* The body prefix file of the voc(jet backend) runtime system, Version 1.0 +* +* Copyright (c) Software Templ, 1994, 1995 +* +* Module SYSTEM is subject to change any time without prior notification. +* Software Templ disclaims all warranties with regard to module SYSTEM, +* in particular shall Software Templ not be liable for any damage resulting +* from inappropriate use or modification of module SYSTEM. +* +* Version 1.1 jt, 24.11.95 fixes for correct pointer arithmetic on Cray computers +* jt 31.1.2007 ANSI prototypes for malloc and exit in order to avoid cc warnings +* +*/ + +#include "SYSTEM.h" +#include "stdarg.h" +#include + + +LONGINT SYSTEM_XCHK(LONGINT i, LONGINT ub) {return __X(i, ub);} +LONGINT SYSTEM_RCHK(LONGINT i, LONGINT ub) {return __R(i, ub);} +LONGINT SYSTEM_ASH (LONGINT i, LONGINT n) {return __ASH(i, n);} +LONGINT SYSTEM_ABS (LONGINT i) {return __ABS(i);} +double SYSTEM_ABSD(double i) {return __ABS(i);} + +void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0) +{ + t -= __TPROC0OFF; + t0 -= __TPROC0OFF; + while (*t0 != __EOM) {*t = *t0; t--; t0--;} +} + + +void SYSTEM_ENUMP(void *adr, LONGINT n, void (*P)()) +{ + while (n > 0) { + P((LONGINT)(uintptr_t)(*((void**)(adr)))); + adr = ((void**)adr) + 1; + n--; + } +} + +void SYSTEM_ENUMR(void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)()) +{ + LONGINT *t, off; + typ++; + while (n > 0) { + t = typ; + off = *t; + while (off >= 0) {P(*(LONGINT*)((char*)adr+off)); t++; off = *t;} + adr = ((char*)adr) + size; + n--; + } +} + +LONGINT SYSTEM_DIV(unsigned LONGINT x, unsigned LONGINT y) +{ if ((LONGINT) x >= 0) return (x / y); + else return -((y - 1 - x) / y); +} + +LONGINT SYSTEM_MOD(unsigned LONGINT x, unsigned LONGINT y) +{ unsigned LONGINT m; + if ((LONGINT) x >= 0) return (x % y); + else { m = (-x) % y; + if (m != 0) return (y - m); else return 0; + } +} + +LONGINT SYSTEM_ENTIER(double x) +{ + LONGINT y; + if (x >= 0) + return (LONGINT)x; + else { + y = (LONGINT)x; + if (y <= x) return y; else return y - 1; + } +} + +extern void Heap_Lock(); +extern void Heap_Unlock(); + +SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim, int nofdyn, ...) +{ + LONGINT nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off; + va_list ap; + va_start(ap, nofdyn); + nofelems = 1; + while (nofdim > 0) { + nofelems = nofelems * va_arg(ap, LONGINT); nofdim--; + if (nofelems <= 0) __HALT(-20); + } + va_end(ap); + dataoff = nofdyn * sizeof(LONGINT); + if (elemalgn > sizeof(LONGINT)) { + n = dataoff % elemalgn; + if (n != 0) dataoff += elemalgn - n; + } + size = dataoff + nofelems * elemsz; + Heap_Lock(); + if (typ == NIL) { + /* element typ does not contain pointers */ + x = Heap_NEWBLK(size); + } + else if (typ == (LONGINT*)POINTER__typ) { + /* element type is a pointer */ + x = Heap_NEWBLK(size + nofelems * sizeof(LONGINT)); + p = (LONGINT*)(uintptr_t)x[-1]; + p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ + p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */ + while (n <= nofelems) {*p = n*sizeof(LONGINT); p++; n++;} + *p = - (nofelems + 1) * sizeof(LONGINT); /* sentinel */ + x[-1] -= nofelems * sizeof(LONGINT); + } + else { + /* element type is a record that contains pointers */ + ptab = typ + 1; nofptrs = 0; + while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */ + nptr = nofelems * nofptrs; /* total number of pointers */ + x = Heap_NEWBLK(size + nptr * sizeof(LONGINT)); + p = (LONGINT*)(uintptr_t)x[- 1]; + p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ + p -= nptr - 1; n = 0; off = dataoff; + while (n < nofelems) {i = 0; + while (i < nofptrs) {*p = off + ptab[i]; p++; i++;} + off += elemsz; n++; + } + *p = - (nptr + 1) * sizeof(LONGINT); /* sentinel */ + x[-1] -= nptr * sizeof(LONGINT); + } + if (nofdyn != 0) { + /* setup len vector for index checks */ + va_start(ap, nofdyn); + p = x; + while (nofdyn > 0) {*p = va_arg(ap, LONGINT); p++, nofdyn--;} + va_end(ap); + } + Heap_Unlock(); + return x; +} + + + + +typedef void (*SystemSignalHandler)(INTEGER); // = Platform_SignalHandler + +#ifndef _WIN32 + + SystemSignalHandler handler[3] = {0}; + + // Provide signal handling for Unix based systems + void signalHandler(int s) { + if (s >= 2 && s <= 4) handler[s-2](s); + // (Ignore other signals) + } + + void SystemSetHandler(int s, uintptr_t h) { + if (s >= 2 && s <= 4) { + int needtosetsystemhandler = handler[s-2] == 0; + handler[s-2] = (SystemSignalHandler)h; + if (needtosetsystemhandler) {signal(s, signalHandler);} + } + } + +#else + + // Provides Windows callback handlers for signal-like scenarios + #include "WindowsWrapper.h" + + SystemSignalHandler SystemInterruptHandler = 0; + SystemSignalHandler SystemQuitHandler = 0; + BOOL ConsoleCtrlHandlerSet = FALSE; + + BOOL WINAPI SystemConsoleCtrlHandler(DWORD ctrlType) { + if ((ctrlType == CTRL_C_EVENT) || (ctrlType == CTRL_BREAK_EVENT)) { + if (SystemInterruptHandler) { + SystemInterruptHandler(2); // SIGINT + return TRUE; + } + } else { // Close, logoff or shutdown + if (SystemQuitHandler) { + SystemQuitHandler(3); // SIGQUIT + return TRUE; + } + } + return FALSE; + } + + void EnsureConsoleCtrlHandler() { + if (!ConsoleCtrlHandlerSet) { + SetConsoleCtrlHandler(SystemConsoleCtrlHandler, TRUE); + ConsoleCtrlHandlerSet = TRUE; + } + } + + void SystemSetInterruptHandler(uintptr_t h) { + EnsureConsoleCtrlHandler(); + SystemInterruptHandler = (SystemSignalHandler)h; + } + + void SystemSetQuitHandler(uintptr_t h) { + EnsureConsoleCtrlHandler(); + SystemQuitHandler = (SystemSignalHandler)h; + } + +#endif diff --git a/bootstrap/unix-88/SYSTEM.h b/bootstrap/unix-88/SYSTEM.h new file mode 100644 index 00000000..f9e2f930 --- /dev/null +++ b/bootstrap/unix-88/SYSTEM.h @@ -0,0 +1,275 @@ +#ifndef SYSTEM__h +#define SYSTEM__h + +#ifndef _WIN32 + + // Building for a Unix/Linux based system + #include // For memcpy ... + #include // For uintptr_t ... + +#else + + // Building for Windows platform with either mingw under cygwin, or the MS C compiler + #ifdef _WIN64 + typedef unsigned long long size_t; + typedef unsigned long long uintptr_t; + #else + typedef unsigned int size_t; + typedef unsigned int uintptr_t; + #endif /* _WIN64 */ + + typedef unsigned int uint32_t; + void * __cdecl memcpy(void * dest, const void * source, size_t size); + +#endif + + +// The compiler uses 'import' and 'export' which translate to 'extern' and +// nothing respectively. + +#define import extern +#define export + + + +// Known constants + +#define NIL ((void*)0) +#define __MAXEXT 16 +#define POINTER__typ ((LONGINT*)(1)) // not NIL and not a valid type + + +// Oberon types + +#define BOOLEAN char +#define SYSTEM_BYTE unsigned char +#define CHAR unsigned char +#define SHORTINT signed char +#define REAL float +#define LONGREAL double +#define SYSTEM_PTR void* + +// For 32 bit builds, the size of LONGINT depends on a make option: + +#if (__SIZEOF_POINTER__ == 8) || defined(LARGE) || defined(_WIN64) + #define INTEGER int // INTEGER is 32 bit. + #define LONGINT long long // LONGINT is 64 bit. (long long is always 64 bits, while long can be 32 bits e.g. under MSC/MingW) +#else + #define INTEGER short int // INTEGER is 16 bit. + #define LONGINT long // LONGINT is 32 bit. +#endif + +#define SET unsigned LONGINT + + +// OS Memory allocation interfaces are in PlatformXXX.Mod + +extern LONGINT Platform_OSAllocate (LONGINT size); +extern void Platform_OSFree (LONGINT addr); + + +// Run time system routines in SYSTEM.c + +extern LONGINT SYSTEM_XCHK (LONGINT i, LONGINT ub); +extern LONGINT SYSTEM_RCHK (LONGINT i, LONGINT ub); +extern LONGINT SYSTEM_ASH (LONGINT i, LONGINT n); +extern LONGINT SYSTEM_ABS (LONGINT i); +extern double SYSTEM_ABSD (double i); +extern void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0); +extern void SYSTEM_ENUMP (void *adr, LONGINT n, void (*P)()); +extern void SYSTEM_ENUMR (void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)()); +extern LONGINT SYSTEM_DIV (unsigned LONGINT x, unsigned LONGINT y); +extern LONGINT SYSTEM_MOD (unsigned LONGINT x, unsigned LONGINT y); +extern LONGINT SYSTEM_ENTIER (double x); + + +// Signal handling in SYSTEM.c + +#ifndef _WIN32 + extern void SystemSetHandler(int s, uintptr_t h); +#else + extern void SystemSetInterruptHandler(uintptr_t h); + extern void SystemSetQuitHandler (uintptr_t h); +#endif + + + +// String comparison + +static int __str_cmp(CHAR *x, CHAR *y){ + LONGINT i = 0; + CHAR ch1, ch2; + do {ch1 = x[i]; ch2 = y[i]; i++; + if (!ch1) return -(int)ch2; + } while (ch1==ch2); + return (int)ch1 - (int)ch2; +} +#define __STRCMP(a,b) __str_cmp((CHAR*)(a), (CHAR*)(b)) + + + +// Inline string, record and array copy + +#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d; LONGINT _i=0,_t=n-1; \ + while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;} +#define __DUP(x, l, t) x=(void*)memcpy((void*)(uintptr_t)Platform_OSAllocate(l*sizeof(t)),x,l*sizeof(t)) +#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t)) +#define __DEL(x) Platform_OSFree((LONGINT)(uintptr_t)x) + + + + +/* SYSTEM ops */ + +#define __VAL(t, x) ((t)(x)) +#define __VALP(t, x) ((t)(uintptr_t)(x)) + +#define __GET(a, x, t) x= *(t*)(uintptr_t)(a) +#define __PUT(a, x, t) *(t*)(uintptr_t)(a)=x +#define __LSHL(x, n, t) ((t)((unsigned t)(x)<<(n))) +#define __LSHR(x, n, t) ((t)((unsigned t)(x)>>(n))) +#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) +#define __ROTL(x, n, t) ((t)((unsigned t)(x)<<(n)|(unsigned t)(x)>>(8*sizeof(t)-(n)))) +#define __ROTR(x, n, t) ((t)((unsigned t)(x)>>(n)|(unsigned t)(x)<<(8*sizeof(t)-(n)))) +#define __LSHR(x, n, t) ((t)((unsigned t)(x)>>(n))) +#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) +#define __ROTL(x, n, t) ((t)((unsigned t)(x)<<(n)|(unsigned t)(x)>>(8*sizeof(t)-(n)))) +#define __ROTR(x, n, t) ((t)((unsigned t)(x)>>(n)|(unsigned t)(x)<<(8*sizeof(t)-(n)))) +#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t)) +#define __BIT(x, n) (*(unsigned LONGINT*)(x)>>(n)&1) +#define __MOVE(s, d, n) memcpy((char*)(uintptr_t)(d),(char*)(uintptr_t)(s),n) +#define __ASHL(x, n) ((LONGINT)(x)<<(n)) +#define __ASHR(x, n) ((LONGINT)(x)>>(n)) +#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n))) +#define __ASHF(x, n) SYSTEM_ASH((LONGINT)(x), (LONGINT)(n)) +#define __SHORT(x, y) ((int)((unsigned LONGINT)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0))) +#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y))) +#define __CHR(x) ((CHAR)__R(x, 256)) +#define __CHRF(x) ((CHAR)__RF(x, 256)) +#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y))) +#define __DIVF(x, y) SYSTEM_DIV((LONGINT)(x),(LONGINT)(y)) +#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y)) +#define __MODF(x, y) SYSTEM_MOD((LONGINT)(x),(LONGINT)(y)) +#define __ENTIER(x) SYSTEM_ENTIER(x) +#define __ABS(x) (((x)<0)?-(x):(x)) +#define __ABSF(x) SYSTEM_ABS((LONGINT)(x)) +#define __ABSFD(x) SYSTEM_ABSD((double)(x)) +#define __CAP(ch) ((CHAR)((ch)&0x5f)) +#define __ODD(x) ((x)&1) +#define __IN(x, s) (((s)>>(x))&1) +#define __SETOF(x) ((SET)1<<(x)) +#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h))) +#define __MASK(x, m) ((x)&~(m)) + + + +// Runtime checks + +#define __X(i, ub) (((unsigned LONGINT)(i)<(unsigned LONGINT)(ub))?i:(__HALT(-2),0)) +#define __XF(i, ub) SYSTEM_XCHK((LONGINT)(i), (LONGINT)(ub)) +#define __R(i, ub) (((unsigned LONGINT)(i)<(unsigned LONGINT)(ub))?i:(__HALT(-8),0)) +#define __RF(i, ub) SYSTEM_RCHK((LONGINT)(i),(LONGINT)(ub)) +#define __RETCHK __retchk: __HALT(-3); return 0; +#define __CASECHK __HALT(-4) +#define __WITHCHK __HALT(-7) + +#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p))) +#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r)))) +#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p))) +#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p) +#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p) + + + +// Module entry/registration/exit + +extern void Heap_REGCMD(); +extern SYSTEM_PTR Heap_REGMOD(); +extern void Heap_REGTYP(); +extern void Heap_INCREF(); + +#define __DEFMOD static void *m; if (m!=0) {return m;} +#define __REGCMD(name, cmd) Heap_REGCMD(m, (CHAR*)name, cmd) +#define __REGMOD(name, enum) if (m==0) {m = Heap_REGMOD((CHAR*)name,enum);} +#define __ENDMOD return m +#define __MODULE_IMPORT(name) Heap_INCREF(name##__init()) + + + +// Main module initialisation, registration and finalisation + +extern void Platform_Init(INTEGER argc, LONGINT argv); +extern void *Platform_MainModule; +extern void Heap_FINALL(); + +#define __INIT(argc, argv) static void *m; Platform_Init((INTEGER)argc, (LONGINT)(uintptr_t)&argv); +#define __REGMAIN(name, enum) m = Heap_REGMOD((CHAR*)name,enum) +#define __FINI Heap_FINALL(); return 0 + + +// Assertions and Halts + +extern void Platform_Halt(LONGINT x); +extern void Platform_AssertFail(LONGINT x); + +#define __HALT(x) Platform_Halt(x) +#define __ASSERT(cond, x) if (!(cond)) Platform_AssertFail((LONGINT)(x)) + + +// Memory allocation + +extern SYSTEM_PTR Heap_NEWBLK (LONGINT size); +extern SYSTEM_PTR Heap_NEWREC (LONGINT tag); +extern SYSTEM_PTR SYSTEM_NEWARR(LONGINT*, LONGINT, int, int, int, ...); + +#define __SYSNEW(p, len) p = Heap_NEWBLK((LONGINT)(len)) +#define __NEW(p, t) p = Heap_NEWREC((LONGINT)(uintptr_t)t##__typ) +#define __NEWARR SYSTEM_NEWARR + + + +/* Type handling */ + +#define __TDESC(t, m, n) \ + static struct t##__desc { \ + LONGINT tproc[m]; /* Proc for each ptr field */ \ + LONGINT tag; \ + LONGINT next; /* Module table type list points here */ \ + LONGINT level; \ + LONGINT module; \ + char name[24]; \ + LONGINT basep[__MAXEXT]; /* List of bases this extends */ \ + LONGINT reserved; \ + LONGINT blksz; /* xxx_typ points here */ \ + LONGINT ptr[n+1]; /* Offsets of ptrs up to -ve sentinel */ \ + } t##__desc + +#define __BASEOFF (__MAXEXT+1) // blksz as index to base. +#define __TPROC0OFF (__BASEOFF+24/sizeof(LONGINT)+5) // blksz as index to tproc IFF m=1. +#define __EOM 1 +#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size +#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (LONGINT)(n), P) +#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (LONGINT)(size), (LONGINT)(n), P) + +#define __INITYP(t, t0, level) \ + t##__typ = (LONGINT*)&t##__desc.blksz; \ + memcpy(t##__desc.basep, t0##__typ - __BASEOFF, level*sizeof(LONGINT)); \ + t##__desc.basep[level] = (LONGINT)(uintptr_t)t##__typ; \ + t##__desc.module = (LONGINT)(uintptr_t)m; \ + if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \ + t##__desc.blksz = (t##__desc.blksz+5*sizeof(LONGINT)-1)/(4*sizeof(LONGINT))*(4*sizeof(LONGINT)); \ + Heap_REGTYP(m, (LONGINT)(uintptr_t)&t##__desc.next); \ + SYSTEM_INHERIT(t##__typ, t0##__typ) + +#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(LONGINT)(uintptr_t)typ##__typ) +#define __TYPEOF(p) ((LONGINT*)(uintptr_t)(*(((LONGINT*)(p))-1))) +#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level) + +// Oberon-2 type bound procedures support +#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(LONGINT)(uintptr_t)proc +#define __SEND(typ, num, funtyp, parlist) ((funtyp)((uintptr_t)*(typ-(__TPROC0OFF+num))))parlist + + + + +#endif diff --git a/bootstrap/unix-88/Strings.c b/bootstrap/unix-88/Strings.c new file mode 100644 index 00000000..98eef9eb --- /dev/null +++ b/bootstrap/unix-88/Strings.c @@ -0,0 +1,244 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" + + + + +export void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len); +export void Strings_Cap (CHAR *s, LONGINT s__len); +export void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n); +export void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len); +export void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len); +export INTEGER Strings_Length (CHAR *s, LONGINT s__len); +export BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len); +export INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos); +export void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len); + + +INTEGER Strings_Length (CHAR *s, LONGINT s__len) +{ + INTEGER _o_result; + INTEGER i; + __DUP(s, s__len, CHAR); + i = 0; + while (((LONGINT)i < s__len && s[__X(i, s__len)] != 0x00)) { + i += 1; + } + _o_result = i; + __DEL(s); + return _o_result; +} + +void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len) +{ + INTEGER n1, n2, i; + __DUP(extra, extra__len, CHAR); + n1 = Strings_Length(dest, dest__len); + n2 = Strings_Length(extra, extra__len); + i = 0; + while ((i < n2 && (LONGINT)(i + n1) < dest__len)) { + dest[__X(i + n1, dest__len)] = extra[__X(i, extra__len)]; + i += 1; + } + if ((LONGINT)(i + n1) < dest__len) { + dest[__X(i + n1, dest__len)] = 0x00; + } + __DEL(extra); +} + +void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len) +{ + INTEGER n1, n2, i; + __DUP(source, source__len, CHAR); + n1 = Strings_Length(dest, dest__len); + n2 = Strings_Length(source, source__len); + if (pos < 0) { + pos = 0; + } + if (pos > n1) { + Strings_Append(dest, dest__len, (void*)source, source__len); + return; + } + if ((LONGINT)(pos + n2) < dest__len) { + i = n1; + while (i >= pos) { + if ((LONGINT)(i + n2) < dest__len) { + dest[__X(i + n2, dest__len)] = dest[__X(i, dest__len)]; + } + i -= 1; + } + } + i = 0; + while (i < n2) { + dest[__X(pos + i, dest__len)] = source[__X(i, source__len)]; + i += 1; + } + __DEL(source); +} + +void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n) +{ + INTEGER len, i; + len = Strings_Length(s, s__len); + if (pos < 0) { + pos = 0; + } else if (pos >= len) { + return; + } + if (pos + n < len) { + i = pos + n; + while (i < len) { + s[__X(i - n, s__len)] = s[__X(i, s__len)]; + i += 1; + } + if ((LONGINT)(i - n) < s__len) { + s[__X(i - n, s__len)] = 0x00; + } + } else { + s[__X(pos, s__len)] = 0x00; + } +} + +void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len) +{ + __DUP(source, source__len, CHAR); + Strings_Delete((void*)dest, dest__len, pos, pos + Strings_Length(source, source__len)); + Strings_Insert(source, source__len, pos, (void*)dest, dest__len); + __DEL(source); +} + +void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len) +{ + INTEGER len, destLen, i; + __DUP(source, source__len, CHAR); + len = Strings_Length(source, source__len); + destLen = (int)dest__len - 1; + if (pos < 0) { + pos = 0; + } + if (pos >= len) { + dest[0] = 0x00; + return; + } + i = 0; + while (((((LONGINT)(pos + i) <= source__len && source[__X(pos + i, source__len)] != 0x00)) && i < n)) { + if (i < destLen) { + dest[__X(i, dest__len)] = source[__X(pos + i, source__len)]; + } + i += 1; + } + dest[__X(i, dest__len)] = 0x00; + __DEL(source); +} + +INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos) +{ + INTEGER _o_result; + INTEGER n1, n2, i, j; + __DUP(pattern, pattern__len, CHAR); + __DUP(s, s__len, CHAR); + n1 = Strings_Length(s, s__len); + n2 = Strings_Length(pattern, pattern__len); + if (n2 == 0) { + _o_result = 0; + __DEL(pattern); + __DEL(s); + return _o_result; + } + i = pos; + while (i <= n1 - n2) { + if (s[__X(i, s__len)] == pattern[0]) { + j = 1; + while ((j < n2 && s[__X(i + j, s__len)] == pattern[__X(j, pattern__len)])) { + j += 1; + } + if (j == n2) { + _o_result = i; + __DEL(pattern); + __DEL(s); + return _o_result; + } + } + i += 1; + } + _o_result = -1; + __DEL(pattern); + __DEL(s); + return _o_result; +} + +void Strings_Cap (CHAR *s, LONGINT s__len) +{ + INTEGER i; + i = 0; + while (s[__X(i, s__len)] != 0x00) { + if (('a' <= s[__X(i, s__len)] && s[__X(i, s__len)] <= 'z')) { + s[__X(i, s__len)] = __CAP(s[__X(i, s__len)]); + } + i += 1; + } +} + +static struct Match__7 { + struct Match__7 *lnk; +} *Match__7_s; + +static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INTEGER n, INTEGER m); + +static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INTEGER n, INTEGER m) +{ + BOOLEAN _o_result; + while ((((n >= 0 && m >= 0)) && mask[__X(m, mask__len)] != '*')) { + if (name[__X(n, name__len)] != mask[__X(m, mask__len)]) { + _o_result = 0; + return _o_result; + } + n -= 1; + m -= 1; + } + if (m < 0) { + _o_result = n < 0; + return _o_result; + } + while ((m >= 0 && mask[__X(m, mask__len)] == '*')) { + m -= 1; + } + if (m < 0) { + _o_result = 1; + return _o_result; + } + while (n >= 0) { + if (M__8(name, name__len, mask, mask__len, n, m)) { + _o_result = 1; + return _o_result; + } + n -= 1; + } + _o_result = 0; + return _o_result; +} + +BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len) +{ + BOOLEAN _o_result; + struct Match__7 _s; + __DUP(string, string__len, CHAR); + __DUP(pattern, pattern__len, CHAR); + _s.lnk = Match__7_s; + Match__7_s = &_s; + _o_result = M__8((void*)string, string__len, (void*)pattern, pattern__len, Strings_Length(string, string__len) - 1, Strings_Length(pattern, pattern__len) - 1); + Match__7_s = _s.lnk; + __DEL(string); + __DEL(pattern); + return _o_result; +} + + +export void *Strings__init(void) +{ + __DEFMOD; + __REGMOD("Strings", 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/unix-88/Strings.h b/bootstrap/unix-88/Strings.h new file mode 100644 index 00000000..05e86973 --- /dev/null +++ b/bootstrap/unix-88/Strings.h @@ -0,0 +1,24 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Strings__h +#define Strings__h + +#define LARGE +#include "SYSTEM.h" + + + + +import void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len); +import void Strings_Cap (CHAR *s, LONGINT s__len); +import void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n); +import void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len); +import void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len); +import INTEGER Strings_Length (CHAR *s, LONGINT s__len); +import BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len); +import INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos); +import void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len); +import void *Strings__init(void); + + +#endif diff --git a/bootstrap/unix-88/Texts.c b/bootstrap/unix-88/Texts.c new file mode 100644 index 00000000..307bec01 --- /dev/null +++ b/bootstrap/unix-88/Texts.c @@ -0,0 +1,1839 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "Files.h" +#include "Modules.h" +#include "Reals.h" + +typedef + struct Texts_RunDesc *Texts_Run; + +typedef + struct Texts_FontDesc *Texts_FontsFont; + +typedef + struct Texts_RunDesc { + Texts_Run prev, next; + LONGINT len; + Texts_FontsFont fnt; + SHORTINT col, voff; + BOOLEAN ascii; + } Texts_RunDesc; + +typedef + struct Texts_ElemDesc *Texts_Elem; + +typedef + struct Texts_ElemMsg { + char _prvt0[1]; + } Texts_ElemMsg; + +typedef + void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, LONGINT *); + +typedef + struct Texts_TextDesc *Texts_Text; + +typedef + struct Texts_ElemDesc { + Texts_Run prev, next; + LONGINT len; + Texts_FontsFont fnt; + SHORTINT col, voff; + BOOLEAN ascii; + LONGINT W, H; + Texts_Handler handle; + Texts_Text base; + } Texts_ElemDesc; + +struct Texts__1 { /* Texts_ElemDesc */ + Texts_Run prev, next; + LONGINT len; + Texts_FontsFont fnt; + SHORTINT col, voff; + BOOLEAN ascii; + LONGINT W, H; + Texts_Handler handle; + Texts_Text base; + Files_File file; + LONGINT org, span; + CHAR mod[32], proc[32]; +}; + +typedef + struct Texts__1 *Texts_Alien; + +typedef + struct Texts_BufDesc { + LONGINT len; + Texts_Run head; + } Texts_BufDesc; + +typedef + Texts_BufDesc *Texts_Buffer; + +typedef + struct Texts_CopyMsg { /* Texts_ElemMsg */ + Texts_Elem e; + } Texts_CopyMsg; + +typedef + struct Texts_FileMsg { /* Texts_ElemMsg */ + INTEGER id; + LONGINT pos; + Files_Rider r; + } Texts_FileMsg; + +typedef + struct Texts_FontDesc { + CHAR name[32]; + } Texts_FontDesc; + +typedef + struct Texts_IdentifyMsg { /* Texts_ElemMsg */ + CHAR mod[32], proc[32]; + } Texts_IdentifyMsg; + +typedef + void (*Texts_Notifier)(Texts_Text, INTEGER, LONGINT, LONGINT); + +typedef + struct Texts_PieceDesc *Texts_Piece; + +typedef + struct Texts_PieceDesc { + Texts_Run prev, next; + LONGINT len; + Texts_FontsFont fnt; + SHORTINT col, voff; + BOOLEAN ascii; + Files_File file; + LONGINT org; + } Texts_PieceDesc; + +typedef + struct Texts_Reader { + BOOLEAN eot; + Texts_FontsFont fnt; + SHORTINT col, voff; + Texts_Elem elem; + Files_Rider rider; + Texts_Run run; + LONGINT org, off; + } Texts_Reader; + +typedef + struct Texts_Scanner { /* Texts_Reader */ + BOOLEAN eot; + Texts_FontsFont fnt; + SHORTINT col, voff; + Texts_Elem elem; + Files_Rider rider; + Texts_Run run; + LONGINT org, off; + CHAR nextCh; + INTEGER line, class; + LONGINT i; + REAL x; + LONGREAL y; + CHAR c; + SHORTINT len; + CHAR s[64]; + } Texts_Scanner; + +typedef + struct Texts_TextDesc { + LONGINT len; + Texts_Notifier notify; + Texts_Run head, cache; + LONGINT corg; + } Texts_TextDesc; + +typedef + struct Texts_Writer { + Texts_Buffer buf; + Texts_FontsFont fnt; + SHORTINT col, voff; + Files_Rider rider; + Files_File file; + } Texts_Writer; + + +export Texts_Elem Texts_new; +static Texts_Buffer Texts_del; +static Texts_FontsFont Texts_FontsDefault; + +export LONGINT *Texts_FontDesc__typ; +export LONGINT *Texts_RunDesc__typ; +export LONGINT *Texts_PieceDesc__typ; +export LONGINT *Texts_ElemMsg__typ; +export LONGINT *Texts_ElemDesc__typ; +export LONGINT *Texts_FileMsg__typ; +export LONGINT *Texts_CopyMsg__typ; +export LONGINT *Texts_IdentifyMsg__typ; +export LONGINT *Texts_BufDesc__typ; +export LONGINT *Texts_TextDesc__typ; +export LONGINT *Texts_Reader__typ; +export LONGINT *Texts_Scanner__typ; +export LONGINT *Texts_Writer__typ; +export LONGINT *Texts__1__typ; + +export void Texts_Append (Texts_Text T, Texts_Buffer B); +export void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff); +static Texts_Elem Texts_CloneElem (Texts_Elem e); +static Texts_Piece Texts_ClonePiece (Texts_Piece p); +export void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len); +export void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB); +export void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE); +export void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end); +export Texts_Text Texts_ElemBase (Texts_Elem E); +export LONGINT Texts_ElemPos (Texts_Elem E); +static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org, LONGINT *off); +static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len); +static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__typ); +export void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B); +export void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v); +export void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len); +export void Texts_OpenBuf (Texts_Buffer B); +export void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos); +export void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos); +export void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ); +export LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ); +export void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch); +export void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ); +export void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ); +export void Texts_Recall (Texts_Buffer *B); +export void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B); +export void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ); +export void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col); +export void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt); +export void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff); +static void Texts_Splice (Texts_Run un, Texts_Run v, Texts_Run w, Texts_Text base); +static void Texts_Split (LONGINT off, Texts_Run *u, Texts_Run *un); +export void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +export void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch); +export void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d); +export void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e); +export void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x); +export void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n); +export void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ); +export void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n); +export void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x); +export void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n); +export void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k); +export void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x); +export void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len); + + +static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len) +{ + Texts_FontsFont _o_result; + Texts_FontsFont F = NIL; + __NEW(F, Texts_FontDesc); + __COPY(name, F->name, ((LONGINT)(32))); + _o_result = F; + return _o_result; +} + +static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org, LONGINT *off) +{ + Texts_Run v = NIL; + LONGINT m; + if (*pos >= T->len) { + *pos = T->len; + *u = T->head; + *org = T->len; + *off = 0; + T->cache = T->head; + T->corg = 0; + } else { + v = T->cache->next; + m = *pos - T->corg; + if (*pos >= T->corg) { + while (m >= v->len) { + m -= v->len; + v = v->next; + } + } else { + while (m < 0) { + v = v->prev; + m += v->len; + } + } + *u = v; + *org = *pos - m; + *off = m; + T->cache = v->prev; + T->corg = *org; + } +} + +static void Texts_Split (LONGINT off, Texts_Run *u, Texts_Run *un) +{ + Texts_Piece p = NIL, U = NIL; + if (off == 0) { + *un = *u; + *u = (*un)->prev; + } else if (off >= (*u)->len) { + *un = (*u)->next; + } else { + __NEW(p, Texts_PieceDesc); + *un = (Texts_Run)p; + U = __GUARDP(*u, Texts_PieceDesc, 1); + __GUARDEQP(p, Texts_PieceDesc) = *U; + p->org += off; + p->len -= off; + U->len -= p->len; + p->ascii = (*u)->ascii; + p->prev = (Texts_Run)U; + p->next = U->next; + p->next->prev = (Texts_Run)p; + U->next = (Texts_Run)p; + } +} + +static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v) +{ + Texts_Piece p = NIL, q = NIL; + if ((((((((((__ISP(u, Texts_PieceDesc, 1) && __ISP(*v, Texts_PieceDesc, 1))) && __STRCMP(u->fnt->name, (*v)->fnt->name) == 0)) && u->col == (*v)->col)) && u->voff == (*v)->voff)) && __GUARDP(u, Texts_PieceDesc, 1)->ascii == __GUARDP(*v, Texts_PieceDesc, 1)->ascii)) { + p = __GUARDP(u, Texts_PieceDesc, 1); + q = __GUARDP(*v, Texts_PieceDesc, 1); + if ((p->file == q->file && p->org + p->len == q->org)) { + if (T->cache == u) { + T->corg += q->len; + } else if (T->cache == *v) { + T->cache = T->head; + T->corg = 0; + } + p->len += q->len; + *v = (*v)->next; + } + } +} + +static void Texts_Splice (Texts_Run un, Texts_Run v, Texts_Run w, Texts_Text base) +{ + Texts_Run u = NIL; + if (v != w->next) { + u = un->prev; + u->next = v; + v->prev = u; + un->prev = w; + w->next = un; + do { + if (__ISP(v, Texts_ElemDesc, 1)) { + __GUARDP(v, Texts_ElemDesc, 1)->base = base; + } + v = v->next; + } while (!(v == un)); + } +} + +static Texts_Piece Texts_ClonePiece (Texts_Piece p) +{ + Texts_Piece _o_result; + Texts_Piece q = NIL; + __NEW(q, Texts_PieceDesc); + __GUARDEQP(q, Texts_PieceDesc) = *p; + _o_result = q; + return _o_result; +} + +static Texts_Elem Texts_CloneElem (Texts_Elem e) +{ + Texts_Elem _o_result; + Texts_CopyMsg msg; + msg.e = NIL; + (*e->handle)(e, (void*)&msg, Texts_CopyMsg__typ); + _o_result = msg.e; + return _o_result; +} + +void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE) +{ + DE->len = SE->len; + DE->fnt = SE->fnt; + DE->col = SE->col; + DE->voff = SE->voff; + DE->W = SE->W; + DE->H = SE->H; + DE->handle = SE->handle; +} + +Texts_Text Texts_ElemBase (Texts_Elem E) +{ + Texts_Text _o_result; + _o_result = E->base; + return _o_result; +} + +LONGINT Texts_ElemPos (Texts_Elem E) +{ + LONGINT _o_result; + Texts_Run u = NIL; + LONGINT pos; + u = E->base->head->next; + pos = 0; + while (u != (void *) E) { + pos = pos + u->len; + u = u->next; + } + _o_result = pos; + return _o_result; +} + +static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__typ) +{ + Texts_Alien e = NIL; + Files_Rider r; + LONGINT i; + CHAR ch; + if (__ISP(E, Texts__1, 2)) { + if (__IS(msg__typ, Texts_CopyMsg, 1)) { + if (__IS(msg__typ, Texts_CopyMsg, 1)) { + Texts_CopyMsg *msg__ = (void*)msg; + __NEW(e, Texts__1); + Texts_CopyElem((void*)((Texts_Alien)E), (void*)e); + e->file = ((Texts_Alien)E)->file; + e->org = ((Texts_Alien)E)->org; + e->span = ((Texts_Alien)E)->span; + __COPY(((Texts_Alien)E)->mod, e->mod, ((LONGINT)(32))); + __COPY(((Texts_Alien)E)->proc, e->proc, ((LONGINT)(32))); + (*msg__).e = (Texts_Elem)e; + } else __WITHCHK; + } else if (__IS(msg__typ, Texts_IdentifyMsg, 1)) { + if (__IS(msg__typ, Texts_IdentifyMsg, 1)) { + Texts_IdentifyMsg *msg__ = (void*)msg; + __COPY(((Texts_Alien)E)->mod, (*msg__).mod, ((LONGINT)(32))); + __COPY(((Texts_Alien)E)->proc, (*msg__).proc, ((LONGINT)(32))); + (*msg__).mod[31] = 0x01; + } else __WITHCHK; + } else if (__IS(msg__typ, Texts_FileMsg, 1)) { + if (__IS(msg__typ, Texts_FileMsg, 1)) { + Texts_FileMsg *msg__ = (void*)msg; + if ((*msg__).id == 1) { + Files_Set(&r, Files_Rider__typ, ((Texts_Alien)E)->file, ((Texts_Alien)E)->org); + i = ((Texts_Alien)E)->span; + while (i > 0) { + Files_Read(&r, Files_Rider__typ, (void*)&ch); + Files_Write(&(*msg__).r, Files_Rider__typ, ch); + i -= 1; + } + } + } else __WITHCHK; + } + } else __WITHCHK; +} + +void Texts_OpenBuf (Texts_Buffer B) +{ + Texts_Run u = NIL; + __NEW(u, Texts_RunDesc); + u->next = u; + u->prev = u; + B->head = u; + B->len = 0; +} + +void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB) +{ + Texts_Run u = NIL, v = NIL, vn = NIL; + u = SB->head->next; + v = DB->head->prev; + while (u != SB->head) { + if (__ISP(u, Texts_PieceDesc, 1)) { + vn = (Texts_Run)Texts_ClonePiece(__GUARDP(u, Texts_PieceDesc, 1)); + } else { + vn = (Texts_Run)Texts_CloneElem(__GUARDP(u, Texts_ElemDesc, 1)); + } + v->next = vn; + vn->prev = v; + v = vn; + u = u->next; + } + v->next = DB->head; + DB->head->prev = v; + DB->len += SB->len; +} + +void Texts_Recall (Texts_Buffer *B) +{ + *B = Texts_del; + Texts_del = NIL; +} + +void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B) +{ + Texts_Run u = NIL, v = NIL, w = NIL, wn = NIL; + LONGINT uo, ud, vo, vd; + Texts_Find(T, &beg, &u, &uo, &ud); + Texts_Find(T, &end, &v, &vo, &vd); + w = B->head->prev; + while (u != v) { + if (__ISP(u, Texts_PieceDesc, 1)) { + wn = (Texts_Run)Texts_ClonePiece(__GUARDP(u, Texts_PieceDesc, 1)); + wn->len -= ud; + __GUARDP(wn, Texts_PieceDesc, 1)->org += ud; + } else { + wn = (Texts_Run)Texts_CloneElem(__GUARDP(u, Texts_ElemDesc, 1)); + } + w->next = wn; + wn->prev = w; + w = wn; + u = u->next; + ud = 0; + } + if (vd > 0) { + wn = (Texts_Run)Texts_ClonePiece(__GUARDP(v, Texts_PieceDesc, 1)); + wn->len = vd - ud; + __GUARDP(wn, Texts_PieceDesc, 1)->org += ud; + w->next = wn; + wn->prev = w; + w = wn; + } + w->next = B->head; + B->head->prev = w; + B->len += end - beg; +} + +void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B) +{ + Texts_Run u = NIL, un = NIL, v = NIL; + Texts_Piece p = NIL, q = NIL; + LONGINT uo, ud, len; + Texts_Find(T, &pos, &u, &uo, &ud); + Texts_Split(ud, &u, &un); + len = B->len; + v = B->head->next; + Texts_Merge(T, u, &v); + Texts_Splice(un, v, B->head->prev, T); + T->len += len; + B->head->next = B->head; + B->head->prev = B->head; + B->len = 0; + if (T->notify != NIL) { + (*T->notify)(T, 1, pos, pos + len); + } +} + +void Texts_Append (Texts_Text T, Texts_Buffer B) +{ + Texts_Run v = NIL; + LONGINT pos, len; + pos = T->len; + len = B->len; + v = B->head->next; + Texts_Merge(T, T->head->prev, &v); + Texts_Splice(T->head, v, B->head->prev, T); + T->len += len; + B->head->next = B->head; + B->head->prev = B->head; + B->len = 0; + if (T->notify != NIL) { + (*T->notify)(T, 1, pos, pos + len); + } +} + +void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end) +{ + Texts_Run c = NIL, u = NIL, un = NIL, v = NIL, vn = NIL; + LONGINT co, uo, ud, vo, vd; + Texts_Find(T, &beg, &u, &uo, &ud); + Texts_Split(ud, &u, &un); + c = T->cache; + co = T->corg; + Texts_Find(T, &end, &v, &vo, &vd); + Texts_Split(vd, &v, &vn); + T->cache = c; + T->corg = co; + __NEW(Texts_del, Texts_BufDesc); + Texts_OpenBuf(Texts_del); + Texts_del->len = end - beg; + Texts_Splice(Texts_del->head, un, v, NIL); + Texts_Merge(T, u, &vn); + u->next = vn; + vn->prev = u; + T->len -= end - beg; + if (T->notify != NIL) { + (*T->notify)(T, 2, beg, end); + } +} + +void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff) +{ + Texts_Run c = NIL, u = NIL, un = NIL, v = NIL, vn = NIL; + LONGINT co, uo, ud, vo, vd; + Texts_Find(T, &beg, &u, &uo, &ud); + Texts_Split(ud, &u, &un); + c = T->cache; + co = T->corg; + Texts_Find(T, &end, &v, &vo, &vd); + Texts_Split(vd, &v, &vn); + T->cache = c; + T->corg = co; + while (un != vn) { + if ((__IN(0, sel) && fnt != NIL)) { + un->fnt = fnt; + } + if (__IN(1, sel)) { + un->col = col; + } + if (__IN(2, sel)) { + un->voff = voff; + } + Texts_Merge(T, u, &un); + if (u->next == un) { + u = un; + un = un->next; + } else { + u->next = un; + un->prev = u; + } + } + Texts_Merge(T, u, &un); + u->next = un; + un->prev = u; + if (T->notify != NIL) { + (*T->notify)(T, 0, beg, end); + } +} + +void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos) +{ + Texts_Run u = NIL; + if (pos >= T->len) { + pos = T->len; + } + Texts_Find(T, &pos, &u, &(*R).org, &(*R).off); + (*R).run = u; + (*R).eot = 0; + if (__ISP(u, Texts_PieceDesc, 1)) { + Files_Set(&(*R).rider, Files_Rider__typ, __GUARDP(u, Texts_PieceDesc, 1)->file, __GUARDP(u, Texts_PieceDesc, 1)->org + (*R).off); + } +} + +void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch) +{ + Texts_Run u = NIL; + LONGINT pos; + CHAR nextch; + u = (*R).run; + (*R).fnt = u->fnt; + (*R).col = u->col; + (*R).voff = u->voff; + (*R).off += 1; + if (__ISP(u, Texts_PieceDesc, 1)) { + Files_Read(&(*R).rider, Files_Rider__typ, (void*)&*ch); + (*R).elem = NIL; + if ((*ch == 0x0a && __GUARDP(u, Texts_PieceDesc, 1)->ascii)) { + *ch = 0x0d; + } else if ((*ch == 0x0d && __GUARDP(u, Texts_PieceDesc, 1)->ascii)) { + pos = Files_Pos(&(*R).rider, Files_Rider__typ); + Files_Read(&(*R).rider, Files_Rider__typ, (void*)&nextch); + if (nextch == 0x0a) { + (*R).off += 1; + } else { + Files_Set(&(*R).rider, Files_Rider__typ, __GUARDP(u, Texts_PieceDesc, 1)->file, pos); + } + } + } else if (__ISP(u, Texts_ElemDesc, 1)) { + *ch = 0x1c; + (*R).elem = __GUARDP(u, Texts_ElemDesc, 1); + } else { + *ch = 0x00; + (*R).elem = NIL; + (*R).eot = 1; + } + if ((*R).off == u->len) { + (*R).org += u->len; + u = u->next; + if (__ISP(u, Texts_PieceDesc, 1)) { + if (__ISP(u, Texts_PieceDesc, 1)) { + Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org); + } else __WITHCHK; + } + (*R).run = u; + (*R).off = 0; + } +} + +void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ) +{ + Texts_Run u = NIL, un = NIL; + u = (*R).run; + while (__ISP(u, Texts_PieceDesc, 1)) { + (*R).org += u->len; + u = u->next; + } + if (__ISP(u, Texts_ElemDesc, 1)) { + un = u->next; + (*R).run = un; + (*R).org += 1; + (*R).off = 0; + (*R).fnt = u->fnt; + (*R).col = u->col; + (*R).voff = u->voff; + (*R).elem = __GUARDP(u, Texts_ElemDesc, 1); + if (__ISP(un, Texts_PieceDesc, 1)) { + if (__ISP(un, Texts_PieceDesc, 1)) { + Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)un)->file, ((Texts_Piece)un)->org); + } else __WITHCHK; + } + } else { + (*R).eot = 1; + (*R).elem = NIL; + } +} + +void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ) +{ + Texts_Run u = NIL; + u = (*R).run->prev; + while (__ISP(u, Texts_PieceDesc, 1)) { + (*R).org -= u->len; + u = u->prev; + } + if (__ISP(u, Texts_ElemDesc, 1)) { + (*R).run = u; + (*R).org -= 1; + (*R).off = 0; + (*R).fnt = u->fnt; + (*R).col = u->col; + (*R).voff = u->voff; + (*R).elem = __GUARDP(u, Texts_ElemDesc, 1); + } else { + (*R).eot = 1; + (*R).elem = NIL; + } +} + +LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ) +{ + LONGINT _o_result; + _o_result = (*R).org + (*R).off; + return _o_result; +} + +void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos) +{ + Texts_OpenReader((void*)&*S, S__typ, T, pos); + (*S).line = 0; + (*S).nextCh = ' '; +} + +static struct Scan__31 { + Texts_Scanner *S; + LONGINT *S__typ; + CHAR *ch; + BOOLEAN *negE; + INTEGER *e; + struct Scan__31 *lnk; +} *Scan__31_s; + +static void ReadScaleFactor__32 (void); + +static void ReadScaleFactor__32 (void) +{ + Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch); + if (*Scan__31_s->ch == '-') { + *Scan__31_s->negE = 1; + Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch); + } else { + *Scan__31_s->negE = 0; + if (*Scan__31_s->ch == '+') { + Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch); + } + } + while (('0' <= *Scan__31_s->ch && *Scan__31_s->ch <= '9')) { + *Scan__31_s->e = (*Scan__31_s->e * 10 + (int)*Scan__31_s->ch) - 48; + Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch); + } +} + +void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ) +{ + CHAR ch, term; + BOOLEAN neg, negE, hex; + SHORTINT i, j, h; + INTEGER e; + LONGINT k; + REAL x, f; + LONGREAL y, g; + CHAR d[32]; + struct Scan__31 _s; + _s.S = S; _s.S__typ = S__typ; + _s.ch = &ch; + _s.negE = &negE; + _s.e = &e; + _s.lnk = Scan__31_s; + Scan__31_s = &_s; + ch = (*S).nextCh; + i = 0; + for (;;) { + if (ch == 0x0d) { + (*S).line += 1; + } else if ((ch != ' ' && ch != 0x09)) { + break; + } + Texts_Read((void*)&*S, S__typ, &ch); + } + if ((('A' <= __CAP(ch) && __CAP(ch) <= 'Z') || ch == '/') || ch == '.') { + do { + (*S).s[__X(i, ((LONGINT)(64)))] = ch; + i += 1; + Texts_Read((void*)&*S, S__typ, &ch); + } while (!((((__CAP(ch) > 'Z' && ch != '_') || ('A' > __CAP(ch) && ch > '9')) || ((('0' > ch && ch != '.')) && ch != '/')) || i == 63)); + (*S).s[__X(i, ((LONGINT)(64)))] = 0x00; + (*S).len = i; + (*S).class = 1; + } else if (ch == '\"') { + Texts_Read((void*)&*S, S__typ, &ch); + while ((((ch != '\"' && ch >= ' ')) && i != 63)) { + (*S).s[__X(i, ((LONGINT)(64)))] = ch; + i += 1; + Texts_Read((void*)&*S, S__typ, &ch); + } + (*S).s[__X(i, ((LONGINT)(64)))] = 0x00; + (*S).len = i + 1; + Texts_Read((void*)&*S, S__typ, &ch); + (*S).class = 2; + } else { + if (ch == '-') { + neg = 1; + Texts_Read((void*)&*S, S__typ, &ch); + } else { + neg = 0; + } + if (('0' <= ch && ch <= '9')) { + hex = 0; + j = 0; + for (;;) { + d[__X(i, ((LONGINT)(32)))] = ch; + i += 1; + Texts_Read((void*)&*S, S__typ, &ch); + if (ch < '0') { + break; + } + if ('9' < ch) { + if (('A' <= ch && ch <= 'F')) { + hex = 1; + ch = (CHAR)((int)ch - 7); + } else if (('a' <= ch && ch <= 'f')) { + hex = 1; + ch = (CHAR)((int)ch - 39); + } else { + break; + } + } + } + if (ch == 'H') { + Texts_Read((void*)&*S, S__typ, &ch); + (*S).class = 3; + if (i - j > 8) { + j = i - 8; + } + k = (int)d[__X(j, ((LONGINT)(32)))] - 48; + j += 1; + if ((i - j == 7 && k >= 8)) { + k -= 16; + } + while (j < i) { + k = __ASHL(k, 4) + (LONGINT)((int)d[__X(j, ((LONGINT)(32)))] - 48); + j += 1; + } + if (neg) { + (*S).i = -k; + } else { + (*S).i = k; + } + } else if (ch == '.') { + Texts_Read((void*)&*S, S__typ, &ch); + h = i; + while (('0' <= ch && ch <= '9')) { + d[__X(i, ((LONGINT)(32)))] = ch; + i += 1; + Texts_Read((void*)&*S, S__typ, &ch); + } + if (ch == 'D') { + e = 0; + y = (LONGREAL)0; + g = (LONGREAL)1; + do { + y = y * (LONGREAL)10 + ((int)d[__X(j, ((LONGINT)(32)))] - 48); + j += 1; + } while (!(j == h)); + while (j < i) { + g = g / (LONGREAL)(LONGREAL)10; + y = ((int)d[__X(j, ((LONGINT)(32)))] - 48) * g + y; + j += 1; + } + ReadScaleFactor__32(); + if (negE) { + if (e <= 308) { + y = y / (LONGREAL)Reals_TenL(e); + } else { + y = (LONGREAL)0; + } + } else if (e > 0) { + if (e <= 308) { + y = Reals_TenL(e) * y; + } else { + __HALT(40); + } + } + if (neg) { + y = -y; + } + (*S).class = 5; + (*S).y = y; + } else { + e = 0; + x = (REAL)0; + f = (REAL)1; + do { + x = x * (REAL)10 + ((int)d[__X(j, ((LONGINT)(32)))] - 48); + j += 1; + } while (!(j == h)); + while (j < i) { + f = f / (REAL)(REAL)10; + x = ((int)d[__X(j, ((LONGINT)(32)))] - 48) * f + x; + j += 1; + } + if (ch == 'E') { + ReadScaleFactor__32(); + } + if (negE) { + if (e <= 38) { + x = x / (REAL)Reals_Ten(e); + } else { + x = (REAL)0; + } + } else if (e > 0) { + if (e <= 38) { + x = Reals_Ten(e) * x; + } else { + __HALT(40); + } + } + if (neg) { + x = -x; + } + (*S).class = 4; + (*S).x = x; + } + if (hex) { + (*S).class = 0; + } + } else { + (*S).class = 3; + k = 0; + do { + k = k * 10 + (LONGINT)((int)d[__X(j, ((LONGINT)(32)))] - 48); + j += 1; + } while (!(j == i)); + if (neg) { + (*S).i = -k; + } else { + (*S).i = k; + } + if (hex) { + (*S).class = 0; + } else { + (*S).class = 3; + } + } + } else { + (*S).class = 6; + if (neg) { + (*S).c = '-'; + } else { + (*S).c = ch; + Texts_Read((void*)&*S, S__typ, &ch); + } + } + } + (*S).nextCh = ch; + Scan__31_s = _s.lnk; +} + +void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ) +{ + __NEW((*W).buf, Texts_BufDesc); + Texts_OpenBuf((*W).buf); + (*W).fnt = Texts_FontsDefault; + (*W).col = 15; + (*W).voff = 0; + (*W).file = Files_New((CHAR*)"", (LONGINT)1); + Files_Set(&(*W).rider, Files_Rider__typ, (*W).file, ((LONGINT)(0))); +} + +void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt) +{ + (*W).fnt = fnt; +} + +void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col) +{ + (*W).col = col; +} + +void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff) +{ + (*W).voff = voff; +} + +void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch) +{ + Texts_Run u = NIL, un = NIL; + Texts_Piece p = NIL; + Files_Write(&(*W).rider, Files_Rider__typ, ch); + (*W).buf->len += 1; + un = (*W).buf->head; + u = un->prev; + if ((((((((((__ISP(u, Texts_PieceDesc, 1) && __GUARDP(u, Texts_PieceDesc, 1)->file == (*W).file)) && __STRCMP(u->fnt->name, (*W).fnt->name) == 0)) && u->col == (*W).col)) && u->voff == (*W).voff)) && !__GUARDP(u, Texts_PieceDesc, 1)->ascii)) { + u->len += 1; + } else { + __NEW(p, Texts_PieceDesc); + u->next = (Texts_Run)p; + p->prev = u; + p->next = un; + un->prev = (Texts_Run)p; + p->len = 1; + p->fnt = (*W).fnt; + p->col = (*W).col; + p->voff = (*W).voff; + p->file = (*W).file; + p->org = Files_Length((*W).file) - 1; + p->ascii = 0; + } +} + +void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e) +{ + Texts_Run u = NIL, un = NIL; + if (e->base != NIL) { + __HALT(99); + } + (*W).buf->len += 1; + e->len = 1; + e->fnt = (*W).fnt; + e->col = (*W).col; + e->voff = (*W).voff; + un = (*W).buf->head; + u = un->prev; + u->next = (Texts_Run)e; + e->prev = u; + e->next = un; + un->prev = (Texts_Run)e; +} + +void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ) +{ + Texts_Write(&*W, W__typ, 0x0d); +} + +void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len) +{ + INTEGER i; + __DUP(s, s__len, CHAR); + i = 0; + while (s[__X(i, s__len)] >= ' ') { + Texts_Write(&*W, W__typ, s[__X(i, s__len)]); + i += 1; + } + __DEL(s); +} + +void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n) +{ + INTEGER i; + LONGINT x0; + CHAR a[22]; + i = 0; + if (x < 0) { + if (x == (-9223372036854775807-1)) { + Texts_WriteString(&*W, W__typ, (CHAR*)" -9223372036854775808", (LONGINT)22); + return; + } else { + n -= 1; + x0 = -x; + } + } else { + x0 = x; + } + do { + a[__X(i, ((LONGINT)(22)))] = (CHAR)(__MOD(x0, 10) + 48); + x0 = __DIV(x0, 10); + i += 1; + } while (!(x0 == 0)); + while (n > (LONGINT)i) { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } + if (x < 0) { + Texts_Write(&*W, W__typ, '-'); + } + do { + i -= 1; + Texts_Write(&*W, W__typ, a[__X(i, ((LONGINT)(22)))]); + } while (!(i == 0)); +} + +void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x) +{ + INTEGER i; + LONGINT y; + CHAR a[20]; + i = 0; + Texts_Write(&*W, W__typ, ' '); + do { + y = __MASK(x, -16); + if (y < 10) { + a[__X(i, ((LONGINT)(20)))] = (CHAR)(y + 48); + } else { + a[__X(i, ((LONGINT)(20)))] = (CHAR)(y + 55); + } + x = __ASHR(x, 4); + i += 1; + } while (!(i == 8)); + do { + i -= 1; + Texts_Write(&*W, W__typ, a[__X(i, ((LONGINT)(20)))]); + } while (!(i == 0)); +} + +void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n) +{ + INTEGER e; + REAL x0; + CHAR d[9]; + e = Reals_Expo(x); + if (e == 0) { + Texts_WriteString(&*W, W__typ, (CHAR*)" 0", (LONGINT)4); + do { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } while (!(n <= 3)); + } else if (e == 255) { + Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5); + while (n > 4) { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } + } else { + if (n <= 9) { + n = 3; + } else { + n -= 6; + } + do { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } while (!(n <= 8)); + if (x < (REAL)0) { + Texts_Write(&*W, W__typ, '-'); + x = -x; + } else { + Texts_Write(&*W, W__typ, ' '); + } + e = __ASHR((e - 127) * 77, 8); + if (e >= 0) { + x = x / (REAL)Reals_Ten(e); + } else { + x = Reals_Ten(-e) * x; + } + if (x >= (REAL)10) { + x = 1.0000000e-001 * x; + e += 1; + } + x0 = Reals_Ten(n - 1); + x = x0 * x + 5.0000000e-001; + if (x >= (REAL)10 * x0) { + x = x * 1.0000000e-001; + e += 1; + } + Reals_Convert(x, n, (void*)d, ((LONGINT)(9))); + n -= 1; + Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(9)))]); + Texts_Write(&*W, W__typ, '.'); + do { + n -= 1; + Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(9)))]); + } while (!(n == 0)); + Texts_Write(&*W, W__typ, 'E'); + if (e < 0) { + Texts_Write(&*W, W__typ, '-'); + e = -e; + } else { + Texts_Write(&*W, W__typ, '+'); + } + Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48)); + Texts_Write(&*W, W__typ, (CHAR)((int)__MOD(e, 10) + 48)); + } +} + +static struct WriteRealFix__53 { + Texts_Writer *W; + LONGINT *W__typ; + INTEGER *i; + CHAR (*d)[9]; + struct WriteRealFix__53 *lnk; +} *WriteRealFix__53_s; + +static void dig__54 (INTEGER n); +static void seq__56 (CHAR ch, INTEGER n); + +static void seq__56 (CHAR ch, INTEGER n) +{ + while (n > 0) { + Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, ch); + n -= 1; + } +} + +static void dig__54 (INTEGER n) +{ + while (n > 0) { + *WriteRealFix__53_s->i -= 1; + Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, (*WriteRealFix__53_s->d)[__X(*WriteRealFix__53_s->i, ((LONGINT)(9)))]); + n -= 1; + } +} + +void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k) +{ + INTEGER e, i; + CHAR sign; + REAL x0; + CHAR d[9]; + struct WriteRealFix__53 _s; + _s.W = W; _s.W__typ = W__typ; + _s.i = &i; + _s.d = (void*)d; + _s.lnk = WriteRealFix__53_s; + WriteRealFix__53_s = &_s; + e = Reals_Expo(x); + if (k < 0) { + k = 0; + } + if (e == 0) { + seq__56(' ', (n - k) - 2); + Texts_Write(&*W, W__typ, '0'); + seq__56(' ', k + 1); + } else if (e == 255) { + Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5); + seq__56(' ', n - 4); + } else { + e = __ASHR((e - 127) * 77, 8); + if (x < (REAL)0) { + sign = '-'; + x = -x; + } else { + sign = ' '; + } + if (e >= 0) { + x = x / (REAL)Reals_Ten(e); + } else { + x = Reals_Ten(-e) * x; + } + if (x >= (REAL)10) { + x = 1.0000000e-001 * x; + e += 1; + } + if (k + e >= 8) { + k = 8 - e; + } else if (k + e < 0) { + k = -e; + x = (REAL)0; + } + x0 = Reals_Ten(k + e); + x = x0 * x + 5.0000000e-001; + if (x >= (REAL)10 * x0) { + e += 1; + } + e += 1; + i = k + e; + Reals_Convert(x, i, (void*)d, ((LONGINT)(9))); + if (e > 0) { + seq__56(' ', ((n - e) - k) - 2); + Texts_Write(&*W, W__typ, sign); + dig__54(e); + Texts_Write(&*W, W__typ, '.'); + dig__54(k); + } else { + seq__56(' ', (n - k) - 3); + Texts_Write(&*W, W__typ, sign); + Texts_Write(&*W, W__typ, '0'); + Texts_Write(&*W, W__typ, '.'); + seq__56('0', -e); + dig__54(k + e); + } + } + WriteRealFix__53_s = _s.lnk; +} + +void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x) +{ + INTEGER i; + CHAR d[8]; + Reals_ConvertH(x, (void*)d, ((LONGINT)(8))); + i = 0; + do { + Texts_Write(&*W, W__typ, d[__X(i, ((LONGINT)(8)))]); + i += 1; + } while (!(i == 8)); +} + +void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n) +{ + INTEGER e; + LONGREAL x0; + CHAR d[16]; + e = Reals_ExpoL(x); + if (e == 0) { + Texts_WriteString(&*W, W__typ, (CHAR*)" 0", (LONGINT)4); + do { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } while (!(n <= 3)); + } else if (e == 2047) { + Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5); + while (n > 4) { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } + } else { + if (n <= 10) { + n = 3; + } else { + n -= 7; + } + do { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } while (!(n <= 16)); + if (x < (LONGREAL)0) { + Texts_Write(&*W, W__typ, '-'); + x = -x; + } else { + Texts_Write(&*W, W__typ, ' '); + } + e = (int)__ASHR((LONGINT)(e - 1023) * 77, 8); + if (e >= 0) { + x = x / (LONGREAL)Reals_TenL(e); + } else { + x = Reals_TenL(-e) * x; + } + if (x >= (LONGREAL)10) { + x = 1.00000000000000e-001 * x; + e += 1; + } + x0 = Reals_TenL(n - 1); + x = x0 * x + 5.00000000000000e-001; + if (x >= (LONGREAL)10 * x0) { + x = 1.00000000000000e-001 * x; + e += 1; + } + Reals_ConvertL(x, n, (void*)d, ((LONGINT)(16))); + n -= 1; + Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(16)))]); + Texts_Write(&*W, W__typ, '.'); + do { + n -= 1; + Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(16)))]); + } while (!(n == 0)); + Texts_Write(&*W, W__typ, 'D'); + if (e < 0) { + Texts_Write(&*W, W__typ, '-'); + e = -e; + } else { + Texts_Write(&*W, W__typ, '+'); + } + Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 100) + 48)); + e = (int)__MOD(e, 100); + Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48)); + Texts_Write(&*W, W__typ, (CHAR)((int)__MOD(e, 10) + 48)); + } +} + +void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x) +{ + INTEGER i; + CHAR d[16]; + Reals_ConvertHL(x, (void*)d, ((LONGINT)(16))); + i = 0; + do { + Texts_Write(&*W, W__typ, d[__X(i, ((LONGINT)(16)))]); + i += 1; + } while (!(i == 16)); +} + +static struct WriteDate__43 { + Texts_Writer *W; + LONGINT *W__typ; + struct WriteDate__43 *lnk; +} *WriteDate__43_s; + +static void WritePair__44 (CHAR ch, LONGINT x); + +static void WritePair__44 (CHAR ch, LONGINT x) +{ + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, ch); + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__DIV(x, 10) + 48)); + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__MOD(x, 10) + 48)); +} + +void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d) +{ + struct WriteDate__43 _s; + _s.W = W; _s.W__typ = W__typ; + _s.lnk = WriteDate__43_s; + WriteDate__43_s = &_s; + WritePair__44(' ', __MASK(d, -32)); + WritePair__44('.', __MASK(__ASHR(d, 5), -16)); + WritePair__44('.', __MASK(__ASHR(d, 9), -128)); + WritePair__44(' ', __MASK(__ASHR(t, 12), -32)); + WritePair__44(':', __MASK(__ASHR(t, 6), -64)); + WritePair__44(':', __MASK(t, -64)); + WriteDate__43_s = _s.lnk; +} + +static struct Load0__16 { + Texts_Text *T; + SHORTINT *ecnt; + Files_File *f; + Texts_FileMsg *msg; + CHAR (*mods)[64][32], (*procs)[64][32]; + struct Load0__16 *lnk; +} *Load0__16_s; + +static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT span, Texts_Elem *e); + +static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT span, Texts_Elem *e) +{ + Modules_Module M = NIL; + Modules_Command Cmd; + Texts_Alien a = NIL; + LONGINT org, ew, eh; + SHORTINT eno; + Texts_new = NIL; + Files_ReadLInt(&*r, r__typ, &ew); + Files_ReadLInt(&*r, r__typ, &eh); + Files_Read(&*r, r__typ, (void*)&eno); + if (eno > *Load0__16_s->ecnt) { + *Load0__16_s->ecnt = eno; + Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32))); + Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32))); + } + org = Files_Pos(&*r, r__typ); + M = Modules_ThisMod((*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32))); + if (M != NIL) { + Cmd = Modules_ThisCommand(M, (*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32))); + if (Cmd != NIL) { + (*Cmd)(); + } + } + *e = Texts_new; + if (*e != NIL) { + (*e)->W = ew; + (*e)->H = eh; + (*e)->base = *Load0__16_s->T; + (*Load0__16_s->msg).pos = pos; + (*(*e)->handle)(*e, (void*)&*Load0__16_s->msg, Texts_FileMsg__typ); + if (Files_Pos(&*r, r__typ) != org + span) { + *e = NIL; + } + } + if (*e == NIL) { + Files_Set(&*r, r__typ, *Load0__16_s->f, org + span); + __NEW(a, Texts__1); + a->W = ew; + a->H = eh; + a->handle = Texts_HandleAlien; + a->base = *Load0__16_s->T; + a->file = *Load0__16_s->f; + a->org = org; + a->span = span; + __COPY((*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], a->mod, ((LONGINT)(32))); + __COPY((*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], a->proc, ((LONGINT)(32))); + *e = (Texts_Elem)a; + } +} + +static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T) +{ + Texts_Run u = NIL, un = NIL; + Texts_Piece p = NIL; + Texts_Elem e = NIL; + LONGINT org, pos, hlen, plen; + SHORTINT ecnt, fno, fcnt, col, voff; + Files_File f = NIL; + Texts_FileMsg msg; + CHAR mods[64][32], procs[64][32]; + CHAR name[32]; + Texts_FontsFont fnts[32]; + struct Load0__16 _s; + _s.T = &T; + _s.ecnt = &ecnt; + _s.f = &f; + _s.msg = &msg; + _s.mods = (void*)mods; + _s.procs = (void*)procs; + _s.lnk = Load0__16_s; + Load0__16_s = &_s; + pos = Files_Pos(&*r, r__typ); + f = Files_Base(&*r, r__typ); + __NEW(u, Texts_RunDesc); + u->len = 9223372036854775807; + u->fnt = NIL; + u->col = 15; + T->head = u; + ecnt = 0; + fcnt = 0; + msg.id = 0; + msg.r = *r; + Files_ReadLInt(&msg.r, Files_Rider__typ, &hlen); + org = (pos - 2) + hlen; + pos = org; + Files_Read(&msg.r, Files_Rider__typ, (void*)&fno); + while (fno != 0) { + if (fno > fcnt) { + fcnt = fno; + Files_ReadString(&msg.r, Files_Rider__typ, (void*)name, ((LONGINT)(32))); + fnts[__X(fno, ((LONGINT)(32)))] = Texts_FontsThis((void*)name, ((LONGINT)(32))); + } + Files_Read(&msg.r, Files_Rider__typ, (void*)&col); + Files_Read(&msg.r, Files_Rider__typ, (void*)&voff); + Files_ReadLInt(&msg.r, Files_Rider__typ, &plen); + if (plen > 0) { + __NEW(p, Texts_PieceDesc); + p->file = f; + p->org = pos; + p->ascii = 0; + un = (Texts_Run)p; + un->len = plen; + } else { + LoadElem__17(&msg.r, Files_Rider__typ, pos - org, -plen, &e); + un = (Texts_Run)e; + un->len = 1; + } + un->col = col; + un->voff = voff; + pos += un->len; + u->next = un; + un->prev = u; + u = un; + Files_Read(&msg.r, Files_Rider__typ, (void*)&fno); + } + u->next = T->head; + T->head->prev = u; + T->cache = T->head; + T->corg = 0; + Files_ReadLInt(&msg.r, Files_Rider__typ, &T->len); + Files_Set(&*r, r__typ, f, Files_Pos(&msg.r, Files_Rider__typ) + T->len); + Load0__16_s = _s.lnk; +} + +void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T) +{ + INTEGER tag; + Files_ReadInt(&*r, r__typ, &tag); + if (tag != -4095) { + Files_Set(&*r, r__typ, Files_Base(&*r, r__typ), Files_Pos(&*r, r__typ) - 2); + } + Texts_Load0(&*r, r__typ, T); +} + +void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len) +{ + Files_File f = NIL; + Files_Rider r; + Texts_Run u = NIL; + Texts_Piece p = NIL; + CHAR tag, version; + LONGINT hlen; + __DUP(name, name__len, CHAR); + f = Files_Old(name, name__len); + if (f == NIL) { + f = Files_New((CHAR*)"", (LONGINT)1); + } + Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(0))); + Files_Read(&r, Files_Rider__typ, (void*)&tag); + Files_Read(&r, Files_Rider__typ, (void*)&version); + if (tag == 0xf0 || (tag == 0x01 && version == 0xf0)) { + Texts_Load0(&r, Files_Rider__typ, T); + } else { + __NEW(u, Texts_RunDesc); + u->len = 9223372036854775807; + u->fnt = NIL; + u->col = 15; + __NEW(p, Texts_PieceDesc); + if ((tag == 0xf7 && version == 0x07)) { + Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(28))); + Files_ReadLInt(&r, Files_Rider__typ, &hlen); + Files_Set(&r, Files_Rider__typ, f, 22 + hlen); + Files_ReadLInt(&r, Files_Rider__typ, &T->len); + p->org = 26 + hlen; + } else { + T->len = Files_Length(f); + p->org = 0; + } + if (T->len > 0) { + p->len = T->len; + p->fnt = Texts_FontsDefault; + p->col = 15; + p->voff = 0; + p->file = f; + p->ascii = 1; + u->next = (Texts_Run)p; + u->prev = (Texts_Run)p; + p->next = u; + p->prev = u; + } else { + u->next = u; + u->prev = u; + } + T->head = u; + T->cache = T->head; + T->corg = 0; + } + __DEL(name); +} + +static struct Store__39 { + SHORTINT *ecnt; + Texts_FileMsg *msg; + Texts_IdentifyMsg *iden; + CHAR (*mods)[64][32], (*procs)[64][32]; + struct Store__39 *lnk; +} *Store__39_s; + +static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_Elem e); + +static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_Elem e) +{ + Files_Rider r1; + LONGINT org, span; + SHORTINT eno; + __COPY((*Store__39_s->iden).mod, (*Store__39_s->mods)[__X(*Store__39_s->ecnt, ((LONGINT)(64)))], ((LONGINT)(32))); + __COPY((*Store__39_s->iden).proc, (*Store__39_s->procs)[__X(*Store__39_s->ecnt, ((LONGINT)(64)))], ((LONGINT)(32))); + eno = 1; + while (__STRCMP((*Store__39_s->mods)[__X(eno, ((LONGINT)(64)))], (*Store__39_s->iden).mod) != 0 || __STRCMP((*Store__39_s->procs)[__X(eno, ((LONGINT)(64)))], (*Store__39_s->iden).proc) != 0) { + eno += 1; + } + Files_Set(&r1, Files_Rider__typ, Files_Base(&*r, r__typ), Files_Pos(&*r, r__typ)); + Files_WriteLInt(&*r, r__typ, ((LONGINT)(0))); + Files_WriteLInt(&*r, r__typ, ((LONGINT)(0))); + Files_WriteLInt(&*r, r__typ, ((LONGINT)(0))); + Files_Write(&*r, r__typ, eno); + if (eno == *Store__39_s->ecnt) { + *Store__39_s->ecnt += 1; + Files_WriteString(&*r, r__typ, (*Store__39_s->iden).mod, ((LONGINT)(32))); + Files_WriteString(&*r, r__typ, (*Store__39_s->iden).proc, ((LONGINT)(32))); + } + (*Store__39_s->msg).pos = pos; + org = Files_Pos(&*r, r__typ); + (*e->handle)(e, (void*)&*Store__39_s->msg, Texts_FileMsg__typ); + span = Files_Pos(&*r, r__typ) - org; + Files_WriteLInt(&r1, Files_Rider__typ, -span); + Files_WriteLInt(&r1, Files_Rider__typ, e->W); + Files_WriteLInt(&r1, Files_Rider__typ, e->H); +} + +void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T) +{ + Files_Rider r1; + Texts_Run u = NIL, un = NIL; + Texts_Elem e = NIL; + LONGINT org, pos, delta, hlen, rlen; + SHORTINT ecnt, fno, fcnt; + CHAR ch; + Texts_FileMsg msg; + Texts_IdentifyMsg iden; + CHAR mods[64][32], procs[64][32]; + Texts_FontsFont fnts[32]; + CHAR block[1024]; + struct Store__39 _s; + _s.ecnt = &ecnt; + _s.msg = &msg; + _s.iden = &iden; + _s.mods = (void*)mods; + _s.procs = (void*)procs; + _s.lnk = Store__39_s; + Store__39_s = &_s; + org = Files_Pos(&*r, r__typ); + msg.id = 1; + msg.r = *r; + Files_WriteLInt(&msg.r, Files_Rider__typ, ((LONGINT)(0))); + u = T->head->next; + pos = 0; + delta = 0; + fcnt = 1; + ecnt = 1; + while (u != T->head) { + if (__ISP(u, Texts_ElemDesc, 1)) { + iden.mod[0] = 0x00; + (*__GUARDP(u, Texts_ElemDesc, 1)->handle)(__GUARDP(u, Texts_ElemDesc, 1), (void*)&iden, Texts_IdentifyMsg__typ); + } else { + iden.mod[0] = 0x01; + } + if (iden.mod[0] != 0x00) { + fnts[__X(fcnt, ((LONGINT)(32)))] = u->fnt; + fno = 1; + while (__STRCMP(fnts[__X(fno, ((LONGINT)(32)))]->name, u->fnt->name) != 0) { + fno += 1; + } + Files_Write(&msg.r, Files_Rider__typ, fno); + if (fno == fcnt) { + fcnt += 1; + Files_WriteString(&msg.r, Files_Rider__typ, u->fnt->name, ((LONGINT)(32))); + } + Files_Write(&msg.r, Files_Rider__typ, u->col); + Files_Write(&msg.r, Files_Rider__typ, u->voff); + } + if (__ISP(u, Texts_PieceDesc, 1)) { + rlen = u->len; + un = u->next; + while ((((((__ISP(un, Texts_PieceDesc, 1) && un->fnt == u->fnt)) && un->col == u->col)) && un->voff == u->voff)) { + rlen += un->len; + un = un->next; + } + Files_WriteLInt(&msg.r, Files_Rider__typ, rlen); + pos += rlen; + u = un; + } else if (iden.mod[0] != 0x00) { + StoreElem__40(&msg.r, Files_Rider__typ, pos, __GUARDP(u, Texts_ElemDesc, 1)); + pos += 1; + u = u->next; + } else { + delta += 1; + u = u->next; + } + } + Files_Write(&msg.r, Files_Rider__typ, 0); + Files_WriteLInt(&msg.r, Files_Rider__typ, T->len - delta); + hlen = (Files_Pos(&msg.r, Files_Rider__typ) - org) + 2; + Files_Set(&r1, Files_Rider__typ, Files_Base(&msg.r, Files_Rider__typ), org); + Files_WriteLInt(&r1, Files_Rider__typ, hlen); + u = T->head->next; + while (u != T->head) { + if (__ISP(u, Texts_PieceDesc, 1)) { + if (__ISP(u, Texts_PieceDesc, 1)) { + if (((Texts_Piece)u)->ascii) { + Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org); + delta = ((Texts_Piece)u)->len; + while (delta > 0) { + Files_Read(&r1, Files_Rider__typ, (void*)&ch); + delta -= 1; + if (ch == 0x0a) { + Files_Write(&msg.r, Files_Rider__typ, 0x0d); + } else { + Files_Write(&msg.r, Files_Rider__typ, ch); + } + } + } else { + Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org); + delta = ((Texts_Piece)u)->len; + while (delta > 1024) { + Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), ((LONGINT)(1024))); + Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), ((LONGINT)(1024))); + delta -= 1024; + } + Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), delta); + Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), delta); + } + } else __WITHCHK; + } else { + iden.mod[0] = 0x00; + (*__GUARDP(u, Texts_ElemDesc, 1)->handle)(__GUARDP(u, Texts_ElemDesc, 1), (void*)&iden, Texts_IdentifyMsg__typ); + if (iden.mod[0] != 0x00) { + Files_Write(&msg.r, Files_Rider__typ, 0x1c); + } + } + u = u->next; + } + __GUARDEQR(r, r__typ, Files_Rider) = msg.r; + if (T->notify != NIL) { + (*T->notify)(T, 3, ((LONGINT)(0)), ((LONGINT)(0))); + } + Store__39_s = _s.lnk; +} + +void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len) +{ + Files_File f = NIL; + Files_Rider r; + INTEGER i, res; + CHAR bak[64]; + __DUP(name, name__len, CHAR); + f = Files_New(name, name__len); + Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(0))); + Files_Write(&r, Files_Rider__typ, 0xf0); + Files_Write(&r, Files_Rider__typ, 0x01); + Texts_Store(&r, Files_Rider__typ, T); + i = 0; + while (name[__X(i, name__len)] != 0x00) { + i += 1; + } + __COPY(name, bak, ((LONGINT)(64))); + bak[__X(i, ((LONGINT)(64)))] = '.'; + bak[__X(i + 1, ((LONGINT)(64)))] = 'B'; + bak[__X(i + 2, ((LONGINT)(64)))] = 'a'; + bak[__X(i + 3, ((LONGINT)(64)))] = 'k'; + bak[__X(i + 4, ((LONGINT)(64)))] = 0x00; + Files_Rename(name, name__len, bak, ((LONGINT)(64)), &res); + Files_Register(f); + __DEL(name); +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(Texts_new); + P(Texts_del); + P(Texts_FontsDefault); +} + +__TDESC(Texts_FontDesc, 1, 0) = {__TDFLDS("FontDesc", 32), {-8}}; +__TDESC(Texts_RunDesc, 1, 3) = {__TDFLDS("RunDesc", 40), {0, 8, 24, -32}}; +__TDESC(Texts_PieceDesc, 1, 4) = {__TDFLDS("PieceDesc", 56), {0, 8, 24, 40, -40}}; +__TDESC(Texts_ElemMsg, 1, 0) = {__TDFLDS("ElemMsg", 1), {-8}}; +__TDESC(Texts_ElemDesc, 1, 4) = {__TDFLDS("ElemDesc", 72), {0, 8, 24, 64, -40}}; +__TDESC(Texts_FileMsg, 1, 1) = {__TDFLDS("FileMsg", 56), {32, -16}}; +__TDESC(Texts_CopyMsg, 1, 1) = {__TDFLDS("CopyMsg", 8), {0, -16}}; +__TDESC(Texts_IdentifyMsg, 1, 0) = {__TDFLDS("IdentifyMsg", 64), {-8}}; +__TDESC(Texts_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 16), {8, -16}}; +__TDESC(Texts_TextDesc, 1, 2) = {__TDFLDS("TextDesc", 40), {16, 24, -24}}; +__TDESC(Texts_Reader, 1, 4) = {__TDFLDS("Reader", 96), {8, 24, 48, 72, -40}}; +__TDESC(Texts_Scanner, 1, 4) = {__TDFLDS("Scanner", 208), {8, 24, 48, 72, -40}}; +__TDESC(Texts_Writer, 1, 4) = {__TDFLDS("Writer", 72), {0, 8, 40, 64, -40}}; +__TDESC(Texts__1, 1, 5) = {__TDFLDS("", 160), {0, 8, 24, 64, 72, -48}}; + +export void *Texts__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Files); + __MODULE_IMPORT(Modules); + __MODULE_IMPORT(Reals); + __REGMOD("Texts", EnumPtrs); + __INITYP(Texts_FontDesc, Texts_FontDesc, 0); + __INITYP(Texts_RunDesc, Texts_RunDesc, 0); + __INITYP(Texts_PieceDesc, Texts_RunDesc, 1); + __INITYP(Texts_ElemMsg, Texts_ElemMsg, 0); + __INITYP(Texts_ElemDesc, Texts_RunDesc, 1); + __INITYP(Texts_FileMsg, Texts_ElemMsg, 1); + __INITYP(Texts_CopyMsg, Texts_ElemMsg, 1); + __INITYP(Texts_IdentifyMsg, Texts_ElemMsg, 1); + __INITYP(Texts_BufDesc, Texts_BufDesc, 0); + __INITYP(Texts_TextDesc, Texts_TextDesc, 0); + __INITYP(Texts_Reader, Texts_Reader, 0); + __INITYP(Texts_Scanner, Texts_Reader, 1); + __INITYP(Texts_Writer, Texts_Writer, 0); + __INITYP(Texts__1, Texts_ElemDesc, 2); +/* BEGIN */ + Texts_del = NIL; + __NEW(Texts_FontsDefault, Texts_FontDesc); + __MOVE("Syntax10.Scn.Fnt", Texts_FontsDefault->name, 17); + __ENDMOD; +} diff --git a/bootstrap/unix-88/Texts.h b/bootstrap/unix-88/Texts.h new file mode 100644 index 00000000..d1805878 --- /dev/null +++ b/bootstrap/unix-88/Texts.h @@ -0,0 +1,173 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Texts__h +#define Texts__h + +#define LARGE +#include "SYSTEM.h" +#include "Files.h" + +typedef + struct Texts_BufDesc { + LONGINT len; + char _prvt0[8]; + } Texts_BufDesc; + +typedef + Texts_BufDesc *Texts_Buffer; + +typedef + struct Texts_ElemMsg { + char _prvt0[1]; + } Texts_ElemMsg; + +typedef + struct Texts_ElemDesc *Texts_Elem; + +typedef + struct Texts_CopyMsg { /* Texts_ElemMsg */ + Texts_Elem e; + } Texts_CopyMsg; + +typedef + struct Texts_RunDesc { + LONGINT _prvt0; + char _prvt1[27]; + } Texts_RunDesc; + +typedef + void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, LONGINT *); + +typedef + struct Texts_ElemDesc { + char _prvt0[40]; + LONGINT W, H; + Texts_Handler handle; + char _prvt1[8]; + } Texts_ElemDesc; + +typedef + struct Texts_FileMsg { /* Texts_ElemMsg */ + INTEGER id; + LONGINT pos; + Files_Rider r; + } Texts_FileMsg; + +typedef + struct Texts_FontDesc { + char _prvt0[32]; + } Texts_FontDesc; + +typedef + Texts_FontDesc *Texts_FontsFont; + +typedef + struct Texts_IdentifyMsg { /* Texts_ElemMsg */ + CHAR mod[32], proc[32]; + } Texts_IdentifyMsg; + +typedef + struct Texts_TextDesc *Texts_Text; + +typedef + void (*Texts_Notifier)(Texts_Text, INTEGER, LONGINT, LONGINT); + +typedef + struct Texts_Reader { + BOOLEAN eot; + Texts_FontsFont fnt; + SHORTINT col, voff; + Texts_Elem elem; + char _prvt0[64]; + } Texts_Reader; + +typedef + struct Texts_Scanner { /* Texts_Reader */ + BOOLEAN eot; + Texts_FontsFont fnt; + SHORTINT col, voff; + Texts_Elem elem; + char _prvt0[64]; + CHAR nextCh; + INTEGER line, class; + LONGINT i; + REAL x; + LONGREAL y; + CHAR c; + SHORTINT len; + CHAR s[64]; + } Texts_Scanner; + +typedef + struct Texts_TextDesc { + LONGINT len; + Texts_Notifier notify; + char _prvt0[24]; + } Texts_TextDesc; + +typedef + struct Texts_Writer { + Texts_Buffer buf; + Texts_FontsFont fnt; + SHORTINT col, voff; + char _prvt0[54]; + } Texts_Writer; + + +import Texts_Elem Texts_new; + +import LONGINT *Texts_FontDesc__typ; +import LONGINT *Texts_RunDesc__typ; +import LONGINT *Texts_ElemMsg__typ; +import LONGINT *Texts_ElemDesc__typ; +import LONGINT *Texts_FileMsg__typ; +import LONGINT *Texts_CopyMsg__typ; +import LONGINT *Texts_IdentifyMsg__typ; +import LONGINT *Texts_BufDesc__typ; +import LONGINT *Texts_TextDesc__typ; +import LONGINT *Texts_Reader__typ; +import LONGINT *Texts_Scanner__typ; +import LONGINT *Texts_Writer__typ; + +import void Texts_Append (Texts_Text T, Texts_Buffer B); +import void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff); +import void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len); +import void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB); +import void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE); +import void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end); +import Texts_Text Texts_ElemBase (Texts_Elem E); +import LONGINT Texts_ElemPos (Texts_Elem E); +import void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B); +import void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +import void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len); +import void Texts_OpenBuf (Texts_Buffer B); +import void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos); +import void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos); +import void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ); +import LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ); +import void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch); +import void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ); +import void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ); +import void Texts_Recall (Texts_Buffer *B); +import void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B); +import void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ); +import void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col); +import void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt); +import void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff); +import void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +import void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch); +import void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d); +import void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e); +import void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x); +import void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n); +import void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ); +import void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n); +import void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x); +import void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n); +import void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k); +import void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x); +import void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len); +import void *Texts__init(void); + + +#endif diff --git a/bootstrap/unix-88/Vishap.c b/bootstrap/unix-88/Vishap.c new file mode 100644 index 00000000..d084e34a --- /dev/null +++ b/bootstrap/unix-88/Vishap.c @@ -0,0 +1,169 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkamSf */ +#define LARGE +#include "SYSTEM.h" +#include "Configuration.h" +#include "Heap.h" +#include "OPB.h" +#include "OPC.h" +#include "OPM.h" +#include "OPP.h" +#include "OPT.h" +#include "OPV.h" +#include "Platform.h" +#include "Strings.h" +#include "extTools.h" +#include "vt100.h" + + +static CHAR Vishap_mname[256]; + + +export void Vishap_Module (BOOLEAN *done); +static void Vishap_PropagateElementaryTypeSizes (void); +export void Vishap_Translate (void); +static void Vishap_Trap (INTEGER sig); + + +void Vishap_Module (BOOLEAN *done) +{ + BOOLEAN ext, new; + OPT_Node p = NIL; + OPP_Module(&p, OPM_opt); + if (OPM_noerr) { + OPV_Init(); + OPV_AdrAndSize(OPT_topScope); + OPT_Export(&ext, &new); + if (OPM_noerr) { + OPM_OpenFiles((void*)OPT_SelfName, ((LONGINT)(256))); + OPC_Init(); + OPV_Module(p); + if (OPM_noerr) { + if (((OPM_mainProg || OPM_mainLinkStat) && __STRCMP(OPM_modName, "SYSTEM") != 0)) { + OPM_DeleteNewSym(); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"32m", (LONGINT)4); + } + OPM_LogWStr((CHAR*)" Main program.", (LONGINT)16); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + } else { + if (new) { + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"32m", (LONGINT)4); + } + OPM_LogWStr((CHAR*)" New symbol file.", (LONGINT)19); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + OPM_RegisterNewSym(); + } else if (ext) { + OPM_LogWStr((CHAR*)" Extended symbol file.", (LONGINT)24); + OPM_RegisterNewSym(); + } + } + } else { + OPM_DeleteNewSym(); + } + } + } + OPM_CloseFiles(); + OPT_Close(); + OPM_LogWLn(); + *done = OPM_noerr; +} + +static void Vishap_PropagateElementaryTypeSizes (void) +{ + OPT_bytetyp->size = OPM_ByteSize; + OPT_sysptrtyp->size = OPM_PointerSize; + OPT_chartyp->size = OPM_CharSize; + OPT_settyp->size = OPM_SetSize; + OPT_realtyp->size = OPM_RealSize; + OPT_inttyp->size = OPM_IntSize; + OPT_linttyp->size = OPM_LIntSize; + OPT_lrltyp->size = OPM_LRealSize; + OPT_sinttyp->size = OPM_SIntSize; + OPT_booltyp->size = OPM_BoolSize; +} + +void Vishap_Translate (void) +{ + BOOLEAN done; + CHAR modulesobj[2048]; + modulesobj[0] = 0x00; + if (OPM_OpenPar()) { + for (;;) { + OPM_Init(&done, (void*)Vishap_mname, ((LONGINT)(256))); + if (!done) { + return; + } + OPM_InitOptions(); + Vishap_PropagateElementaryTypeSizes(); + Heap_GC(0); + Vishap_Module(&done); + if (!done) { + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Module compilation failed.", (LONGINT)27); + OPM_LogWLn(); + Platform_Exit(1); + } + if (!OPM_dontAsm) { + if (OPM_dontLink) { + extTools_Assemble(OPM_modName, ((LONGINT)(32))); + } else { + if (!(OPM_mainProg || OPM_mainLinkStat)) { + extTools_Assemble(OPM_modName, ((LONGINT)(32))); + Strings_Append((CHAR*)" ", (LONGINT)2, (void*)modulesobj, ((LONGINT)(2048))); + Strings_Append(OPM_modName, ((LONGINT)(32)), (void*)modulesobj, ((LONGINT)(2048))); + Strings_Append((CHAR*)".o", (LONGINT)3, (void*)modulesobj, ((LONGINT)(2048))); + } else { + extTools_LinkMain((void*)OPM_modName, ((LONGINT)(32)), OPM_mainLinkStat, modulesobj, ((LONGINT)(2048))); + } + } + } + } + } +} + +static void Vishap_Trap (INTEGER sig) +{ + Heap_FINALL(); + if (sig == 3) { + Platform_Exit(0); + } else { + if ((sig == 4 && Platform_HaltCode == -15)) { + OPM_LogWStr((CHAR*)" --- Vishap Oberon: internal error", (LONGINT)35); + OPM_LogWLn(); + } + Platform_Exit(2); + } +} + + +export int main(int argc, char **argv) +{ + __INIT(argc, argv); + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Heap); + __MODULE_IMPORT(OPB); + __MODULE_IMPORT(OPC); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPP); + __MODULE_IMPORT(OPT); + __MODULE_IMPORT(OPV); + __MODULE_IMPORT(Platform); + __MODULE_IMPORT(Strings); + __MODULE_IMPORT(extTools); + __MODULE_IMPORT(vt100); + __REGMAIN("Vishap", 0); + __REGCMD("Translate", Vishap_Translate); +/* BEGIN */ + Platform_SetInterruptHandler(Vishap_Trap); + Platform_SetQuitHandler(Vishap_Trap); + Platform_SetBadInstructionHandler(Vishap_Trap); + OPB_typSize = OPV_TypSize; + OPT_typSize = OPV_TypSize; + Vishap_Translate(); + __FINI; +} diff --git a/bootstrap/unix-88/WindowsWrapper.h b/bootstrap/unix-88/WindowsWrapper.h new file mode 100644 index 00000000..cdb8714c --- /dev/null +++ b/bootstrap/unix-88/WindowsWrapper.h @@ -0,0 +1,9 @@ +// WindowsWrapper.h +// +// Includes Windows.h while avoiding conflicts with Oberon types. + +#undef BOOLEAN +#undef CHAR +#include +#define BOOLEAN char +#define CHAR unsigned char diff --git a/bootstrap/unix-88/errors.c b/bootstrap/unix-88/errors.c new file mode 100644 index 00000000..879f5cf7 --- /dev/null +++ b/bootstrap/unix-88/errors.c @@ -0,0 +1,199 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" + +typedef + CHAR errors_string[128]; + + +export errors_string errors_errors[350]; + + + + + +export void *errors__init(void) +{ + __DEFMOD; + __REGMOD("errors", 0); +/* BEGIN */ + __MOVE("undeclared identifier", errors_errors[0], 22); + __MOVE("multiply defined identifier", errors_errors[1], 28); + __MOVE("illegal character in number", errors_errors[2], 28); + __MOVE("illegal character in string", errors_errors[3], 28); + __MOVE("identifier does not match procedure name", errors_errors[4], 41); + __MOVE("comment not closed", errors_errors[5], 19); + errors_errors[6][0] = 0x00; + errors_errors[7][0] = 0x00; + errors_errors[8][0] = 0x00; + __MOVE("\'=\' expected", errors_errors[9], 13); + errors_errors[10][0] = 0x00; + errors_errors[11][0] = 0x00; + __MOVE("type definition starts with incorrect symbol", errors_errors[12], 45); + __MOVE("factor starts with incorrect symbol", errors_errors[13], 36); + __MOVE("statement starts with incorrect symbol", errors_errors[14], 39); + __MOVE("declaration followed by incorrect symbol", errors_errors[15], 41); + __MOVE("MODULE expected", errors_errors[16], 16); + errors_errors[17][0] = 0x00; + __MOVE("\'.\' missing", errors_errors[18], 12); + __MOVE("\',\' missing", errors_errors[19], 12); + __MOVE("\':\' missing", errors_errors[20], 12); + errors_errors[21][0] = 0x00; + __MOVE("\')\' missing", errors_errors[22], 12); + __MOVE("\']\' missing", errors_errors[23], 12); + __MOVE("\'}\' missing", errors_errors[24], 12); + __MOVE("OF missing", errors_errors[25], 11); + __MOVE("THEN missing", errors_errors[26], 13); + __MOVE("DO missing", errors_errors[27], 11); + __MOVE("TO missing", errors_errors[28], 11); + errors_errors[29][0] = 0x00; + __MOVE("\'(\' missing", errors_errors[30], 12); + errors_errors[31][0] = 0x00; + errors_errors[32][0] = 0x00; + errors_errors[33][0] = 0x00; + __MOVE("\':=\' missing", errors_errors[34], 13); + __MOVE("\',\' or OF expected", errors_errors[35], 19); + errors_errors[36][0] = 0x00; + errors_errors[37][0] = 0x00; + __MOVE("identifier expected", errors_errors[38], 20); + __MOVE("\';\' missing", errors_errors[39], 12); + errors_errors[40][0] = 0x00; + __MOVE("END missing", errors_errors[41], 12); + errors_errors[42][0] = 0x00; + errors_errors[43][0] = 0x00; + __MOVE("UNTIL missing", errors_errors[44], 14); + errors_errors[45][0] = 0x00; + __MOVE("EXIT not within loop statement", errors_errors[46], 31); + __MOVE("illegally marked identifier", errors_errors[47], 28); + errors_errors[48][0] = 0x00; + errors_errors[49][0] = 0x00; + __MOVE("expression should be constant", errors_errors[50], 30); + __MOVE("constant not an integer", errors_errors[51], 24); + __MOVE("identifier does not denote a type", errors_errors[52], 34); + __MOVE("identifier does not denote a record type", errors_errors[53], 41); + __MOVE("result type of procedure is not a basic type", errors_errors[54], 45); + __MOVE("procedure call of a function", errors_errors[55], 29); + __MOVE("assignment to non-variable", errors_errors[56], 27); + __MOVE("pointer not bound to record or array type", errors_errors[57], 42); + __MOVE("recursive type definition", errors_errors[58], 26); + __MOVE("illegal open array parameter", errors_errors[59], 29); + __MOVE("wrong type of case label", errors_errors[60], 25); + __MOVE("inadmissible type of case label", errors_errors[61], 32); + __MOVE("case label defined more than once", errors_errors[62], 34); + __MOVE("illegal value of constant", errors_errors[63], 26); + __MOVE("more actual than formal parameters", errors_errors[64], 35); + __MOVE("fewer actual than formal parameters", errors_errors[65], 36); + __MOVE("element types of actual array and formal open array differ", errors_errors[66], 59); + __MOVE("actual parameter corresponding to open array is not an array", errors_errors[67], 61); + __MOVE("control variable must be integer", errors_errors[68], 33); + __MOVE("parameter must be an integer constant", errors_errors[69], 38); + __MOVE("pointer or VAR record required as formal receiver", errors_errors[70], 50); + __MOVE("pointer expected as actual receiver", errors_errors[71], 36); + __MOVE("procedure must be bound to a record of the same scope", errors_errors[72], 54); + __MOVE("procedure must have level 0", errors_errors[73], 28); + __MOVE("procedure unknown in base type", errors_errors[74], 31); + __MOVE("invalid call of base procedure", errors_errors[75], 31); + __MOVE("this variable (field) is read only", errors_errors[76], 35); + __MOVE("object is not a record", errors_errors[77], 23); + __MOVE("dereferenced object is not a variable", errors_errors[78], 38); + __MOVE("indexed object is not a variable", errors_errors[79], 33); + __MOVE("index expression is not an integer", errors_errors[80], 35); + __MOVE("index out of specified bounds", errors_errors[81], 30); + __MOVE("indexed variable is not an array", errors_errors[82], 33); + __MOVE("undefined record field", errors_errors[83], 23); + __MOVE("dereferenced variable is not a pointer", errors_errors[84], 39); + __MOVE("guard or test type is not an extension of variable type", errors_errors[85], 56); + __MOVE("guard or testtype is not a pointer", errors_errors[86], 35); + __MOVE("guarded or tested variable is neither a pointer nor a VAR-parameter record", errors_errors[87], 75); + __MOVE("open array not allowed as variable, record field or array element", errors_errors[88], 66); + errors_errors[89][0] = 0x00; + errors_errors[90][0] = 0x00; + errors_errors[91][0] = 0x00; + __MOVE("operand of IN not an integer, or not a set", errors_errors[92], 43); + __MOVE("set element type is not an integer", errors_errors[93], 35); + __MOVE("operand of & is not of type BOOLEAN", errors_errors[94], 36); + __MOVE("operand of OR is not of type BOOLEAN", errors_errors[95], 37); + __MOVE("operand not applicable to (unary) +", errors_errors[96], 36); + __MOVE("operand not applicable to (unary) -", errors_errors[97], 36); + __MOVE("operand of ~ is not of type BOOLEAN", errors_errors[98], 36); + __MOVE("ASSERT fault", errors_errors[99], 13); + __MOVE("incompatible operands of dyadic operator", errors_errors[100], 41); + __MOVE("operand type inapplicable to *", errors_errors[101], 31); + __MOVE("operand type inapplicable to /", errors_errors[102], 31); + __MOVE("operand type inapplicable to DIV", errors_errors[103], 33); + __MOVE("operand type inapplicable to MOD", errors_errors[104], 33); + __MOVE("operand type inapplicable to +", errors_errors[105], 31); + __MOVE("operand type inapplicable to -", errors_errors[106], 31); + __MOVE("operand type inapplicable to = or #", errors_errors[107], 36); + __MOVE("operand type inapplicable to relation", errors_errors[108], 38); + __MOVE("overriding method must be exported", errors_errors[109], 35); + __MOVE("operand is not a type", errors_errors[110], 22); + __MOVE("operand inapplicable to (this) function", errors_errors[111], 40); + __MOVE("operand is not a variable", errors_errors[112], 26); + __MOVE("incompatible assignment", errors_errors[113], 24); + __MOVE("string too long to be assigned", errors_errors[114], 31); + __MOVE("parameter doesn\'t match", errors_errors[115], 24); + __MOVE("number of parameters doesn\'t match", errors_errors[116], 35); + __MOVE("result type doesn\'t match", errors_errors[117], 26); + __MOVE("export mark doesn\'t match with forward declaration", errors_errors[118], 51); + __MOVE("redefinition textually precedes procedure bound to base type", errors_errors[119], 61); + __MOVE("type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN", errors_errors[120], 71); + __MOVE("called object is not a procedure (or is an interrupt procedure)", errors_errors[121], 64); + __MOVE("actual VAR-parameter is not a variable", errors_errors[122], 39); + __MOVE("type of actual parameter is not identical with that of formal VAR-parameter", errors_errors[123], 76); + __MOVE("type of result expression differs from that of procedure", errors_errors[124], 57); + __MOVE("type of case expression is neither INTEGER nor CHAR", errors_errors[125], 52); + __MOVE("this expression cannot be a type or a procedure", errors_errors[126], 48); + __MOVE("illegal use of object", errors_errors[127], 22); + __MOVE("unsatisfied forward reference", errors_errors[128], 30); + __MOVE("unsatisfied forward procedure", errors_errors[129], 30); + __MOVE("WITH clause does not specify a variable", errors_errors[130], 40); + __MOVE("LEN not applied to array", errors_errors[131], 25); + __MOVE("dimension in LEN too large or negative", errors_errors[132], 39); + __MOVE("SYSTEM not imported", errors_errors[135], 20); + __MOVE("key inconsistency of imported module", errors_errors[150], 37); + __MOVE("incorrect symbol file", errors_errors[151], 22); + __MOVE("symbol file of imported module not found", errors_errors[152], 41); + __MOVE("object or symbol file not opened (disk full\?)", errors_errors[153], 46); + __MOVE("recursive import not allowed", errors_errors[154], 29); + __MOVE("generation of new symbol file not allowed", errors_errors[155], 42); + __MOVE("parameter file not found", errors_errors[156], 25); + __MOVE("syntax error in parameter file", errors_errors[157], 31); + __MOVE("not yet implemented", errors_errors[200], 20); + __MOVE("lower bound of set range greater than higher bound", errors_errors[201], 51); + __MOVE("set element greater than MAX(SET) or less than 0", errors_errors[202], 49); + __MOVE("number too large", errors_errors[203], 17); + __MOVE("product too large", errors_errors[204], 18); + __MOVE("division by zero", errors_errors[205], 17); + __MOVE("sum too large", errors_errors[206], 14); + __MOVE("difference too large", errors_errors[207], 21); + __MOVE("overflow in arithmetic shift", errors_errors[208], 29); + __MOVE("case range too large", errors_errors[209], 21); + __MOVE("too many cases in case statement", errors_errors[213], 33); + __MOVE("illegal value of parameter (0 <= p < 256)", errors_errors[218], 42); + __MOVE("machine registers cannot be accessed", errors_errors[219], 37); + __MOVE("illegal value of parameter", errors_errors[220], 27); + __MOVE("too many pointers in a record", errors_errors[221], 30); + __MOVE("too many global pointers", errors_errors[222], 25); + __MOVE("too many record types", errors_errors[223], 22); + __MOVE("too many pointer types", errors_errors[224], 23); + __MOVE("address of pointer variable too large (move forward in text)", errors_errors[225], 61); + __MOVE("too many exported procedures", errors_errors[226], 29); + __MOVE("too many imported modules", errors_errors[227], 26); + __MOVE("too many exported structures", errors_errors[228], 29); + __MOVE("too many nested records for import", errors_errors[229], 35); + __MOVE("too many constants (strings) in module", errors_errors[230], 39); + __MOVE("too many link table entries (external procedures)", errors_errors[231], 50); + __MOVE("too many commands in module", errors_errors[232], 28); + __MOVE("record extension hierarchy too high", errors_errors[233], 36); + __MOVE("export of recursive type not allowed", errors_errors[234], 37); + __MOVE("identifier too long", errors_errors[240], 20); + __MOVE("string too long", errors_errors[241], 16); + __MOVE("address overflow", errors_errors[242], 17); + __MOVE("cyclic type definition not allowed", errors_errors[244], 35); + __MOVE("guarded pointer variable may be manipulated by non-local operations; use auxiliary pointer variable", errors_errors[245], 100); + __MOVE("implicit type cast", errors_errors[301], 19); + __MOVE("inappropriate symbol file ignored", errors_errors[306], 34); + __MOVE("no ELSE symbol after CASE statement sequence may lead to trap", errors_errors[307], 62); + __ENDMOD; +} diff --git a/bootstrap/unix-88/errors.h b/bootstrap/unix-88/errors.h new file mode 100644 index 00000000..43cd79a9 --- /dev/null +++ b/bootstrap/unix-88/errors.h @@ -0,0 +1,19 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef errors__h +#define errors__h + +#define LARGE +#include "SYSTEM.h" + +typedef + CHAR errors_string[128]; + + +import errors_string errors_errors[350]; + + +import void *errors__init(void); + + +#endif diff --git a/bootstrap/unix-88/extTools.c b/bootstrap/unix-88/extTools.c new file mode 100644 index 00000000..7d1a2da9 --- /dev/null +++ b/bootstrap/unix-88/extTools.c @@ -0,0 +1,113 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "Configuration.h" +#include "Console.h" +#include "OPM.h" +#include "Platform.h" +#include "Strings.h" + + +static CHAR extTools_compilationOptions[1023], extTools_CFLAGS[1023]; + + +export void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len); +export void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len); +static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len); + + +static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len) +{ + INTEGER r, status, exitcode; + __DUP(title, title__len, CHAR); + __DUP(cmd, cmd__len, CHAR); + if (OPM_Verbose) { + Console_String(title, title__len); + Console_String(cmd, cmd__len); + Console_Ln(); + } + r = Platform_System(cmd, cmd__len); + status = __MASK(r, -128); + exitcode = __ASHR(r, 8); + if (exitcode > 127) { + exitcode = exitcode - 256; + } + if (r != 0) { + Console_String(title, title__len); + Console_String(cmd, cmd__len); + Console_Ln(); + Console_String((CHAR*)"-- failed: status ", (LONGINT)19); + Console_Int(status, ((LONGINT)(1))); + Console_String((CHAR*)", exitcode ", (LONGINT)12); + Console_Int(exitcode, ((LONGINT)(1))); + Console_String((CHAR*)".", (LONGINT)2); + Console_Ln(); + if ((status == 0 && exitcode == 127)) { + Console_String((CHAR*)"Is the C compiler in the current command path\?", (LONGINT)47); + Console_Ln(); + } + if (status != 0) { + Platform_Halt(status); + } else { + Platform_Halt(exitcode); + } + } + __DEL(title); + __DEL(cmd); +} + +void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len) +{ + CHAR cmd[1023]; + __DUP(moduleName, moduleName__len, CHAR); + __MOVE("gcc -g", cmd, 7); + Strings_Append(extTools_compilationOptions, ((LONGINT)(1023)), (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)"-c ", (LONGINT)4, (void*)cmd, ((LONGINT)(1023))); + Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)".c", (LONGINT)3, (void*)cmd, ((LONGINT)(1023))); + extTools_execute((CHAR*)"Assemble: ", (LONGINT)11, cmd, ((LONGINT)(1023))); + __DEL(moduleName); +} + +void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len) +{ + CHAR cmd[1023]; + __DUP(additionalopts, additionalopts__len, CHAR); + __MOVE("gcc -g", cmd, 7); + Strings_Append((CHAR*)" ", (LONGINT)2, (void*)cmd, ((LONGINT)(1023))); + Strings_Append(extTools_compilationOptions, ((LONGINT)(1023)), (void*)cmd, ((LONGINT)(1023))); + Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)".c ", (LONGINT)4, (void*)cmd, ((LONGINT)(1023))); + Strings_Append(additionalopts, additionalopts__len, (void*)cmd, ((LONGINT)(1023))); + if (statically) { + Strings_Append((CHAR*)"-static", (LONGINT)8, (void*)cmd, ((LONGINT)(1023))); + } + Strings_Append((CHAR*)" -o ", (LONGINT)5, (void*)cmd, ((LONGINT)(1023))); + Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)" -L\"", (LONGINT)5, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)"/lib\"", (LONGINT)6, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)" -l voc", (LONGINT)8, (void*)cmd, ((LONGINT)(1023))); + extTools_execute((CHAR*)"Assemble and link: ", (LONGINT)20, cmd, ((LONGINT)(1023))); + __DEL(additionalopts); +} + + +export void *extTools__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Console); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(Platform); + __MODULE_IMPORT(Strings); + __REGMOD("extTools", 0); +/* BEGIN */ + Strings_Append((CHAR*)" -I \"", (LONGINT)6, (void*)extTools_compilationOptions, ((LONGINT)(1023))); + Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)extTools_compilationOptions, ((LONGINT)(1023))); + Strings_Append((CHAR*)"/include\" ", (LONGINT)11, (void*)extTools_compilationOptions, ((LONGINT)(1023))); + Platform_GetEnv((CHAR*)"CFLAGS", (LONGINT)7, (void*)extTools_CFLAGS, ((LONGINT)(1023))); + Strings_Append(extTools_CFLAGS, ((LONGINT)(1023)), (void*)extTools_compilationOptions, ((LONGINT)(1023))); + Strings_Append((CHAR*)" ", (LONGINT)2, (void*)extTools_compilationOptions, ((LONGINT)(1023))); + __ENDMOD; +} diff --git a/bootstrap/unix-88/extTools.h b/bootstrap/unix-88/extTools.h new file mode 100644 index 00000000..61ca56e4 --- /dev/null +++ b/bootstrap/unix-88/extTools.h @@ -0,0 +1,17 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef extTools__h +#define extTools__h + +#define LARGE +#include "SYSTEM.h" + + + + +import void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len); +import void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len); +import void *extTools__init(void); + + +#endif diff --git a/bootstrap/unix-88/vt100.c b/bootstrap/unix-88/vt100.c new file mode 100644 index 00000000..88c386a8 --- /dev/null +++ b/bootstrap/unix-88/vt100.c @@ -0,0 +1,259 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "Console.h" +#include "Strings.h" + + +export CHAR vt100_CSI[5]; +static CHAR vt100_tmpstr[32]; + + +export void vt100_CHA (INTEGER n); +export void vt100_CNL (INTEGER n); +export void vt100_CPL (INTEGER n); +export void vt100_CUB (INTEGER n); +export void vt100_CUD (INTEGER n); +export void vt100_CUF (INTEGER n); +export void vt100_CUP (INTEGER n, INTEGER m); +export void vt100_CUU (INTEGER n); +export void vt100_DECTCEMh (void); +export void vt100_DECTCEMl (void); +export void vt100_DSR (INTEGER n); +export void vt100_ED (INTEGER n); +export void vt100_EL (INTEGER n); +static void vt100_EscSeq (INTEGER n, CHAR *letter, LONGINT letter__len); +static void vt100_EscSeq0 (CHAR *letter, LONGINT letter__len); +static void vt100_EscSeq2 (INTEGER n, INTEGER m, CHAR *letter, LONGINT letter__len); +static void vt100_EscSeqSwapped (INTEGER n, CHAR *letter, LONGINT letter__len); +export void vt100_HVP (INTEGER n, INTEGER m); +export void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len); +export void vt100_RCP (void); +static void vt100_Reverse0 (CHAR *str, LONGINT str__len, INTEGER start, INTEGER end); +export void vt100_SCP (void); +export void vt100_SD (INTEGER n); +export void vt100_SGR (INTEGER n); +export void vt100_SGR2 (INTEGER n, INTEGER m); +export void vt100_SU (INTEGER n); +export void vt100_SetAttr (CHAR *attr, LONGINT attr__len); + + +static void vt100_Reverse0 (CHAR *str, LONGINT str__len, INTEGER start, INTEGER end) +{ + CHAR h; + while (start < end) { + h = str[__X(start, str__len)]; + str[__X(start, str__len)] = str[__X(end, str__len)]; + str[__X(end, str__len)] = h; + start += 1; + end -= 1; + } +} + +void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len) +{ + CHAR b[21]; + INTEGER s, e; + SHORTINT maxLength; + maxLength = 20; + if (int_ == (-9223372036854775807-1)) { + __MOVE("-9223372036854775808", b, 21); + e = 20; + } else { + if (int_ < 0) { + b[0] = '-'; + int_ = -int_; + s = 1; + } else { + s = 0; + } + e = s; + do { + b[__X(e, ((LONGINT)(21)))] = (CHAR)(__MOD(int_, 10) + 48); + int_ = __DIV(int_, 10); + e += 1; + } while (!(int_ == 0)); + b[__X(e, ((LONGINT)(21)))] = 0x00; + vt100_Reverse0((void*)b, ((LONGINT)(21)), s, e - 1); + } + __COPY(b, str, str__len); +} + +static void vt100_EscSeq0 (CHAR *letter, LONGINT letter__len) +{ + CHAR cmd[9]; + __DUP(letter, letter__len, CHAR); + __COPY(vt100_CSI, cmd, ((LONGINT)(9))); + Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(9))); + Console_String(cmd, ((LONGINT)(9))); + __DEL(letter); +} + +static void vt100_EscSeq (INTEGER n, CHAR *letter, LONGINT letter__len) +{ + CHAR nstr[2]; + CHAR cmd[7]; + __DUP(letter, letter__len, CHAR); + vt100_IntToStr(n, (void*)nstr, ((LONGINT)(2))); + __COPY(vt100_CSI, cmd, ((LONGINT)(7))); + Strings_Append(nstr, ((LONGINT)(2)), (void*)cmd, ((LONGINT)(7))); + Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(7))); + Console_String(cmd, ((LONGINT)(7))); + __DEL(letter); +} + +static void vt100_EscSeqSwapped (INTEGER n, CHAR *letter, LONGINT letter__len) +{ + CHAR nstr[2]; + CHAR cmd[7]; + __DUP(letter, letter__len, CHAR); + vt100_IntToStr(n, (void*)nstr, ((LONGINT)(2))); + __COPY(vt100_CSI, cmd, ((LONGINT)(7))); + Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(7))); + Strings_Append(nstr, ((LONGINT)(2)), (void*)cmd, ((LONGINT)(7))); + Console_String(cmd, ((LONGINT)(7))); + __DEL(letter); +} + +static void vt100_EscSeq2 (INTEGER n, INTEGER m, CHAR *letter, LONGINT letter__len) +{ + CHAR nstr[5], mstr[5]; + CHAR cmd[12]; + __DUP(letter, letter__len, CHAR); + vt100_IntToStr(n, (void*)nstr, ((LONGINT)(5))); + vt100_IntToStr(m, (void*)mstr, ((LONGINT)(5))); + __COPY(vt100_CSI, cmd, ((LONGINT)(12))); + Strings_Append(nstr, ((LONGINT)(5)), (void*)cmd, ((LONGINT)(12))); + Strings_Append((CHAR*)";", (LONGINT)2, (void*)cmd, ((LONGINT)(12))); + Strings_Append(mstr, ((LONGINT)(5)), (void*)cmd, ((LONGINT)(12))); + Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(12))); + Console_String(cmd, ((LONGINT)(12))); + __DEL(letter); +} + +void vt100_CUU (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"A", (LONGINT)2); +} + +void vt100_CUD (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"B", (LONGINT)2); +} + +void vt100_CUF (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"C", (LONGINT)2); +} + +void vt100_CUB (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"D", (LONGINT)2); +} + +void vt100_CNL (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"E", (LONGINT)2); +} + +void vt100_CPL (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"F", (LONGINT)2); +} + +void vt100_CHA (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"G", (LONGINT)2); +} + +void vt100_CUP (INTEGER n, INTEGER m) +{ + vt100_EscSeq2(n, m, (CHAR*)"H", (LONGINT)2); +} + +void vt100_ED (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"J", (LONGINT)2); +} + +void vt100_EL (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"K", (LONGINT)2); +} + +void vt100_SU (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"S", (LONGINT)2); +} + +void vt100_SD (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"T", (LONGINT)2); +} + +void vt100_HVP (INTEGER n, INTEGER m) +{ + vt100_EscSeq2(n, m, (CHAR*)"f", (LONGINT)2); +} + +void vt100_SGR (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"m", (LONGINT)2); +} + +void vt100_SGR2 (INTEGER n, INTEGER m) +{ + vt100_EscSeq2(n, m, (CHAR*)"m", (LONGINT)2); +} + +void vt100_DSR (INTEGER n) +{ + vt100_EscSeq(6, (CHAR*)"n", (LONGINT)2); +} + +void vt100_SCP (void) +{ + vt100_EscSeq0((CHAR*)"s", (LONGINT)2); +} + +void vt100_RCP (void) +{ + vt100_EscSeq0((CHAR*)"u", (LONGINT)2); +} + +void vt100_DECTCEMl (void) +{ + vt100_EscSeq0((CHAR*)"\?25l", (LONGINT)5); +} + +void vt100_DECTCEMh (void) +{ + vt100_EscSeq0((CHAR*)"\?25h", (LONGINT)5); +} + +void vt100_SetAttr (CHAR *attr, LONGINT attr__len) +{ + CHAR tmpstr[16]; + __DUP(attr, attr__len, CHAR); + __COPY(vt100_CSI, tmpstr, ((LONGINT)(16))); + Strings_Append(attr, attr__len, (void*)tmpstr, ((LONGINT)(16))); + Console_String(tmpstr, ((LONGINT)(16))); + __DEL(attr); +} + + +export void *vt100__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Console); + __MODULE_IMPORT(Strings); + __REGMOD("vt100", 0); + __REGCMD("DECTCEMh", vt100_DECTCEMh); + __REGCMD("DECTCEMl", vt100_DECTCEMl); + __REGCMD("RCP", vt100_RCP); + __REGCMD("SCP", vt100_SCP); +/* BEGIN */ + __COPY("", vt100_CSI, ((LONGINT)(5))); + Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5))); + __ENDMOD; +} diff --git a/bootstrap/unix-88/vt100.h b/bootstrap/unix-88/vt100.h new file mode 100644 index 00000000..b124915f --- /dev/null +++ b/bootstrap/unix-88/vt100.h @@ -0,0 +1,38 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef vt100__h +#define vt100__h + +#define LARGE +#include "SYSTEM.h" + + +import CHAR vt100_CSI[5]; + + +import void vt100_CHA (INTEGER n); +import void vt100_CNL (INTEGER n); +import void vt100_CPL (INTEGER n); +import void vt100_CUB (INTEGER n); +import void vt100_CUD (INTEGER n); +import void vt100_CUF (INTEGER n); +import void vt100_CUP (INTEGER n, INTEGER m); +import void vt100_CUU (INTEGER n); +import void vt100_DECTCEMh (void); +import void vt100_DECTCEMl (void); +import void vt100_DSR (INTEGER n); +import void vt100_ED (INTEGER n); +import void vt100_EL (INTEGER n); +import void vt100_HVP (INTEGER n, INTEGER m); +import void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len); +import void vt100_RCP (void); +import void vt100_SCP (void); +import void vt100_SD (INTEGER n); +import void vt100_SGR (INTEGER n); +import void vt100_SGR2 (INTEGER n, INTEGER m); +import void vt100_SU (INTEGER n); +import void vt100_SetAttr (CHAR *attr, LONGINT attr__len); +import void *vt100__init(void); + + +#endif diff --git a/bootstrap/windows-48/Configuration.c b/bootstrap/windows-48/Configuration.c new file mode 100644 index 00000000..a1992033 --- /dev/null +++ b/bootstrap/windows-48/Configuration.c @@ -0,0 +1,16 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" + + + + + + + +export void *Configuration__init(void) +{ + __DEFMOD; + __REGMOD("Configuration", 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/windows-48/Configuration.h b/bootstrap/windows-48/Configuration.h new file mode 100644 index 00000000..e7aed50a --- /dev/null +++ b/bootstrap/windows-48/Configuration.h @@ -0,0 +1,14 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Configuration__h +#define Configuration__h + +#include "SYSTEM.h" + + + + +import void *Configuration__init(void); + + +#endif diff --git a/bootstrap/windows-48/Console.c b/bootstrap/windows-48/Console.c new file mode 100644 index 00000000..2f8e5f21 --- /dev/null +++ b/bootstrap/windows-48/Console.c @@ -0,0 +1,150 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "Platform.h" + + +static CHAR Console_line[128]; +static INTEGER Console_pos; + + +export void Console_Bool (BOOLEAN b); +export void Console_Char (CHAR ch); +export void Console_Flush (void); +export void Console_Hex (LONGINT i); +export void Console_Int (LONGINT i, LONGINT n); +export void Console_Ln (void); +export void Console_Read (CHAR *ch); +export void Console_ReadLine (CHAR *line, LONGINT line__len); +export void Console_String (CHAR *s, LONGINT s__len); + + +void Console_Flush (void) +{ + INTEGER error; + error = Platform_Write(Platform_StdOut, (LONGINT)(uintptr_t)Console_line, Console_pos); + Console_pos = 0; +} + +void Console_Char (CHAR ch) +{ + if (Console_pos == 128) { + Console_Flush(); + } + Console_line[__X(Console_pos, ((LONGINT)(128)))] = ch; + Console_pos += 1; + if (ch == 0x0a) { + Console_Flush(); + } +} + +void Console_String (CHAR *s, LONGINT s__len) +{ + INTEGER i; + __DUP(s, s__len, CHAR); + i = 0; + while (s[__X(i, s__len)] != 0x00) { + Console_Char(s[__X(i, s__len)]); + i += 1; + } + __DEL(s); +} + +void Console_Int (LONGINT i, LONGINT n) +{ + CHAR s[32]; + LONGINT i1, k; + if (i == __LSHL(1, 31, LONGINT)) { + __MOVE("8463847412", s, 11); + k = 10; + } else { + i1 = __ABS(i); + s[0] = (CHAR)(__MOD(i1, 10) + 48); + i1 = __DIV(i1, 10); + k = 1; + while (i1 > 0) { + s[__X(k, ((LONGINT)(32)))] = (CHAR)(__MOD(i1, 10) + 48); + i1 = __DIV(i1, 10); + k += 1; + } + } + if (i < 0) { + s[__X(k, ((LONGINT)(32)))] = '-'; + k += 1; + } + while (n > k) { + Console_Char(' '); + n -= 1; + } + while (k > 0) { + k -= 1; + Console_Char(s[__X(k, ((LONGINT)(32)))]); + } +} + +void Console_Ln (void) +{ + Console_Char(0x0a); +} + +void Console_Bool (BOOLEAN b) +{ + if (b) { + Console_String((CHAR*)"TRUE", (LONGINT)5); + } else { + Console_String((CHAR*)"FALSE", (LONGINT)6); + } +} + +void Console_Hex (LONGINT i) +{ + LONGINT k, n; + k = -28; + while (k <= 0) { + n = __MASK(__ASH(i, k), -16); + if (n <= 9) { + Console_Char((CHAR)(48 + n)); + } else { + Console_Char((CHAR)(55 + n)); + } + k += 4; + } +} + +void Console_Read (CHAR *ch) +{ + LONGINT n; + INTEGER error; + Console_Flush(); + error = Platform_ReadBuf(Platform_StdIn, (void*)&*ch, ((LONGINT)(1)), &n); + if (n != 1) { + *ch = 0x00; + } +} + +void Console_ReadLine (CHAR *line, LONGINT line__len) +{ + LONGINT i; + CHAR ch; + Console_Flush(); + i = 0; + Console_Read(&ch); + while ((((i < line__len - 1 && ch != 0x0a)) && ch != 0x00)) { + line[__X(i, line__len)] = ch; + i += 1; + Console_Read(&ch); + } + line[__X(i, line__len)] = 0x00; +} + + +export void *Console__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Platform); + __REGMOD("Console", 0); + __REGCMD("Flush", Console_Flush); + __REGCMD("Ln", Console_Ln); +/* BEGIN */ + Console_pos = 0; + __ENDMOD; +} diff --git a/bootstrap/windows-48/Console.h b/bootstrap/windows-48/Console.h new file mode 100644 index 00000000..316e7e46 --- /dev/null +++ b/bootstrap/windows-48/Console.h @@ -0,0 +1,23 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Console__h +#define Console__h + +#include "SYSTEM.h" + + + + +import void Console_Bool (BOOLEAN b); +import void Console_Char (CHAR ch); +import void Console_Flush (void); +import void Console_Hex (LONGINT i); +import void Console_Int (LONGINT i, LONGINT n); +import void Console_Ln (void); +import void Console_Read (CHAR *ch); +import void Console_ReadLine (CHAR *line, LONGINT line__len); +import void Console_String (CHAR *s, LONGINT s__len); +import void *Console__init(void); + + +#endif diff --git a/bootstrap/windows-48/Files.c b/bootstrap/windows-48/Files.c new file mode 100644 index 00000000..25fa879e --- /dev/null +++ b/bootstrap/windows-48/Files.c @@ -0,0 +1,1078 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tspkaSfF */ +#include "SYSTEM.h" +#include "Configuration.h" +#include "Console.h" +#include "Heap.h" +#include "Platform.h" +#include "Strings.h" + +typedef + struct Files_Handle *Files_File; + +typedef + struct Files_BufDesc { + Files_File f; + BOOLEAN chg; + LONGINT org, size; + SYSTEM_BYTE data[4096]; + } Files_BufDesc; + +typedef + Files_BufDesc *Files_Buffer; + +typedef + CHAR Files_FileName[101]; + +typedef + struct Files_Handle { + Files_FileName workName, registerName; + BOOLEAN tempFile; + Platform_FileIdentity identity; + LONGINT fd, len, pos; + Files_Buffer bufs[4]; + INTEGER swapper, state; + } Files_Handle; + +typedef + struct Files_Rider { + LONGINT res; + BOOLEAN eof; + Files_Buffer buf; + LONGINT org, offset; + } Files_Rider; + + +static LONGINT Files_fileTab[256]; +static INTEGER Files_tempno; +static CHAR Files_HOME[1024]; +static struct { + LONGINT len[1]; + CHAR data[1]; +} *Files_SearchPath; + +export LONGINT *Files_Handle__typ; +export LONGINT *Files_BufDesc__typ; +export LONGINT *Files_Rider__typ; + +export Files_File Files_Base (Files_Rider *r, LONGINT *r__typ); +static Files_File Files_CacheEntry (Platform_FileIdentity identity); +export void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res); +export void Files_Close (Files_File f); +static void Files_Create (Files_File f); +export void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res); +static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INTEGER errcode); +static void Files_Finalize (SYSTEM_PTR o); +static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len); +static void Files_Flush (Files_Buffer buf); +export void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d); +export void Files_GetName (Files_File f, CHAR *name, LONGINT name__len); +static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len); +static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len); +static void Files_Init (void); +export LONGINT Files_Length (Files_File f); +static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len); +export Files_File Files_New (CHAR *name, LONGINT name__len); +export Files_File Files_Old (CHAR *name, LONGINT name__len); +export LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ); +export void Files_Purge (Files_File f); +export void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x); +export void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x); +export void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len); +export void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n); +export void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x); +export void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x); +export void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x); +export void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +export void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x); +export void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x); +export void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x); +export void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +export void Files_Register (Files_File f); +export void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res); +static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len); +export void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos); +export void Files_SetSearchPath (CHAR *path, LONGINT path__len); +export void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x); +export void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x); +export void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n); +export void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x); +export void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x); +export void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x); +export void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x); +export void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x); +export void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x); +export void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); + +#define Files_IdxTrap() __HALT(-1) + +static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INTEGER errcode) +{ + __DUP(s, s__len, CHAR); + Console_Ln(); + Console_String((CHAR*)"-- ", (LONGINT)4); + Console_String(s, s__len); + Console_String((CHAR*)": ", (LONGINT)3); + if (f != NIL) { + if (f->registerName[0] != 0x00) { + Console_String(f->registerName, ((LONGINT)(101))); + } else { + Console_String(f->workName, ((LONGINT)(101))); + } + if (f->fd != 0) { + Console_String((CHAR*)"f.fd = ", (LONGINT)8); + Console_Int(f->fd, ((LONGINT)(1))); + } + } + if (errcode != 0) { + Console_String((CHAR*)" errcode = ", (LONGINT)12); + Console_Int(errcode, ((LONGINT)(1))); + } + Console_Ln(); + __HALT(99); + __DEL(s); +} + +static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len) +{ + INTEGER i, j; + __DUP(dir, dir__len, CHAR); + __DUP(name, name__len, CHAR); + i = 0; + j = 0; + while (dir[i] != 0x00) { + dest[i] = dir[i]; + i += 1; + } + if (dest[i - 1] != '/') { + dest[i] = '/'; + i += 1; + } + while (name[j] != 0x00) { + dest[i] = name[j]; + i += 1; + j += 1; + } + dest[i] = 0x00; + __DEL(dir); + __DEL(name); +} + +static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len) +{ + LONGINT n, i, j; + __DUP(finalName, finalName__len, CHAR); + Files_tempno += 1; + n = Files_tempno; + i = 0; + if (finalName[0] != '/') { + while (Platform_CWD[i] != 0x00) { + name[i] = Platform_CWD[i]; + i += 1; + } + if (Platform_CWD[i - 1] != '/') { + name[i] = '/'; + i += 1; + } + } + j = 0; + while (finalName[j] != 0x00) { + name[i] = finalName[j]; + i += 1; + j += 1; + } + i -= 1; + while (name[i] != '/') { + i -= 1; + } + name[i + 1] = '.'; + name[i + 2] = 't'; + name[i + 3] = 'm'; + name[i + 4] = 'p'; + name[i + 5] = '.'; + i += 6; + while (n > 0) { + name[i] = (CHAR)(__MOD(n, 10) + 48); + n = __DIV(n, 10); + i += 1; + } + name[i] = '.'; + i += 1; + n = Platform_PID; + while (n > 0) { + name[i] = (CHAR)(__MOD(n, 10) + 48); + n = __DIV(n, 10); + i += 1; + } + name[i] = 0x00; + __DEL(finalName); +} + +static void Files_Create (Files_File f) +{ + Platform_FileIdentity identity; + BOOLEAN done; + INTEGER error; + CHAR err[32]; + if (f->fd == -1) { + if (f->state == 1) { + Files_GetTempName(f->registerName, ((LONGINT)(101)), (void*)f->workName, ((LONGINT)(101))); + f->tempFile = 1; + } else if (f->state == 2) { + __COPY(f->registerName, f->workName, ((LONGINT)(101))); + f->registerName[0] = 0x00; + f->tempFile = 0; + } + error = Platform_Unlink((void*)f->workName, ((LONGINT)(101))); + error = Platform_New((void*)f->workName, ((LONGINT)(101)), &f->fd); + done = error == 0; + if ((!done && Platform_TooManyFiles(error)) || (done && f->fd >= 256)) { + if ((done && f->fd >= 256)) { + error = Platform_Close(f->fd); + } + Heap_GC(1); + error = Platform_New((void*)f->workName, ((LONGINT)(101)), &f->fd); + done = f->fd == 0; + } + if (done) { + if (f->fd >= 256) { + error = Platform_Close(f->fd); + Files_Err((CHAR*)"too many files open", (LONGINT)20, f, 0); + } else { + Files_fileTab[f->fd] = (LONGINT)(uintptr_t)f; + Heap_FileCount += 1; + Heap_RegisterFinalizer((void*)f, Files_Finalize); + f->state = 0; + f->pos = 0; + error = Platform_Identify(f->fd, &f->identity, Platform_FileIdentity__typ); + } + } else { + if (Platform_NoSuchDirectory(error)) { + __MOVE("no such directory", err, 18); + } else if (Platform_TooManyFiles(error)) { + __MOVE("too many files open", err, 20); + } else { + __MOVE("file not created", err, 17); + } + Files_Err(err, ((LONGINT)(32)), f, error); + } + } +} + +static void Files_Flush (Files_Buffer buf) +{ + INTEGER error; + Files_File f = NIL; + if (buf->chg) { + f = buf->f; + Files_Create(f); + if (buf->org != f->pos) { + error = Platform_Seek(f->fd, buf->org, Platform_SeekSet); + } + error = Platform_Write(f->fd, (LONGINT)(uintptr_t)buf->data, buf->size); + if (error != 0) { + Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error); + } + f->pos = buf->org + buf->size; + buf->chg = 0; + error = Platform_Identify(f->fd, &f->identity, Platform_FileIdentity__typ); + if (error != 0) { + Files_Err((CHAR*)"error identifying file", (LONGINT)23, f, error); + } + } +} + +void Files_Close (Files_File f) +{ + LONGINT i; + INTEGER error; + if (f->state != 1 || f->registerName[0] != 0x00) { + Files_Create(f); + i = 0; + while ((i < 4 && f->bufs[i] != NIL)) { + Files_Flush(f->bufs[i]); + i += 1; + } + error = Platform_Sync(f->fd); + if (error != 0) { + Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error); + } + Files_fileTab[f->fd] = 0; + error = Platform_Close(f->fd); + f->fd = -1; + f->state = 1; + Heap_FileCount -= 1; + } +} + +LONGINT Files_Length (Files_File f) +{ + LONGINT _o_result; + _o_result = f->len; + return _o_result; +} + +Files_File Files_New (CHAR *name, LONGINT name__len) +{ + Files_File _o_result; + Files_File f = NIL; + __DUP(name, name__len, CHAR); + __NEW(f, Files_Handle); + f->workName[0] = 0x00; + __COPY(name, f->registerName, ((LONGINT)(101))); + f->fd = -1; + f->state = 1; + f->len = 0; + f->pos = 0; + f->swapper = -1; + _o_result = f; + __DEL(name); + return _o_result; +} + +static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len) +{ + INTEGER i; + CHAR ch; + i = 0; + if (Files_SearchPath == NIL) { + if (*pos == 0) { + dir[0] = '.'; + i = 1; + *pos += 1; + } + } else { + ch = (Files_SearchPath->data)[*pos]; + while (ch == ' ' || ch == ';') { + *pos += 1; + ch = (Files_SearchPath->data)[*pos]; + } + if (ch == '~') { + *pos += 1; + ch = (Files_SearchPath->data)[*pos]; + while (Files_HOME[i] != 0x00) { + dir[i] = Files_HOME[i]; + i += 1; + } + if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) { + while ((i > 0 && dir[i - 1] != '/')) { + i -= 1; + } + } + } + while ((ch != 0x00 && ch != ';')) { + dir[i] = ch; + i += 1; + *pos += 1; + ch = (Files_SearchPath->data)[*pos]; + } + while ((i > 0 && dir[i - 1] == ' ')) { + i -= 1; + } + } + dir[i] = 0x00; +} + +static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len) +{ + BOOLEAN _o_result; + INTEGER i; + CHAR ch; + i = 0; + ch = name[0]; + while ((ch != 0x00 && ch != '/')) { + i += 1; + ch = name[i]; + } + _o_result = ch == '/'; + return _o_result; +} + +static Files_File Files_CacheEntry (Platform_FileIdentity identity) +{ + Files_File _o_result; + Files_File f = NIL; + INTEGER i, error; + i = 0; + while (i < 256) { + f = (Files_File)(uintptr_t)Files_fileTab[i]; + if ((f != NIL && Platform_SameFile(identity, f->identity))) { + if (!Platform_SameFileTime(identity, f->identity)) { + i = 0; + while (i < 4) { + if (f->bufs[i] != NIL) { + f->bufs[i]->org = -1; + f->bufs[i] = NIL; + } + i += 1; + } + f->swapper = -1; + f->identity = identity; + error = Platform_Size(f->fd, &f->len); + } + _o_result = f; + return _o_result; + } + i += 1; + } + _o_result = NIL; + return _o_result; +} + +Files_File Files_Old (CHAR *name, LONGINT name__len) +{ + Files_File _o_result; + Files_File f = NIL; + LONGINT fd; + INTEGER pos; + BOOLEAN done; + CHAR dir[256], path[256]; + INTEGER error; + Platform_FileIdentity identity; + __DUP(name, name__len, CHAR); + if (name[0] != 0x00) { + if (Files_HasDir((void*)name, name__len)) { + dir[0] = 0x00; + __COPY(name, path, ((LONGINT)(256))); + } else { + pos = 0; + Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256))); + Files_MakeFileName(dir, ((LONGINT)(256)), name, name__len, (void*)path, ((LONGINT)(256))); + Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256))); + } + for (;;) { + error = Platform_OldRW((void*)path, ((LONGINT)(256)), &fd); + done = error == 0; + if ((!done && Platform_TooManyFiles(error)) || (done && fd >= 256)) { + if ((done && fd >= 256)) { + error = Platform_Close(fd); + } + Heap_GC(1); + error = Platform_OldRW((void*)path, ((LONGINT)(256)), &fd); + done = error == 0; + if ((!done && Platform_TooManyFiles(error))) { + Files_Err((CHAR*)"too many files open", (LONGINT)20, f, error); + } + } + if ((!done && Platform_Inaccessible(error))) { + error = Platform_OldRO((void*)path, ((LONGINT)(256)), &fd); + done = error == 0; + } + if ((!done && !Platform_Absent(error))) { + Console_String((CHAR*)"Warning: Files.Old ", (LONGINT)20); + Console_String(name, name__len); + Console_String((CHAR*)" error = ", (LONGINT)10); + Console_Int(error, ((LONGINT)(0))); + Console_Ln(); + } + if (done) { + error = Platform_Identify(fd, &identity, Platform_FileIdentity__typ); + f = Files_CacheEntry(identity); + if (f != NIL) { + error = Platform_Close(fd); + _o_result = f; + __DEL(name); + return _o_result; + } else if (fd >= 256) { + error = Platform_Close(fd); + Files_Err((CHAR*)"too many files open", (LONGINT)20, f, 0); + } else { + __NEW(f, Files_Handle); + Files_fileTab[fd] = (LONGINT)(uintptr_t)f; + Heap_FileCount += 1; + Heap_RegisterFinalizer((void*)f, Files_Finalize); + f->fd = fd; + f->state = 0; + f->pos = 0; + f->swapper = -1; + error = Platform_Size(fd, &f->len); + __COPY(name, f->workName, ((LONGINT)(101))); + f->registerName[0] = 0x00; + f->tempFile = 0; + f->identity = identity; + _o_result = f; + __DEL(name); + return _o_result; + } + } else if (dir[0] == 0x00) { + _o_result = NIL; + __DEL(name); + return _o_result; + } else { + Files_MakeFileName(dir, ((LONGINT)(256)), name, name__len, (void*)path, ((LONGINT)(256))); + Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256))); + } + } + } else { + _o_result = NIL; + __DEL(name); + return _o_result; + } + __RETCHK; +} + +void Files_Purge (Files_File f) +{ + INTEGER i; + Platform_FileIdentity identity; + INTEGER error; + i = 0; + while (i < 4) { + if (f->bufs[i] != NIL) { + f->bufs[i]->org = -1; + f->bufs[i] = NIL; + } + i += 1; + } + if (f->fd != -1) { + error = Platform_Truncate(f->fd, ((LONGINT)(0))); + error = Platform_Seek(f->fd, ((LONGINT)(0)), Platform_SeekSet); + } + f->pos = 0; + f->len = 0; + f->swapper = -1; + error = Platform_Identify(f->fd, &identity, Platform_FileIdentity__typ); + Platform_SetMTime(&f->identity, Platform_FileIdentity__typ, identity); +} + +void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d) +{ + Platform_FileIdentity identity; + INTEGER error; + Files_Create(f); + error = Platform_Identify(f->fd, &identity, Platform_FileIdentity__typ); + Platform_MTimeAsClock(identity, &*t, &*d); +} + +LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ) +{ + LONGINT _o_result; + _o_result = (*r).org + (*r).offset; + return _o_result; +} + +void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos) +{ + LONGINT org, offset, i, n; + Files_Buffer buf = NIL; + INTEGER error; + if (f != NIL) { + if (pos > f->len) { + pos = f->len; + } else if (pos < 0) { + pos = 0; + } + offset = __MASK(pos, -4096); + org = pos - offset; + i = 0; + while ((((i < 4 && f->bufs[i] != NIL)) && org != f->bufs[i]->org)) { + i += 1; + } + if (i < 4) { + if (f->bufs[i] == NIL) { + __NEW(buf, Files_BufDesc); + buf->chg = 0; + buf->org = -1; + buf->f = f; + f->bufs[i] = buf; + } else { + buf = f->bufs[i]; + } + } else { + f->swapper = __MASK(f->swapper + 1, -4); + buf = f->bufs[f->swapper]; + Files_Flush(buf); + } + if (buf->org != org) { + if (org == f->len) { + buf->size = 0; + } else { + Files_Create(f); + if (f->pos != org) { + error = Platform_Seek(f->fd, org, Platform_SeekSet); + } + error = Platform_ReadBuf(f->fd, (void*)buf->data, ((LONGINT)(4096)), &n); + if (error != 0) { + Files_Err((CHAR*)"read from file not done", (LONGINT)24, f, error); + } + f->pos = org + n; + buf->size = n; + } + buf->org = org; + buf->chg = 0; + } + } else { + buf = NIL; + org = 0; + offset = 0; + } + (*r).buf = buf; + (*r).org = org; + (*r).offset = offset; + (*r).eof = 0; + (*r).res = 0; +} + +void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x) +{ + LONGINT offset; + Files_Buffer buf = NIL; + buf = (*r).buf; + offset = (*r).offset; + if ((*r).org != buf->org) { + Files_Set(&*r, r__typ, buf->f, (*r).org + offset); + buf = (*r).buf; + offset = (*r).offset; + } + if (offset < buf->size) { + *x = buf->data[offset]; + (*r).offset = offset + 1; + } else if ((*r).org + offset < buf->f->len) { + Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset); + *x = (*r).buf->data[0]; + (*r).offset = 1; + } else { + *x = 0x00; + (*r).eof = 1; + } +} + +void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n) +{ + LONGINT xpos, min, restInBuf, offset; + Files_Buffer buf = NIL; + if (n > x__len) { + Files_IdxTrap(); + } + xpos = 0; + buf = (*r).buf; + offset = (*r).offset; + while (n > 0) { + if ((*r).org != buf->org || offset >= 4096) { + Files_Set(&*r, r__typ, buf->f, (*r).org + offset); + buf = (*r).buf; + offset = (*r).offset; + } + restInBuf = buf->size - offset; + if (restInBuf == 0) { + (*r).res = n; + (*r).eof = 1; + return; + } else if (n > restInBuf) { + min = restInBuf; + } else { + min = n; + } + __MOVE((LONGINT)(uintptr_t)buf->data + offset, (LONGINT)(uintptr_t)x + xpos, min); + offset += min; + (*r).offset = offset; + xpos += min; + n -= min; + } + (*r).res = 0; + (*r).eof = 0; +} + +void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len) +{ + Files_ReadBytes(&*r, r__typ, (void*)x, x__len * ((LONGINT)(1)), ((LONGINT)(1))); +} + +Files_File Files_Base (Files_Rider *r, LONGINT *r__typ) +{ + Files_File _o_result; + _o_result = (*r).buf->f; + return _o_result; +} + +void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x) +{ + Files_Buffer buf = NIL; + LONGINT offset; + buf = (*r).buf; + offset = (*r).offset; + if ((*r).org != buf->org || offset >= 4096) { + Files_Set(&*r, r__typ, buf->f, (*r).org + offset); + buf = (*r).buf; + offset = (*r).offset; + } + buf->data[offset] = x; + buf->chg = 1; + if (offset == buf->size) { + buf->size += 1; + buf->f->len += 1; + } + (*r).offset = offset + 1; + (*r).res = 0; +} + +void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n) +{ + LONGINT xpos, min, restInBuf, offset; + Files_Buffer buf = NIL; + if (n > x__len) { + Files_IdxTrap(); + } + xpos = 0; + buf = (*r).buf; + offset = (*r).offset; + while (n > 0) { + if ((*r).org != buf->org || offset >= 4096) { + Files_Set(&*r, r__typ, buf->f, (*r).org + offset); + buf = (*r).buf; + offset = (*r).offset; + } + restInBuf = 4096 - offset; + if (n > restInBuf) { + min = restInBuf; + } else { + min = n; + } + __MOVE((LONGINT)(uintptr_t)x + xpos, (LONGINT)(uintptr_t)buf->data + offset, min); + offset += min; + (*r).offset = offset; + if (offset > buf->size) { + buf->f->len += offset - buf->size; + buf->size = offset; + } + xpos += min; + n -= min; + buf->chg = 1; + } + (*r).res = 0; +} + +void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res) +{ + __DUP(name, name__len, CHAR); + *res = Platform_Unlink((void*)name, name__len); + __DEL(name); +} + +void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res) +{ + LONGINT fdold, fdnew, n; + INTEGER error, ignore; + Platform_FileIdentity oldidentity, newidentity; + CHAR buf[4096]; + __DUP(old, old__len, CHAR); + __DUP(new, new__len, CHAR); + error = Platform_IdentifyByName(old, old__len, &oldidentity, Platform_FileIdentity__typ); + if (error == 0) { + error = Platform_IdentifyByName(new, new__len, &newidentity, Platform_FileIdentity__typ); + if ((error != 0 && !Platform_SameFile(oldidentity, newidentity))) { + Files_Delete(new, new__len, &error); + } + error = Platform_Rename((void*)old, old__len, (void*)new, new__len); + if (!Platform_DifferentFilesystems(error)) { + *res = error; + return; + } else { + error = Platform_OldRO((void*)old, old__len, &fdold); + if (error != 0) { + *res = 2; + return; + } + error = Platform_New((void*)new, new__len, &fdnew); + if (error != 0) { + error = Platform_Close(fdold); + *res = 3; + return; + } + error = Platform_Read(fdold, (LONGINT)(uintptr_t)buf, ((LONGINT)(4096)), &n); + while (n > 0) { + error = Platform_Write(fdnew, (LONGINT)(uintptr_t)buf, n); + if (error != 0) { + ignore = Platform_Close(fdold); + ignore = Platform_Close(fdnew); + Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error); + } + error = Platform_Read(fdold, (LONGINT)(uintptr_t)buf, ((LONGINT)(4096)), &n); + } + ignore = Platform_Close(fdold); + ignore = Platform_Close(fdnew); + if (n == 0) { + error = Platform_Unlink((void*)old, old__len); + *res = 0; + } else { + Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error); + } + } + } else { + *res = 2; + } + __DEL(old); + __DEL(new); +} + +void Files_Register (Files_File f) +{ + INTEGER idx, errcode; + Files_File f1 = NIL; + CHAR file[104]; + if ((f->state == 1 && f->registerName[0] != 0x00)) { + f->state = 2; + } + Files_Close(f); + if (f->registerName[0] != 0x00) { + Files_Rename(f->workName, ((LONGINT)(101)), f->registerName, ((LONGINT)(101)), &errcode); + if (errcode != 0) { + __COPY(f->registerName, file, ((LONGINT)(104))); + __HALT(99); + } + __COPY(f->registerName, f->workName, ((LONGINT)(101))); + f->registerName[0] = 0x00; + f->tempFile = 0; + } +} + +void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res) +{ + __DUP(path, path__len, CHAR); + *res = Platform_Chdir((void*)path, path__len); + __DEL(path); +} + +static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len) +{ + LONGINT i, j; + if (!Platform_LittleEndian) { + i = src__len; + j = 0; + while (i > 0) { + i -= 1; + dest[j] = src[i]; + j += 1; + } + } else { + __MOVE((LONGINT)(uintptr_t)src, (LONGINT)(uintptr_t)dest, src__len); + } +} + +void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x) +{ + Files_Read(&*R, R__typ, (CHAR*)(void*)&*x); +} + +void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x) +{ + CHAR b[2]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(2)), ((LONGINT)(2))); + *x = (int)b[0] + __ASHL((int)b[1], 8); +} + +void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x) +{ + CHAR b[4]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); + *x = ((LONGINT)((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((LONGINT)b[2], 16)) + __ASHL((LONGINT)b[3], 24); +} + +void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x) +{ + CHAR b[4]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); + *x = (SET)(((LONGINT)((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((LONGINT)b[2], 16)) + __ASHL((LONGINT)b[3], 24)); +} + +void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x) +{ + CHAR b[4]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); + Files_FlipBytes((void*)b, ((LONGINT)(4)), (void*)&*x, ((LONGINT)(4))); +} + +void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x) +{ + CHAR b[8]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(8)), ((LONGINT)(8))); + Files_FlipBytes((void*)b, ((LONGINT)(8)), (void*)&*x, ((LONGINT)(8))); +} + +void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len) +{ + INTEGER i; + CHAR ch; + i = 0; + do { + Files_Read(&*R, R__typ, (void*)&ch); + x[i] = ch; + i += 1; + } while (!(ch == 0x00)); +} + +void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len) +{ + INTEGER i; + CHAR ch; + BOOLEAN b; + i = 0; + b = 0; + do { + Files_Read(&*R, R__typ, (void*)&ch); + if ((ch == 0x00 || ch == 0x0a) || ch == 0x0d) { + b = 1; + } else { + x[i] = ch; + i += 1; + } + } while (!b); +} + +void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x) +{ + SHORTINT s; + CHAR ch; + LONGINT n; + s = 0; + n = 0; + Files_Read(&*R, R__typ, (void*)&ch); + while ((int)ch >= 128) { + n += __ASH((LONGINT)((int)ch - 128), s); + s += 7; + Files_Read(&*R, R__typ, (void*)&ch); + } + n += __ASH((LONGINT)(__MASK((int)ch, -64) - __ASHL(__ASHR((int)ch, 6), 6)), s); + *x = n; +} + +void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x) +{ + Files_Write(&*R, R__typ, __VAL(CHAR, x)); +} + +void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x) +{ + CHAR b[2]; + b[0] = (CHAR)x; + b[1] = (CHAR)__ASHR(x, 8); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(2)), ((LONGINT)(2))); +} + +void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x) +{ + CHAR b[4]; + b[0] = (CHAR)x; + b[1] = (CHAR)__ASHR(x, 8); + b[2] = (CHAR)__ASHR(x, 16); + b[3] = (CHAR)__ASHR(x, 24); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); +} + +void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x) +{ + CHAR b[4]; + LONGINT i; + i = (LONGINT)x; + b[0] = (CHAR)i; + b[1] = (CHAR)__ASHR(i, 8); + b[2] = (CHAR)__ASHR(i, 16); + b[3] = (CHAR)__ASHR(i, 24); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); +} + +void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x) +{ + CHAR b[4]; + Files_FlipBytes((void*)&x, ((LONGINT)(4)), (void*)b, ((LONGINT)(4))); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); +} + +void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x) +{ + CHAR b[8]; + Files_FlipBytes((void*)&x, ((LONGINT)(8)), (void*)b, ((LONGINT)(8))); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(8)), ((LONGINT)(8))); +} + +void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len) +{ + INTEGER i; + i = 0; + while (x[i] != 0x00) { + i += 1; + } + Files_WriteBytes(&*R, R__typ, (void*)x, x__len * ((LONGINT)(1)), i + 1); +} + +void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x) +{ + while (x < -64 || x > 63) { + Files_Write(&*R, R__typ, (CHAR)(__MASK(x, -128) + 128)); + x = __ASHR(x, 7); + } + Files_Write(&*R, R__typ, (CHAR)__MASK(x, -128)); +} + +void Files_GetName (Files_File f, CHAR *name, LONGINT name__len) +{ + __COPY(f->workName, name, name__len); +} + +static void Files_Finalize (SYSTEM_PTR o) +{ + Files_File f = NIL; + LONGINT res; + f = (Files_File)(uintptr_t)o; + if (f->fd >= 0) { + Files_fileTab[f->fd] = 0; + res = Platform_Close(f->fd); + f->fd = -1; + Heap_FileCount -= 1; + if (f->tempFile) { + res = Platform_Unlink((void*)f->workName, ((LONGINT)(101))); + } + } +} + +void Files_SetSearchPath (CHAR *path, LONGINT path__len) +{ + __DUP(path, path__len, CHAR); + if (Strings_Length(path, path__len) != 0) { + Files_SearchPath = __NEWARR(NIL, ((LONGINT)(1)), 1, 1, 1, (LONGINT)(Strings_Length(path, path__len) + 1)); + __COPY(path, Files_SearchPath->data, Files_SearchPath->len[0]); + } else { + Files_SearchPath = NIL; + } + __DEL(path); +} + +static void Files_Init (void) +{ + LONGINT i; + i = 0; + while (i < 256) { + Files_fileTab[i] = 0; + i += 1; + } + Files_tempno = -1; + Heap_FileCount = 0; + Files_SearchPath = NIL; + Files_HOME[0] = 0x00; + Platform_GetEnv((CHAR*)"HOME", (LONGINT)5, (void*)Files_HOME, ((LONGINT)(1024))); +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(Files_SearchPath); +} + +__TDESC(Files_Handle, 1, 4) = {__TDFLDS("Handle", 256), {236, 240, 244, 248, -20}}; +__TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4112), {0, -8}}; +__TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 20), {8, -8}}; + +export void *Files__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Console); + __MODULE_IMPORT(Heap); + __MODULE_IMPORT(Platform); + __MODULE_IMPORT(Strings); + __REGMOD("Files", EnumPtrs); + __INITYP(Files_Handle, Files_Handle, 0); + __INITYP(Files_BufDesc, Files_BufDesc, 0); + __INITYP(Files_Rider, Files_Rider, 0); +/* BEGIN */ + Files_Init(); + __ENDMOD; +} diff --git a/bootstrap/windows-48/Files.h b/bootstrap/windows-48/Files.h new file mode 100644 index 00000000..226e2815 --- /dev/null +++ b/bootstrap/windows-48/Files.h @@ -0,0 +1,70 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tspkaSfF */ + +#ifndef Files__h +#define Files__h + +#include "SYSTEM.h" + +typedef + struct Files_Handle *Files_File; + +typedef + struct Files_Handle { + char _prvt0[224]; + LONGINT fd; + char _prvt1[28]; + } Files_Handle; + +typedef + struct Files_Rider { + LONGINT res; + BOOLEAN eof; + char _prvt0[15]; + } Files_Rider; + + + +import LONGINT *Files_Handle__typ; +import LONGINT *Files_Rider__typ; + +import Files_File Files_Base (Files_Rider *r, LONGINT *r__typ); +import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res); +import void Files_Close (Files_File f); +import void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res); +import void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d); +import void Files_GetName (Files_File f, CHAR *name, LONGINT name__len); +import LONGINT Files_Length (Files_File f); +import Files_File Files_New (CHAR *name, LONGINT name__len); +import Files_File Files_Old (CHAR *name, LONGINT name__len); +import LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ); +import void Files_Purge (Files_File f); +import void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x); +import void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x); +import void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len); +import void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n); +import void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x); +import void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x); +import void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x); +import void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +import void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x); +import void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x); +import void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x); +import void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +import void Files_Register (Files_File f); +import void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res); +import void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos); +import void Files_SetSearchPath (CHAR *path, LONGINT path__len); +import void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x); +import void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x); +import void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n); +import void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x); +import void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x); +import void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x); +import void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x); +import void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x); +import void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x); +import void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +import void *Files__init(void); + + +#endif diff --git a/bootstrap/windows-48/Heap.c b/bootstrap/windows-48/Heap.c new file mode 100644 index 00000000..cbb21626 --- /dev/null +++ b/bootstrap/windows-48/Heap.c @@ -0,0 +1,752 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tskSfF */ +#include "SYSTEM.h" + +struct Heap__1 { + CHAR ch; + SYSTEM_PTR p; +}; + +typedef + struct Heap_CmdDesc *Heap_Cmd; + +typedef + CHAR Heap_CmdName[24]; + +typedef + void (*Heap_Command)(void); + +typedef + struct Heap_CmdDesc { + Heap_Cmd next; + Heap_CmdName name; + Heap_Command cmd; + } Heap_CmdDesc; + +typedef + void (*Heap_EnumProc)(void(*)(SYSTEM_PTR)); + +typedef + struct Heap_FinDesc *Heap_FinNode; + +typedef + void (*Heap_Finalizer)(SYSTEM_PTR); + +typedef + struct Heap_FinDesc { + Heap_FinNode next; + LONGINT obj; + BOOLEAN marked; + Heap_Finalizer finalize; + } Heap_FinDesc; + +typedef + struct Heap_ModuleDesc *Heap_Module; + +typedef + CHAR Heap_ModuleName[20]; + +typedef + struct Heap_ModuleDesc { + Heap_Module next; + Heap_ModuleName name; + LONGINT refcnt; + Heap_Cmd cmds; + LONGINT types; + Heap_EnumProc enumPtrs; + LONGINT reserved1, reserved2; + } Heap_ModuleDesc; + + +export SYSTEM_PTR Heap_modules; +static LONGINT Heap_freeList[10]; +static LONGINT Heap_bigBlocks; +export LONGINT Heap_allocated; +static BOOLEAN Heap_firstTry; +static LONGINT Heap_heap, Heap_heapend; +export LONGINT Heap_heapsize; +static Heap_FinNode Heap_fin; +static INTEGER Heap_lockdepth; +static BOOLEAN Heap_interrupted; +export INTEGER Heap_FileCount; + +export LONGINT *Heap_ModuleDesc__typ; +export LONGINT *Heap_CmdDesc__typ; +export LONGINT *Heap_FinDesc__typ; +export LONGINT *Heap__1__typ; + +static void Heap_CheckFin (void); +static void Heap_ExtendHeap (LONGINT blksz); +export void Heap_FINALL (void); +static void Heap_Finalize (void); +export void Heap_GC (BOOLEAN markStack); +static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len); +export void Heap_INCREF (Heap_Module m); +export void Heap_InitHeap (void); +export void Heap_Lock (void); +static void Heap_Mark (LONGINT q); +static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len); +static void Heap_MarkP (SYSTEM_PTR p); +static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len); +export SYSTEM_PTR Heap_NEWBLK (LONGINT size); +export SYSTEM_PTR Heap_NEWREC (LONGINT tag); +static LONGINT Heap_NewChunk (LONGINT blksz); +export void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd); +export SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs); +export void Heap_REGTYP (Heap_Module m, LONGINT typ); +export void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize); +static void Heap_Scan (void); +static void Heap_Sift (LONGINT l, LONGINT r, LONGINT *a, LONGINT a__len); +export void Heap_Unlock (void); + +extern void *Heap__init(); +extern LONGINT Platform_MainStackFrame; +extern LONGINT Platform_OSAllocate(LONGINT size); +#define Heap_FetchAddress(pointer) (LONGINT)(uintptr_t)(*((void**)((uintptr_t)pointer))) +#define Heap_HeapModuleInit() Heap__init() +#define Heap_OSAllocate(size) Platform_OSAllocate(size) +#define Heap_PlatformHalt(code) Platform_Halt(code) +#define Heap_PlatformMainStackFrame() Platform_MainStackFrame + +void Heap_Lock (void) +{ + Heap_lockdepth += 1; +} + +void Heap_Unlock (void) +{ + Heap_lockdepth -= 1; + if ((Heap_interrupted && Heap_lockdepth == 0)) { + Heap_PlatformHalt(((LONGINT)(-9))); + } +} + +SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs) +{ + SYSTEM_PTR _o_result; + Heap_Module m; + if (__STRCMP(name, "Heap") == 0) { + __SYSNEW(m, 48); + } else { + __NEW(m, Heap_ModuleDesc); + } + m->types = 0; + m->cmds = NIL; + __COPY(name, m->name, ((LONGINT)(20))); + m->refcnt = 0; + m->enumPtrs = enumPtrs; + m->next = (Heap_Module)(uintptr_t)Heap_modules; + Heap_modules = (SYSTEM_PTR)m; + _o_result = (void*)m; + return _o_result; +} + +void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd) +{ + Heap_Cmd c; + if (__STRCMP(m->name, "Heap") == 0) { + __SYSNEW(c, 32); + } else { + __NEW(c, Heap_CmdDesc); + } + __COPY(name, c->name, ((LONGINT)(24))); + c->cmd = cmd; + c->next = m->cmds; + m->cmds = c; +} + +void Heap_REGTYP (Heap_Module m, LONGINT typ) +{ + __PUT(typ, m->types, LONGINT); + m->types = typ; +} + +void Heap_INCREF (Heap_Module m) +{ + m->refcnt += 1; +} + +static LONGINT Heap_NewChunk (LONGINT blksz) +{ + LONGINT _o_result; + LONGINT chnk; + chnk = Heap_OSAllocate(blksz + 12); + if (chnk != 0) { + __PUT(chnk + 4, chnk + (12 + blksz), LONGINT); + __PUT(chnk + 12, chnk + 16, LONGINT); + __PUT(chnk + 16, blksz, LONGINT); + __PUT(chnk + 20, -4, LONGINT); + __PUT(chnk + 24, Heap_bigBlocks, LONGINT); + Heap_bigBlocks = chnk + 12; + Heap_heapsize += blksz; + } + _o_result = chnk; + return _o_result; +} + +static void Heap_ExtendHeap (LONGINT blksz) +{ + LONGINT size, chnk, j, next; + if (blksz > 160000) { + size = blksz; + } else { + size = 160000; + } + chnk = Heap_NewChunk(size); + if (chnk != 0) { + if (chnk < Heap_heap) { + __PUT(chnk, Heap_heap, LONGINT); + Heap_heap = chnk; + } else { + j = Heap_heap; + next = Heap_FetchAddress(j); + while ((next != 0 && chnk > next)) { + j = next; + next = Heap_FetchAddress(j); + } + __PUT(chnk, next, LONGINT); + __PUT(j, chnk, LONGINT); + } + if (next == 0) { + Heap_heapend = Heap_FetchAddress(chnk + 4); + } + } +} + +SYSTEM_PTR Heap_NEWREC (LONGINT tag) +{ + SYSTEM_PTR _o_result; + LONGINT i, i0, di, blksz, restsize, t, adr, end, next, prev; + SYSTEM_PTR new; + Heap_Lock(); + blksz = Heap_FetchAddress(tag); + i0 = __ASHR(blksz, 4); + i = i0; + if (i < 9) { + adr = Heap_freeList[i]; + while (adr == 0) { + i += 1; + adr = Heap_freeList[i]; + } + } + if (i < 9) { + next = Heap_FetchAddress(adr + 12); + Heap_freeList[i] = next; + if (i != i0) { + di = i - i0; + restsize = __ASHL(di, 4); + end = adr + restsize; + __PUT(end + 4, blksz, LONGINT); + __PUT(end + 8, -4, LONGINT); + __PUT(end, end + 4, LONGINT); + __PUT(adr + 4, restsize, LONGINT); + __PUT(adr + 12, Heap_freeList[di], LONGINT); + Heap_freeList[di] = adr; + adr += restsize; + } + } else { + adr = Heap_bigBlocks; + prev = 0; + for (;;) { + if (adr == 0) { + if (Heap_firstTry) { + Heap_GC(1); + blksz += 16; + if (__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2) < Heap_heapsize) { + Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize); + } + Heap_firstTry = 0; + new = Heap_NEWREC(tag); + Heap_firstTry = 1; + if (new == NIL) { + Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize); + new = Heap_NEWREC(tag); + } + Heap_Unlock(); + _o_result = new; + return _o_result; + } else { + Heap_Unlock(); + _o_result = NIL; + return _o_result; + } + } + t = Heap_FetchAddress(adr + 4); + if (t >= blksz) { + break; + } + prev = adr; + adr = Heap_FetchAddress(adr + 12); + } + restsize = t - blksz; + end = adr + restsize; + __PUT(end + 4, blksz, LONGINT); + __PUT(end + 8, -4, LONGINT); + __PUT(end, end + 4, LONGINT); + if (restsize > 144) { + __PUT(adr + 4, restsize, LONGINT); + } else { + next = Heap_FetchAddress(adr + 12); + if (prev == 0) { + Heap_bigBlocks = next; + } else { + __PUT(prev + 12, next, LONGINT); + } + if (restsize > 0) { + di = __ASHR(restsize, 4); + __PUT(adr + 4, restsize, LONGINT); + __PUT(adr + 12, Heap_freeList[di], LONGINT); + Heap_freeList[di] = adr; + } + } + adr += restsize; + } + i = adr + 16; + end = adr + blksz; + while (i < end) { + __PUT(i, 0, LONGINT); + __PUT(i + 4, 0, LONGINT); + __PUT(i + 8, 0, LONGINT); + __PUT(i + 12, 0, LONGINT); + i += 16; + } + __PUT(adr + 12, 0, LONGINT); + __PUT(adr, tag, LONGINT); + __PUT(adr + 4, 0, LONGINT); + __PUT(adr + 8, 0, LONGINT); + Heap_allocated += blksz; + Heap_Unlock(); + _o_result = (SYSTEM_PTR)(uintptr_t)(adr + 4); + return _o_result; +} + +SYSTEM_PTR Heap_NEWBLK (LONGINT size) +{ + SYSTEM_PTR _o_result; + LONGINT blksz, tag; + SYSTEM_PTR new; + Heap_Lock(); + blksz = __ASHL(__ASHR(size + 31, 4), 4); + new = Heap_NEWREC((LONGINT)(uintptr_t)&blksz); + tag = ((LONGINT)(uintptr_t)new + blksz) - 12; + __PUT(tag - 4, 0, LONGINT); + __PUT(tag, blksz, LONGINT); + __PUT(tag + 4, -4, LONGINT); + __PUT((LONGINT)(uintptr_t)new - 4, tag, LONGINT); + Heap_Unlock(); + _o_result = new; + return _o_result; +} + +static void Heap_Mark (LONGINT q) +{ + LONGINT p, tag, fld, n, offset, tagbits; + if (q != 0) { + tagbits = Heap_FetchAddress(q - 4); + if (!__ODD(tagbits)) { + __PUT(q - 4, tagbits + 1, LONGINT); + p = 0; + tag = tagbits + 4; + for (;;) { + __GET(tag, offset, LONGINT); + if (offset < 0) { + __PUT(q - 4, (tag + offset) + 1, LONGINT); + if (p == 0) { + break; + } + n = q; + q = p; + tag = Heap_FetchAddress(q - 4); + tag -= 1; + __GET(tag, offset, LONGINT); + fld = q + offset; + p = Heap_FetchAddress(fld); + __PUT(fld, (SYSTEM_PTR)(uintptr_t)n, SYSTEM_PTR); + } else { + fld = q + offset; + n = Heap_FetchAddress(fld); + if (n != 0) { + tagbits = Heap_FetchAddress(n - 4); + if (!__ODD(tagbits)) { + __PUT(n - 4, tagbits + 1, LONGINT); + __PUT(q - 4, tag + 1, LONGINT); + __PUT(fld, (SYSTEM_PTR)(uintptr_t)p, SYSTEM_PTR); + p = q; + q = n; + tag = tagbits; + } + } + } + tag += 4; + } + } + } +} + +static void Heap_MarkP (SYSTEM_PTR p) +{ + Heap_Mark((LONGINT)(uintptr_t)p); +} + +static void Heap_Scan (void) +{ + LONGINT chnk, adr, end, start, tag, i, size, freesize; + Heap_bigBlocks = 0; + i = 1; + while (i < 9) { + Heap_freeList[i] = 0; + i += 1; + } + freesize = 0; + Heap_allocated = 0; + chnk = Heap_heap; + while (chnk != 0) { + adr = chnk + 12; + end = Heap_FetchAddress(chnk + 4); + while (adr < end) { + tag = Heap_FetchAddress(adr); + if (__ODD(tag)) { + if (freesize > 0) { + start = adr - freesize; + __PUT(start, start + 4, LONGINT); + __PUT(start + 4, freesize, LONGINT); + __PUT(start + 8, -4, LONGINT); + i = __ASHR(freesize, 4); + freesize = 0; + if (i < 9) { + __PUT(start + 12, Heap_freeList[i], LONGINT); + Heap_freeList[i] = start; + } else { + __PUT(start + 12, Heap_bigBlocks, LONGINT); + Heap_bigBlocks = start; + } + } + tag -= 1; + __PUT(adr, tag, LONGINT); + size = Heap_FetchAddress(tag); + Heap_allocated += size; + adr += size; + } else { + size = Heap_FetchAddress(tag); + freesize += size; + adr += size; + } + } + if (freesize > 0) { + start = adr - freesize; + __PUT(start, start + 4, LONGINT); + __PUT(start + 4, freesize, LONGINT); + __PUT(start + 8, -4, LONGINT); + i = __ASHR(freesize, 4); + freesize = 0; + if (i < 9) { + __PUT(start + 12, Heap_freeList[i], LONGINT); + Heap_freeList[i] = start; + } else { + __PUT(start + 12, Heap_bigBlocks, LONGINT); + Heap_bigBlocks = start; + } + } + chnk = Heap_FetchAddress(chnk); + } +} + +static void Heap_Sift (LONGINT l, LONGINT r, LONGINT *a, LONGINT a__len) +{ + LONGINT i, j, x; + j = l; + x = a[j]; + for (;;) { + i = j; + j = __ASHL(j, 1) + 1; + if ((j < r && a[j] < a[j + 1])) { + j += 1; + } + if (j > r || a[j] <= x) { + break; + } + a[i] = a[j]; + } + a[i] = x; +} + +static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len) +{ + LONGINT l, r, x; + l = __ASHR(n, 1); + r = n - 1; + while (l > 0) { + l -= 1; + Heap_Sift(l, r, (void*)a, a__len); + } + while (r > 0) { + x = a[0]; + a[0] = a[r]; + a[r] = x; + r -= 1; + Heap_Sift(l, r, (void*)a, a__len); + } +} + +static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len) +{ + LONGINT chnk, adr, tag, next, lim, lim1, i, ptr, size; + chnk = Heap_heap; + i = 0; + lim = cand[n - 1]; + while ((chnk != 0 && chnk < lim)) { + adr = chnk + 12; + lim1 = Heap_FetchAddress(chnk + 4); + if (lim < lim1) { + lim1 = lim; + } + while (adr < lim1) { + tag = Heap_FetchAddress(adr); + if (__ODD(tag)) { + size = Heap_FetchAddress(tag - 1); + adr += size; + } else { + size = Heap_FetchAddress(tag); + ptr = adr + 4; + while (cand[i] < ptr) { + i += 1; + } + if (i == n) { + return; + } + next = adr + size; + if (cand[i] < next) { + Heap_Mark(ptr); + } + adr = next; + } + } + chnk = Heap_FetchAddress(chnk); + } +} + +static void Heap_CheckFin (void) +{ + Heap_FinNode n; + LONGINT tag; + n = Heap_fin; + while (n != NIL) { + tag = Heap_FetchAddress(n->obj - 4); + if (!__ODD(tag)) { + n->marked = 0; + Heap_Mark(n->obj); + } else { + n->marked = 1; + } + n = n->next; + } +} + +static void Heap_Finalize (void) +{ + Heap_FinNode n, prev; + n = Heap_fin; + prev = NIL; + while (n != NIL) { + if (!n->marked) { + if (n == Heap_fin) { + Heap_fin = Heap_fin->next; + } else { + prev->next = n->next; + } + (*n->finalize)((SYSTEM_PTR)(uintptr_t)n->obj); + if (prev == NIL) { + n = Heap_fin; + } else { + n = n->next; + } + } else { + prev = n; + n = n->next; + } + } +} + +void Heap_FINALL (void) +{ + Heap_FinNode n; + while (Heap_fin != NIL) { + n = Heap_fin; + Heap_fin = Heap_fin->next; + (*n->finalize)((SYSTEM_PTR)(uintptr_t)n->obj); + } +} + +static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len) +{ + SYSTEM_PTR frame; + LONGINT inc, nofcand, sp, p, stack0, ptr; + struct Heap__1 align; + if (n > 0) { + Heap_MarkStack(n - 1, cand, cand__len); + if (n > 100) { + return; + } + } + if (n == 0) { + nofcand = 0; + sp = (LONGINT)(uintptr_t)&frame; + stack0 = Heap_PlatformMainStackFrame(); + inc = (LONGINT)(uintptr_t)&align.p - (LONGINT)(uintptr_t)&align; + if (sp > stack0) { + inc = -inc; + } + while (sp != stack0) { + __GET(sp, p, LONGINT); + if ((p > Heap_heap && p < Heap_heapend)) { + if (nofcand == cand__len) { + Heap_HeapSort(nofcand, (void*)cand, cand__len); + Heap_MarkCandidates(nofcand, (void*)cand, cand__len); + nofcand = 0; + } + cand[nofcand] = p; + nofcand += 1; + } + sp += inc; + } + if (nofcand > 0) { + Heap_HeapSort(nofcand, (void*)cand, cand__len); + Heap_MarkCandidates(nofcand, (void*)cand, cand__len); + } + } +} + +void Heap_GC (BOOLEAN markStack) +{ + Heap_Module m; + LONGINT i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23; + LONGINT cand[10000]; + if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) { + Heap_Lock(); + m = (Heap_Module)(uintptr_t)Heap_modules; + while (m != NIL) { + if (m->enumPtrs != NIL) { + (*m->enumPtrs)(Heap_MarkP); + } + m = m->next; + } + if (markStack) { + i0 = -100; + i1 = -101; + i2 = -102; + i3 = -103; + i4 = -104; + i5 = -105; + i6 = -106; + i7 = -107; + i8 = 1; + i9 = 2; + i10 = 3; + i11 = 4; + i12 = 5; + i13 = 6; + i14 = 7; + i15 = 8; + i16 = 9; + i17 = 10; + i18 = 11; + i19 = 12; + i20 = 13; + i21 = 14; + i22 = 15; + i23 = 16; + for (;;) { + i0 += 1; + i1 += 2; + i2 += 3; + i3 += 4; + i4 += 5; + i5 += 6; + i6 += 7; + i7 += 8; + i8 += 9; + i9 += 10; + i10 += 11; + i11 += 12; + i12 += 13; + i13 += 14; + i14 += 15; + i15 += 16; + i16 += 17; + i17 += 18; + i18 += 19; + i19 += 20; + i20 += 21; + i21 += 22; + i22 += 23; + i23 += 24; + if ((i0 == -99 && i15 == 24)) { + Heap_MarkStack(((LONGINT)(32)), (void*)cand, ((LONGINT)(10000))); + break; + } + } + if (((((((((((((((((((((((i0 + i1) + i2) + i3) + i4) + i5) + i6) + i7) + i8) + i9) + i10) + i11) + i12) + i13) + i14) + i15) + i16) + i17) + i18) + i19) + i20) + i21) + i22) + i23 > 10000) { + return; + } + } + Heap_CheckFin(); + Heap_Scan(); + Heap_Finalize(); + Heap_Unlock(); + } +} + +void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize) +{ + Heap_FinNode f; + __NEW(f, Heap_FinDesc); + f->obj = (LONGINT)(uintptr_t)obj; + f->finalize = finalize; + f->marked = 1; + f->next = Heap_fin; + Heap_fin = f; +} + +void Heap_InitHeap (void) +{ + Heap_heap = Heap_NewChunk(128000); + Heap_heapend = Heap_FetchAddress(Heap_heap + 4); + __PUT(Heap_heap, 0, LONGINT); + Heap_allocated = 0; + Heap_firstTry = 1; + Heap_freeList[9] = 1; + Heap_lockdepth = 0; + Heap_FileCount = 0; + Heap_modules = NIL; + Heap_heapsize = 0; + Heap_bigBlocks = 0; + Heap_fin = NIL; + Heap_interrupted = 0; + Heap_HeapModuleInit(); +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(Heap_modules); + P(Heap_fin); +} + +__TDESC(Heap_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 48), {0, 28, -12}}; +__TDESC(Heap_CmdDesc, 1, 1) = {__TDFLDS("CmdDesc", 32), {0, -8}}; +__TDESC(Heap_FinDesc, 1, 1) = {__TDFLDS("FinDesc", 16), {0, -8}}; +__TDESC(Heap__1, 1, 1) = {__TDFLDS("", 8), {4, -8}}; + +export void *Heap__init(void) +{ + __DEFMOD; + __REGMOD("Heap", EnumPtrs); + __REGCMD("FINALL", Heap_FINALL); + __REGCMD("InitHeap", Heap_InitHeap); + __REGCMD("Lock", Heap_Lock); + __REGCMD("Unlock", Heap_Unlock); + __INITYP(Heap_ModuleDesc, Heap_ModuleDesc, 0); + __INITYP(Heap_CmdDesc, Heap_CmdDesc, 0); + __INITYP(Heap_FinDesc, Heap_FinDesc, 0); + __INITYP(Heap__1, Heap__1, 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/windows-48/Heap.h b/bootstrap/windows-48/Heap.h new file mode 100644 index 00000000..d270a455 --- /dev/null +++ b/bootstrap/windows-48/Heap.h @@ -0,0 +1,54 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tskSfF */ + +#ifndef Heap__h +#define Heap__h + +#include "SYSTEM.h" + +typedef + CHAR Heap_CmdName[24]; + +typedef + void (*Heap_Command)(void); + +typedef + void (*Heap_EnumProc)(void(*)(SYSTEM_PTR)); + +typedef + void (*Heap_Finalizer)(SYSTEM_PTR); + +typedef + struct Heap_ModuleDesc *Heap_Module; + +typedef + struct Heap_ModuleDesc { + LONGINT _prvt0; + char _prvt1[44]; + } Heap_ModuleDesc; + +typedef + CHAR Heap_ModuleName[20]; + + +import SYSTEM_PTR Heap_modules; +import LONGINT Heap_allocated, Heap_heapsize; +import INTEGER Heap_FileCount; + +import LONGINT *Heap_ModuleDesc__typ; + +import void Heap_FINALL (void); +import void Heap_GC (BOOLEAN markStack); +import void Heap_INCREF (Heap_Module m); +import void Heap_InitHeap (void); +import void Heap_Lock (void); +import SYSTEM_PTR Heap_NEWBLK (LONGINT size); +import SYSTEM_PTR Heap_NEWREC (LONGINT tag); +import void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd); +import SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs); +import void Heap_REGTYP (Heap_Module m, LONGINT typ); +import void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize); +import void Heap_Unlock (void); +import void *Heap__init(void); + + +#endif diff --git a/bootstrap/windows-48/Modules.c b/bootstrap/windows-48/Modules.c new file mode 100644 index 00000000..6c0f5e0b --- /dev/null +++ b/bootstrap/windows-48/Modules.c @@ -0,0 +1,171 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "Console.h" +#include "Heap.h" + +typedef + struct Modules_CmdDesc *Modules_Cmd; + +typedef + void (*Modules_Command)(void); + +typedef + struct Modules_CmdDesc { + Modules_Cmd next; + CHAR name[24]; + Modules_Command cmd; + } Modules_CmdDesc; + +typedef + struct Modules_ModuleDesc *Modules_Module; + +typedef + CHAR Modules_ModuleName[20]; + +typedef + struct Modules_ModuleDesc { + Modules_Module next; + Modules_ModuleName name; + LONGINT refcnt; + Modules_Cmd cmds; + LONGINT types; + void (*enumPtrs)(void(*)(LONGINT)); + LONGINT reserved1, reserved2; + } Modules_ModuleDesc; + + +export INTEGER Modules_res; +export CHAR Modules_resMsg[256]; +export Modules_ModuleName Modules_imported, Modules_importing; + +export LONGINT *Modules_ModuleDesc__typ; +export LONGINT *Modules_CmdDesc__typ; + +static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len); +export void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all); +export Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len); +export Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len); + +#define Modules_modules() (Modules_Module)Heap_modules +#define Modules_setmodules(m) Heap_modules = m + +static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len) +{ + INTEGER i, j; + __DUP(b, b__len, CHAR); + i = 0; + while (a[__X(i, a__len)] != 0x00) { + i += 1; + } + j = 0; + while (b[__X(j, b__len)] != 0x00) { + a[__X(i, a__len)] = b[__X(j, b__len)]; + i += 1; + j += 1; + } + a[__X(i, a__len)] = 0x00; + __DEL(b); +} + +Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len) +{ + Modules_Module _o_result; + Modules_Module m = NIL; + CHAR bodyname[64]; + Modules_Command body; + __DUP(name, name__len, CHAR); + m = Modules_modules(); + while ((m != NIL && __STRCMP(m->name, name) != 0)) { + m = m->next; + } + if (m != NIL) { + Modules_res = 0; + Modules_resMsg[0] = 0x00; + } else { + Modules_res = 1; + __COPY(name, Modules_importing, ((LONGINT)(20))); + __MOVE(" module \"", Modules_resMsg, 10); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), name, name__len); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)"\" not found", (LONGINT)12); + } + _o_result = m; + __DEL(name); + return _o_result; +} + +Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len) +{ + Modules_Command _o_result; + Modules_Cmd c = NIL; + __DUP(name, name__len, CHAR); + c = mod->cmds; + while ((c != NIL && __STRCMP(c->name, name) != 0)) { + c = c->next; + } + if (c != NIL) { + Modules_res = 0; + Modules_resMsg[0] = 0x00; + _o_result = c->cmd; + __DEL(name); + return _o_result; + } else { + Modules_res = 2; + __MOVE(" command \"", Modules_resMsg, 11); + __COPY(name, Modules_importing, ((LONGINT)(20))); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), mod->name, ((LONGINT)(20))); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)".", (LONGINT)2); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), name, name__len); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)"\" not found", (LONGINT)12); + _o_result = NIL; + __DEL(name); + return _o_result; + } + __RETCHK; +} + +void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all) +{ + Modules_Module m = NIL, p = NIL; + __DUP(name, name__len, CHAR); + m = Modules_modules(); + if (all) { + Modules_res = 1; + __MOVE("unloading \"all\" not yet supported", Modules_resMsg, 34); + } else { + while ((m != NIL && __STRCMP(m->name, name) != 0)) { + p = m; + m = m->next; + } + if ((m != NIL && m->refcnt == 0)) { + if (m == Modules_modules()) { + Modules_setmodules(m->next); + } else { + p->next = m->next; + } + Modules_res = 0; + } else { + Modules_res = 1; + if (m == NIL) { + __MOVE("module not found", Modules_resMsg, 17); + } else { + __MOVE("clients of this module exist", Modules_resMsg, 29); + } + } + } + __DEL(name); +} + +__TDESC(Modules_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 48), {0, 28, -12}}; +__TDESC(Modules_CmdDesc, 1, 1) = {__TDFLDS("CmdDesc", 32), {0, -8}}; + +export void *Modules__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Console); + __MODULE_IMPORT(Heap); + __REGMOD("Modules", 0); + __INITYP(Modules_ModuleDesc, Modules_ModuleDesc, 0); + __INITYP(Modules_CmdDesc, Modules_CmdDesc, 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/windows-48/Modules.h b/bootstrap/windows-48/Modules.h new file mode 100644 index 00000000..5968d1aa --- /dev/null +++ b/bootstrap/windows-48/Modules.h @@ -0,0 +1,54 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Modules__h +#define Modules__h + +#include "SYSTEM.h" + +typedef + struct Modules_CmdDesc *Modules_Cmd; + +typedef + void (*Modules_Command)(void); + +typedef + struct Modules_CmdDesc { + Modules_Cmd next; + CHAR name[24]; + Modules_Command cmd; + } Modules_CmdDesc; + +typedef + struct Modules_ModuleDesc *Modules_Module; + +typedef + CHAR Modules_ModuleName[20]; + +typedef + struct Modules_ModuleDesc { + Modules_Module next; + Modules_ModuleName name; + LONGINT refcnt; + Modules_Cmd cmds; + LONGINT types; + void (*enumPtrs)(void(*)(LONGINT)); + char _prvt0[8]; + } Modules_ModuleDesc; + + +import INTEGER Modules_res; +import CHAR Modules_resMsg[256]; +import Modules_ModuleName Modules_imported, Modules_importing; + +import LONGINT *Modules_ModuleDesc__typ; +import LONGINT *Modules_CmdDesc__typ; + +import void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all); +import Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len); +import Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len); +import void *Modules__init(void); + +#define Modules_modules() (Modules_Module)Heap_modules +#define Modules_setmodules(m) Heap_modules = m + +#endif diff --git a/bootstrap/windows-48/OPB.c b/bootstrap/windows-48/OPB.c new file mode 100644 index 00000000..0c22a7a7 --- /dev/null +++ b/bootstrap/windows-48/OPB.c @@ -0,0 +1,2677 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "OPM.h" +#include "OPS.h" +#include "OPT.h" + + +export void (*OPB_typSize)(OPT_Struct); +static INTEGER OPB_exp; +static LONGINT OPB_maxExp; + + +export void OPB_Assign (OPT_Node *x, OPT_Node y); +static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node y); +static LONGINT OPB_BoolToInt (BOOLEAN b); +export void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp); +static void OPB_CharToString (OPT_Node n); +static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode); +static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo); +export void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames); +static void OPB_CheckProc (OPT_Struct x, OPT_Object y); +static void OPB_CheckPtr (OPT_Node x, OPT_Node y); +static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x); +static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp); +static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y); +export void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y); +static void OPB_Convert (OPT_Node *x, OPT_Struct typ); +export void OPB_DeRef (OPT_Node *x); +static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar); +export OPT_Node OPB_EmptySet (void); +export void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc); +export void OPB_Field (OPT_Node *x, OPT_Object y); +export void OPB_In (OPT_Node *x, OPT_Node y); +export void OPB_Index (OPT_Node *x, OPT_Node y); +export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ); +static BOOLEAN OPB_IntToBool (LONGINT i); +export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y); +export void OPB_MOp (SHORTINT op, OPT_Node *x); +export OPT_Node OPB_NewBoolConst (BOOLEAN boolval); +export OPT_Node OPB_NewIntConst (LONGINT intval); +export OPT_Node OPB_NewLeaf (OPT_Object obj); +export OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ); +export OPT_Node OPB_NewString (OPS_String str, LONGINT len); +export OPT_Node OPB_Nil (void); +static BOOLEAN OPB_NotVar (OPT_Node x); +export void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y); +export void OPB_OptIf (OPT_Node *x); +export void OPB_Param (OPT_Node ap, OPT_Object fp); +export void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar); +export void OPB_Return (OPT_Node *x, OPT_Object proc); +export void OPB_SetElem (OPT_Node *x); +static void OPB_SetIntType (OPT_Node node); +export void OPB_SetRange (OPT_Node *x, OPT_Node y); +export void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno); +export void OPB_StPar0 (OPT_Node *par0, INTEGER fctno); +export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno); +export void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n); +export void OPB_StaticLink (SHORTINT dlev); +export void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard); +static void OPB_err (INTEGER n); +static LONGINT OPB_log (LONGINT x); + + +static void OPB_err (INTEGER n) +{ + OPM_err(n); +} + +OPT_Node OPB_NewLeaf (OPT_Object obj) +{ + OPT_Node _o_result; + OPT_Node node = NIL; + switch (obj->mode) { + case 1: + node = OPT_NewNode(0); + node->readonly = (obj->vis == 2 && obj->mnolev < 0); + break; + case 2: + node = OPT_NewNode(1); + break; + case 3: + node = OPT_NewNode(7); + node->conval = OPT_NewConst(); + __GUARDEQP(node->conval, OPT_ConstDesc) = *obj->conval; + break; + case 5: + node = OPT_NewNode(8); + break; + case 6: case 7: case 8: case 9: case 10: + node = OPT_NewNode(9); + break; + default: + OPB_err(127); + node = OPT_NewNode(0); + break; + } + node->obj = obj; + node->typ = obj->typ; + _o_result = node; + return _o_result; +} + +void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y) +{ + OPT_Node node = NIL; + node = OPT_NewNode(class); + node->typ = OPT_notyp; + node->left = *x; + node->right = y; + *x = node; +} + +void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y) +{ + if (*x == NIL) { + *x = y; + } else { + (*last)->link = y; + } + while (y->link != NIL) { + y = y->link; + } + *last = y; +} + +static LONGINT OPB_BoolToInt (BOOLEAN b) +{ + LONGINT _o_result; + if (b) { + _o_result = 1; + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +static BOOLEAN OPB_IntToBool (LONGINT i) +{ + BOOLEAN _o_result; + if (i == 0) { + _o_result = 0; + return _o_result; + } else { + _o_result = 1; + return _o_result; + } + __RETCHK; +} + +OPT_Node OPB_NewBoolConst (BOOLEAN boolval) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->typ = OPT_booltyp; + x->conval = OPT_NewConst(); + x->conval->intval = OPB_BoolToInt(boolval); + _o_result = x; + return _o_result; +} + +void OPB_OptIf (OPT_Node *x) +{ + OPT_Node if_ = NIL, pred = NIL; + if_ = (*x)->left; + while (if_->left->class == 7) { + if (OPB_IntToBool(if_->left->conval->intval)) { + *x = if_->right; + return; + } else if (if_->link == NIL) { + *x = (*x)->right; + return; + } else { + if_ = if_->link; + (*x)->left = if_; + } + } + pred = if_; + if_ = if_->link; + while (if_ != NIL) { + if (if_->left->class == 7) { + if (OPB_IntToBool(if_->left->conval->intval)) { + pred->link = NIL; + (*x)->right = if_->right; + return; + } else { + if_ = if_->link; + pred->link = if_; + } + } else { + pred = if_; + if_ = if_->link; + } + } +} + +OPT_Node OPB_Nil (void) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->typ = OPT_niltyp; + x->conval = OPT_NewConst(); + x->conval->intval = 0; + _o_result = x; + return _o_result; +} + +OPT_Node OPB_EmptySet (void) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->typ = OPT_settyp; + x->conval = OPT_NewConst(); + x->conval->setval = 0x0; + _o_result = x; + return _o_result; +} + +static void OPB_SetIntType (OPT_Node node) +{ + LONGINT v; + v = node->conval->intval; + if ((OPM_MinSInt <= (LONGINT)v && (LONGINT)v <= OPM_MaxSInt)) { + node->typ = OPT_sinttyp; + } else if ((OPM_MinInt <= (LONGINT)v && (LONGINT)v <= OPM_MaxInt)) { + node->typ = OPT_inttyp; + } else if ((OPM_MinLInt <= v && v <= OPM_MaxLInt)) { + node->typ = OPT_linttyp; + } else { + OPB_err(203); + node->typ = OPT_sinttyp; + node->conval->intval = 1; + } +} + +OPT_Node OPB_NewIntConst (LONGINT intval) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->conval = OPT_NewConst(); + x->conval->intval = intval; + OPB_SetIntType(x); + _o_result = x; + return _o_result; +} + +OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->conval = OPT_NewConst(); + x->conval->realval = realval; + x->typ = typ; + x->conval->intval = -1; + _o_result = x; + return _o_result; +} + +OPT_Node OPB_NewString (OPS_String str, LONGINT len) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->conval = OPT_NewConst(); + x->typ = OPT_stringtyp; + x->conval->intval = -1; + x->conval->intval2 = len; + x->conval->ext = OPT_NewExt(); + __COPY(str, *x->conval->ext, ((LONGINT)(256))); + _o_result = x; + return _o_result; +} + +static void OPB_CharToString (OPT_Node n) +{ + CHAR ch; + n->typ = OPT_stringtyp; + ch = (CHAR)n->conval->intval; + n->conval->ext = OPT_NewExt(); + if (ch == 0x00) { + n->conval->intval2 = 1; + } else { + n->conval->intval2 = 2; + (*n->conval->ext)[1] = 0x00; + } + (*n->conval->ext)[0] = ch; + n->conval->intval = -1; + n->obj = NIL; +} + +static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node y) +{ + OPT_Node node = NIL; + node = OPT_NewNode(class); + node->typ = typ; + node->left = *x; + node->right = y; + *x = node; +} + +static BOOLEAN OPB_NotVar (OPT_Node x) +{ + BOOLEAN _o_result; + _o_result = (x->class >= 7 && ((x->class != 11 || x->subcl != 29) || x->left->class >= 7)); + return _o_result; +} + +void OPB_DeRef (OPT_Node *x) +{ + OPT_Object strobj = NIL, bstrobj = NIL; + OPT_Struct typ = NIL, btyp = NIL; + typ = (*x)->typ; + if ((*x)->class >= 7) { + OPB_err(78); + } else if (typ->form == 13) { + if (typ == OPT_sysptrtyp) { + OPB_err(57); + } + btyp = typ->BaseTyp; + strobj = typ->strobj; + bstrobj = btyp->strobj; + if ((((((strobj != NIL && strobj->name[0] != 0x00)) && bstrobj != NIL)) && bstrobj->name[0] != 0x00)) { + btyp->pbused = 1; + } + OPB_BindNodes(3, btyp, &*x, NIL); + } else { + OPB_err(84); + } +} + +void OPB_Index (OPT_Node *x, OPT_Node y) +{ + INTEGER f; + OPT_Struct typ = NIL; + f = y->typ->form; + if ((*x)->class >= 7) { + OPB_err(79); + } else if (!__IN(f, 0x70) || __IN(y->class, 0x0300)) { + OPB_err(80); + y->typ = OPT_inttyp; + } + if ((*x)->typ->comp == 2) { + typ = (*x)->typ->BaseTyp; + if ((y->class == 7 && (y->conval->intval < 0 || y->conval->intval >= (*x)->typ->n))) { + OPB_err(81); + } + } else if ((*x)->typ->comp == 3) { + typ = (*x)->typ->BaseTyp; + if ((y->class == 7 && y->conval->intval < 0)) { + OPB_err(81); + } + } else { + OPB_err(82); + typ = OPT_undftyp; + } + OPB_BindNodes(4, typ, &*x, y); + (*x)->readonly = (*x)->left->readonly; +} + +void OPB_Field (OPT_Node *x, OPT_Object y) +{ + if ((*x)->class >= 7) { + OPB_err(77); + } + if ((y != NIL && __IN(y->mode, 0x2010))) { + OPB_BindNodes(2, y->typ, &*x, NIL); + (*x)->obj = y; + (*x)->readonly = (*x)->left->readonly || (y->vis == 2 && y->mnolev < 0); + } else { + OPB_err(83); + (*x)->typ = OPT_undftyp; + } +} + +static struct TypTest__57 { + OPT_Node *x; + OPT_Object *obj; + BOOLEAN *guard; + struct TypTest__57 *lnk; +} *TypTest__57_s; + +static void GTT__58 (OPT_Struct t0, OPT_Struct t1); + +static void GTT__58 (OPT_Struct t0, OPT_Struct t1) +{ + OPT_Node node = NIL; + OPT_Struct t = NIL; + t = t0; + while ((((t != NIL && t != t1)) && t != OPT_undftyp)) { + t = t->BaseTyp; + } + if (t != t1) { + while ((((t1 != NIL && t1 != t0)) && t1 != OPT_undftyp)) { + t1 = t1->BaseTyp; + } + if (t1 == t0 || t0->form == 0) { + if (*TypTest__57_s->guard) { + OPB_BindNodes(5, NIL, &*TypTest__57_s->x, NIL); + (*TypTest__57_s->x)->readonly = (*TypTest__57_s->x)->left->readonly; + } else { + node = OPT_NewNode(11); + node->subcl = 16; + node->left = *TypTest__57_s->x; + node->obj = *TypTest__57_s->obj; + *TypTest__57_s->x = node; + } + } else { + OPB_err(85); + } + } else if (t0 != t1) { + OPB_err(85); + } else if (!*TypTest__57_s->guard) { + if ((*TypTest__57_s->x)->class == 5) { + node = OPT_NewNode(11); + node->subcl = 16; + node->left = *TypTest__57_s->x; + node->obj = *TypTest__57_s->obj; + *TypTest__57_s->x = node; + } else { + *TypTest__57_s->x = OPB_NewBoolConst(1); + } + } +} + +void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard) +{ + struct TypTest__57 _s; + _s.x = x; + _s.obj = &obj; + _s.guard = &guard; + _s.lnk = TypTest__57_s; + TypTest__57_s = &_s; + if (OPB_NotVar(*x)) { + OPB_err(112); + } else if ((*x)->typ->form == 13) { + if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) { + OPB_err(85); + } else if (obj->typ->form == 13) { + GTT__58((*x)->typ->BaseTyp, obj->typ->BaseTyp); + } else { + OPB_err(86); + } + } else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) { + GTT__58((*x)->typ, obj->typ); + } else { + OPB_err(87); + } + if (guard) { + (*x)->typ = obj->typ; + } else { + (*x)->typ = OPT_booltyp; + } + TypTest__57_s = _s.lnk; +} + +void OPB_In (OPT_Node *x, OPT_Node y) +{ + INTEGER f; + LONGINT k; + f = (*x)->typ->form; + if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) { + OPB_err(126); + } else if ((__IN(f, 0x70) && y->typ->form == 9)) { + if ((*x)->class == 7) { + k = (*x)->conval->intval; + if (k < 0 || k > (LONGINT)OPM_MaxSet) { + OPB_err(202); + } else if (y->class == 7) { + (*x)->conval->intval = OPB_BoolToInt(__IN(k, y->conval->setval)); + (*x)->obj = NIL; + } else { + OPB_BindNodes(12, OPT_booltyp, &*x, y); + (*x)->subcl = 15; + } + } else { + OPB_BindNodes(12, OPT_booltyp, &*x, y); + (*x)->subcl = 15; + } + } else { + OPB_err(92); + } + (*x)->typ = OPT_booltyp; +} + +static LONGINT OPB_log (LONGINT x) +{ + LONGINT _o_result; + OPB_exp = 0; + if (x > 0) { + while (!__ODD(x)) { + x = __ASHR(x, 1); + OPB_exp += 1; + } + } + _o_result = x; + return _o_result; +} + +static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x) +{ + LONGREAL min, max, r; + if (f == 7) { + min = OPM_MinReal; + max = OPM_MaxReal; + } else { + min = OPM_MinLReal; + max = OPM_MaxLReal; + } + r = __ABS(x->realval); + if (r > max || r < min) { + OPB_err(nr); + x->realval = (LONGREAL)1; + } else if (f == 7) { + x->realval = x->realval; + } + x->intval = -1; +} + +static struct MOp__28 { + struct MOp__28 *lnk; +} *MOp__28_s; + +static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z); + +static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z) +{ + OPT_Node _o_result; + OPT_Node node = NIL; + node = OPT_NewNode(11); + node->subcl = op; + node->typ = typ; + node->left = z; + _o_result = node; + return _o_result; +} + +void OPB_MOp (SHORTINT op, OPT_Node *x) +{ + INTEGER f; + OPT_Struct typ = NIL; + OPT_Node z = NIL; + struct MOp__28 _s; + _s.lnk = MOp__28_s; + MOp__28_s = &_s; + z = *x; + if (z->class == 8 || z->class == 9) { + OPB_err(126); + } else { + typ = z->typ; + f = typ->form; + switch (op) { + case 33: + if (f == 2) { + if (z->class == 7) { + z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval)); + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(98); + } + break; + case 6: + if (!__IN(f, 0x01f0)) { + OPB_err(96); + } + break; + case 7: + if (__IN(f, 0x03f0)) { + if (z->class == 7) { + if (__IN(f, 0x70)) { + if (z->conval->intval == (-2147483647-1)) { + OPB_err(203); + } else { + z->conval->intval = -z->conval->intval; + OPB_SetIntType(z); + } + } else if (__IN(f, 0x0180)) { + z->conval->realval = -z->conval->realval; + } else { + z->conval->setval = ~z->conval->setval; + } + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(97); + } + break; + case 21: + if (__IN(f, 0x01f0)) { + if (z->class == 7) { + if (__IN(f, 0x70)) { + if (z->conval->intval == (-2147483647-1)) { + OPB_err(203); + } else { + z->conval->intval = __ABS(z->conval->intval); + OPB_SetIntType(z); + } + } else { + z->conval->realval = __ABS(z->conval->realval); + } + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(111); + } + break; + case 22: + if (f == 3) { + if (z->class == 7) { + z->conval->intval = (int)__CAP((CHAR)z->conval->intval); + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(111); + z->typ = OPT_chartyp; + } + break; + case 23: + if (__IN(f, 0x70)) { + if (z->class == 7) { + z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval)); + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(111); + } + z->typ = OPT_booltyp; + break; + case 24: + if ((((z->class == 7 && f == 3)) && z->conval->intval >= 32)) { + OPB_CharToString(z); + f = 10; + } + if (z->class < 7 || f == 10) { + z = NewOp__29(op, typ, z); + } else { + OPB_err(127); + } + z->typ = OPT_linttyp; + break; + case 25: + if ((__IN(f, 0x70) && z->class == 7)) { + if ((0 <= z->conval->intval && z->conval->intval <= -1)) { + z = NewOp__29(op, typ, z); + } else { + OPB_err(219); + } + } else { + OPB_err(69); + } + z->typ = OPT_booltyp; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.MOp, op = ", (LONGINT)33); + OPM_LogWNum(op, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } + *x = z; + MOp__28_s = _s.lnk; +} + +static void OPB_CheckPtr (OPT_Node x, OPT_Node y) +{ + INTEGER g; + OPT_Struct p = NIL, q = NIL, t = NIL; + g = y->typ->form; + if (g == 13) { + p = x->typ->BaseTyp; + q = y->typ->BaseTyp; + if ((p->comp == 4 && q->comp == 4)) { + if (p->extlev < q->extlev) { + t = p; + p = q; + q = t; + } + while ((((p != q && p != NIL)) && p != OPT_undftyp)) { + p = p->BaseTyp; + } + if (p == NIL) { + OPB_err(100); + } + } else { + OPB_err(100); + } + } else if (g != 11) { + OPB_err(100); + } +} + +void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames) +{ + OPT_Struct ft = NIL, at = NIL; + while (fp != NIL) { + if (ap != NIL) { + ft = fp->typ; + at = ap->typ; + while ((ft->comp == 3 && at->comp == 3)) { + ft = ft->BaseTyp; + at = at->BaseTyp; + } + if (ft != at) { + if ((ft->form == 14 && at->form == 14)) { + if (ft->BaseTyp == at->BaseTyp) { + OPB_CheckParameters(ft->link, at->link, 0); + } else { + OPB_err(117); + } + } else { + OPB_err(115); + } + } + if (fp->mode != ap->mode || (checkNames && __STRCMP(fp->name, ap->name) != 0)) { + OPB_err(115); + } + ap = ap->link; + } else { + OPB_err(116); + } + fp = fp->link; + } + if (ap != NIL) { + OPB_err(116); + } +} + +static void OPB_CheckProc (OPT_Struct x, OPT_Object y) +{ + if (__IN(y->mode, 0x04c0)) { + if (y->mode == 6) { + if (y->mnolev == 0) { + y->mode = 7; + } else { + OPB_err(73); + } + } + if (x->BaseTyp == y->typ) { + OPB_CheckParameters(x->link, y->link, 0); + } else { + OPB_err(117); + } + } else { + OPB_err(113); + } +} + +static struct ConstOp__13 { + OPT_Node *x; + INTEGER *f; + OPT_Const *xval, *yval; + struct ConstOp__13 *lnk; +} *ConstOp__13_s; + +static INTEGER ConstCmp__14 (void); + +static INTEGER ConstCmp__14 (void) +{ + INTEGER _o_result; + INTEGER res; + switch (*ConstOp__13_s->f) { + case 0: + res = 9; + break; + case 1: case 3: case 4: case 5: case 6: + if ((*ConstOp__13_s->xval)->intval < (*ConstOp__13_s->yval)->intval) { + res = 11; + } else if ((*ConstOp__13_s->xval)->intval > (*ConstOp__13_s->yval)->intval) { + res = 13; + } else { + res = 9; + } + break; + case 7: case 8: + if ((*ConstOp__13_s->xval)->realval < (*ConstOp__13_s->yval)->realval) { + res = 11; + } else if ((*ConstOp__13_s->xval)->realval > (*ConstOp__13_s->yval)->realval) { + res = 13; + } else { + res = 9; + } + break; + case 2: + if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) { + res = 10; + } else { + res = 9; + } + break; + case 9: + if ((*ConstOp__13_s->xval)->setval != (*ConstOp__13_s->yval)->setval) { + res = 10; + } else { + res = 9; + } + break; + case 10: + if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) < 0) { + res = 11; + } else if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) > 0) { + res = 13; + } else { + res = 9; + } + break; + case 11: case 13: case 14: + if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) { + res = 10; + } else { + res = 9; + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", (LONGINT)37); + OPM_LogWNum(*ConstOp__13_s->f, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + (*ConstOp__13_s->x)->typ = OPT_booltyp; + _o_result = res; + return _o_result; +} + +static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y) +{ + INTEGER f, g; + OPT_Const xval = NIL, yval = NIL; + LONGINT xv, yv; + BOOLEAN temp; + struct ConstOp__13 _s; + _s.x = &x; + _s.f = &f; + _s.xval = &xval; + _s.yval = &yval; + _s.lnk = ConstOp__13_s; + ConstOp__13_s = &_s; + f = x->typ->form; + g = y->typ->form; + xval = x->conval; + yval = y->conval; + if (f != g) { + switch (f) { + case 3: + if (g == 10) { + OPB_CharToString(x); + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 4: + if (__IN(g, 0x70)) { + x->typ = y->typ; + } else if (g == 7) { + x->typ = OPT_realtyp; + xval->realval = xval->intval; + } else if (g == 8) { + x->typ = OPT_lrltyp; + xval->realval = xval->intval; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 5: + if (g == 4) { + y->typ = OPT_inttyp; + } else if (__IN(g, 0x70)) { + x->typ = y->typ; + } else if (g == 7) { + x->typ = OPT_realtyp; + xval->realval = xval->intval; + } else if (g == 8) { + x->typ = OPT_lrltyp; + xval->realval = xval->intval; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 6: + if (__IN(g, 0x70)) { + y->typ = OPT_linttyp; + } else if (g == 7) { + x->typ = OPT_realtyp; + xval->realval = xval->intval; + } else if (g == 8) { + x->typ = OPT_lrltyp; + xval->realval = xval->intval; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 7: + if (__IN(g, 0x70)) { + y->typ = x->typ; + yval->realval = yval->intval; + } else if (g == 8) { + x->typ = OPT_lrltyp; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 8: + if (__IN(g, 0x70)) { + y->typ = x->typ; + yval->realval = yval->intval; + } else if (g == 7) { + y->typ = OPT_lrltyp; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 10: + if (g == 3) { + OPB_CharToString(y); + g = 10; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 11: + if (!__IN(g, 0x6000)) { + OPB_err(100); + } + break; + case 13: + OPB_CheckPtr(x, y); + break; + case 14: + if (g != 11) { + OPB_err(100); + } + break; + default: + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + break; + } + f = x->typ->form; + } + switch (op) { + case 1: + if (__IN(f, 0x70)) { + xv = xval->intval; + yv = yval->intval; + if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(2147483647, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-2147483647-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-2147483647-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-2147483647-1))) && yv != (-2147483647-1))) && -xv <= __DIV(2147483647, -yv))) { + xval->intval = xv * yv; + OPB_SetIntType(x); + } else { + OPB_err(204); + } + } else if (__IN(f, 0x0180)) { + temp = __ABS(yval->realval) <= (LONGREAL)1; + if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 / (LONGREAL)__ABS(yval->realval)) { + xval->realval = xval->realval * yval->realval; + OPB_CheckRealType(f, 204, xval); + } else { + OPB_err(204); + } + } else if (f == 9) { + xval->setval = (xval->setval & yval->setval); + } else if (f != 0) { + OPB_err(101); + } + break; + case 2: + if (__IN(f, 0x70)) { + if (yval->intval != 0) { + xval->realval = xval->intval / (REAL)yval->intval; + OPB_CheckRealType(7, 205, xval); + } else { + OPB_err(205); + xval->realval = (LONGREAL)1; + } + x->typ = OPT_realtyp; + } else if (__IN(f, 0x0180)) { + temp = __ABS(yval->realval) >= (LONGREAL)1; + if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 * __ABS(yval->realval)) { + xval->realval = xval->realval / yval->realval; + OPB_CheckRealType(f, 205, xval); + } else { + OPB_err(205); + } + } else if (f == 9) { + xval->setval = xval->setval ^ yval->setval; + } else if (f != 0) { + OPB_err(102); + } + break; + case 3: + if (__IN(f, 0x70)) { + if (yval->intval != 0) { + xval->intval = __DIV(xval->intval, yval->intval); + OPB_SetIntType(x); + } else { + OPB_err(205); + } + } else if (f != 0) { + OPB_err(103); + } + break; + case 4: + if (__IN(f, 0x70)) { + if (yval->intval != 0) { + xval->intval = __MOD(xval->intval, yval->intval); + OPB_SetIntType(x); + } else { + OPB_err(205); + } + } else if (f != 0) { + OPB_err(104); + } + break; + case 5: + if (f == 2) { + xval->intval = OPB_BoolToInt((OPB_IntToBool(xval->intval) && OPB_IntToBool(yval->intval))); + } else { + OPB_err(94); + } + break; + case 6: + if (__IN(f, 0x70)) { + temp = (yval->intval >= 0 && xval->intval <= 2147483647 - yval->intval); + if (temp || (yval->intval < 0 && xval->intval >= (-2147483647-1) - yval->intval)) { + xval->intval += yval->intval; + OPB_SetIntType(x); + } else { + OPB_err(206); + } + } else if (__IN(f, 0x0180)) { + temp = (yval->realval >= (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 - yval->realval); + if (temp || (yval->realval < (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 - yval->realval)) { + xval->realval = xval->realval + yval->realval; + OPB_CheckRealType(f, 206, xval); + } else { + OPB_err(206); + } + } else if (f == 9) { + xval->setval = xval->setval | yval->setval; + } else if (f != 0) { + OPB_err(105); + } + break; + case 7: + if (__IN(f, 0x70)) { + if ((yval->intval >= 0 && xval->intval >= (-2147483647-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 2147483647 + yval->intval)) { + xval->intval -= yval->intval; + OPB_SetIntType(x); + } else { + OPB_err(207); + } + } else if (__IN(f, 0x0180)) { + temp = (yval->realval >= (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 + yval->realval); + if (temp || (yval->realval < (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 + yval->realval)) { + xval->realval = xval->realval - yval->realval; + OPB_CheckRealType(f, 207, xval); + } else { + OPB_err(207); + } + } else if (f == 9) { + xval->setval = (xval->setval & ~yval->setval); + } else if (f != 0) { + OPB_err(106); + } + break; + case 8: + if (f == 2) { + xval->intval = OPB_BoolToInt(OPB_IntToBool(xval->intval) || OPB_IntToBool(yval->intval)); + } else { + OPB_err(95); + } + break; + case 9: + xval->intval = OPB_BoolToInt(ConstCmp__14() == 9); + break; + case 10: + xval->intval = OPB_BoolToInt(ConstCmp__14() != 9); + break; + case 11: + if (__IN(f, 0x2a04)) { + OPB_err(108); + } else { + xval->intval = OPB_BoolToInt(ConstCmp__14() == 11); + } + break; + case 12: + if (__IN(f, 0x2a04)) { + OPB_err(108); + } else { + xval->intval = OPB_BoolToInt(ConstCmp__14() != 13); + } + break; + case 13: + if (__IN(f, 0x2a04)) { + OPB_err(108); + } else { + xval->intval = OPB_BoolToInt(ConstCmp__14() == 13); + } + break; + case 14: + if (__IN(f, 0x2a04)) { + OPB_err(108); + } else { + xval->intval = OPB_BoolToInt(ConstCmp__14() != 11); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstOp, op = ", (LONGINT)37); + OPM_LogWNum(op, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + ConstOp__13_s = _s.lnk; +} + +static void OPB_Convert (OPT_Node *x, OPT_Struct typ) +{ + OPT_Node node = NIL; + INTEGER f, g; + LONGINT k; + LONGREAL r; + f = (*x)->typ->form; + g = typ->form; + if ((*x)->class == 7) { + if (__IN(f, 0x70)) { + if (__IN(g, 0x70)) { + if (f > g) { + OPB_SetIntType(*x); + if ((int)(*x)->typ->form > g) { + OPB_err(203); + (*x)->conval->intval = 1; + } + } + } else if (__IN(g, 0x0180)) { + (*x)->conval->realval = (*x)->conval->intval; + (*x)->conval->intval = -1; + } else { + k = (*x)->conval->intval; + if (0 > k || k > 255) { + OPB_err(220); + } + } + } else if (__IN(f, 0x0180)) { + if (__IN(g, 0x0180)) { + OPB_CheckRealType(g, 203, (*x)->conval); + } else { + r = (*x)->conval->realval; + if (r < -2.14748364800000e+009 || r > 2.14748364700000e+009) { + OPB_err(203); + r = (LONGREAL)1; + } + (*x)->conval->intval = __ENTIER(r); + OPB_SetIntType(*x); + } + } + (*x)->obj = NIL; + } else if (((((*x)->class == 11 && (*x)->subcl == 20)) && ((int)(*x)->left->typ->form < f || f > g))) { + if ((*x)->left->typ == typ) { + *x = (*x)->left; + } + } else { + node = OPT_NewNode(11); + node->subcl = 20; + node->left = *x; + *x = node; + } + (*x)->typ = typ; +} + +static struct Op__38 { + INTEGER *f, *g; + struct Op__38 *lnk; +} *Op__38_s; + +static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y); +static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y); + +static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y) +{ + OPT_Node node = NIL; + node = OPT_NewNode(12); + node->subcl = op; + node->typ = typ; + node->left = *x; + node->right = y; + *x = node; +} + +static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y) +{ + BOOLEAN _o_result; + BOOLEAN ok, xCharArr, yCharArr; + xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 10; + yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 10; + if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) { + OPB_CharToString(*y); + *Op__38_s->g = 10; + yCharArr = 1; + } + if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) { + OPB_CharToString(*x); + *Op__38_s->f = 10; + xCharArr = 1; + } + ok = (xCharArr && yCharArr); + if (ok) { + if ((*Op__38_s->f == 10 && (*x)->conval->intval2 == 1)) { + (*x)->typ = OPT_chartyp; + (*x)->conval->intval = 0; + OPB_Index(&*y, OPB_NewIntConst(((LONGINT)(0)))); + } else if ((*Op__38_s->g == 10 && (*y)->conval->intval2 == 1)) { + (*y)->typ = OPT_chartyp; + (*y)->conval->intval = 0; + OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0)))); + } + } + _o_result = ok; + return _o_result; +} + +void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y) +{ + INTEGER f, g; + OPT_Node t = NIL, z = NIL; + OPT_Struct typ = NIL; + BOOLEAN do_; + LONGINT val; + struct Op__38 _s; + _s.f = &f; + _s.g = &g; + _s.lnk = Op__38_s; + Op__38_s = &_s; + z = *x; + if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) { + OPB_err(126); + } else if ((z->class == 7 && y->class == 7)) { + OPB_ConstOp(op, z, y); + z->obj = NIL; + } else { + if (z->typ != y->typ) { + g = y->typ->form; + switch (z->typ->form) { + case 3: + if (z->class == 7) { + OPB_CharToString(z); + } else { + OPB_err(100); + } + break; + case 4: + if (__IN(g, 0x01f0)) { + OPB_Convert(&z, y->typ); + } else { + OPB_err(100); + } + break; + case 5: + if (g == 4) { + OPB_Convert(&y, z->typ); + } else if (__IN(g, 0x01f0)) { + OPB_Convert(&z, y->typ); + } else { + OPB_err(100); + } + break; + case 6: + if (__IN(g, 0x70)) { + OPB_Convert(&y, z->typ); + } else if (__IN(g, 0x0180)) { + OPB_Convert(&z, y->typ); + } else { + OPB_err(100); + } + break; + case 7: + if (__IN(g, 0x70)) { + OPB_Convert(&y, z->typ); + } else if (__IN(g, 0x0180)) { + OPB_Convert(&z, y->typ); + } else { + OPB_err(100); + } + break; + case 8: + if (__IN(g, 0x01f0)) { + OPB_Convert(&y, z->typ); + } else if (__IN(g, 0x0180)) { + OPB_Convert(&y, z->typ); + } else { + OPB_err(100); + } + break; + case 11: + if (!__IN(g, 0x6000)) { + OPB_err(100); + } + break; + case 13: + OPB_CheckPtr(z, y); + break; + case 14: + if (g != 11) { + OPB_err(100); + } + break; + case 10: + break; + case 15: + if (z->typ->comp == 4) { + OPB_err(100); + } + break; + default: + OPB_err(100); + break; + } + } + typ = z->typ; + f = typ->form; + g = y->typ->form; + switch (op) { + case 1: + do_ = 1; + if (__IN(f, 0x70)) { + if (z->class == 7) { + val = z->conval->intval; + if (val == 1) { + do_ = 0; + z = y; + } else if (val == 0) { + do_ = 0; + } else if (OPB_log(val) == 1) { + t = y; + y = z; + z = t; + op = 17; + y->typ = OPT_sinttyp; + y->conval->intval = OPB_exp; + y->obj = NIL; + } + } else if (y->class == 7) { + val = y->conval->intval; + if (val == 1) { + do_ = 0; + } else if (val == 0) { + do_ = 0; + z = y; + } else if (OPB_log(val) == 1) { + op = 17; + y->typ = OPT_sinttyp; + y->conval->intval = OPB_exp; + y->obj = NIL; + } + } + } else if (!__IN(f, 0x0381)) { + OPB_err(105); + typ = OPT_undftyp; + } + if (do_) { + NewOp__39(op, typ, &z, y); + } + break; + case 2: + if (__IN(f, 0x70)) { + if ((y->class == 7 && y->conval->intval == 0)) { + OPB_err(205); + } + OPB_Convert(&z, OPT_realtyp); + OPB_Convert(&y, OPT_realtyp); + typ = OPT_realtyp; + } else if (__IN(f, 0x0180)) { + if ((y->class == 7 && y->conval->realval == (LONGREAL)0)) { + OPB_err(205); + } + } else if ((f != 9 && f != 0)) { + OPB_err(102); + typ = OPT_undftyp; + } + NewOp__39(op, typ, &z, y); + break; + case 3: + do_ = 1; + if (__IN(f, 0x70)) { + if (y->class == 7) { + val = y->conval->intval; + if (val == 0) { + OPB_err(205); + } else if (val == 1) { + do_ = 0; + } else if (OPB_log(val) == 1) { + op = 17; + y->typ = OPT_sinttyp; + y->conval->intval = -OPB_exp; + y->obj = NIL; + } + } + } else if (f != 0) { + OPB_err(103); + typ = OPT_undftyp; + } + if (do_) { + NewOp__39(op, typ, &z, y); + } + break; + case 4: + if (__IN(f, 0x70)) { + if (y->class == 7) { + if (y->conval->intval == 0) { + OPB_err(205); + } else if (OPB_log(y->conval->intval) == 1) { + op = 18; + y->conval->intval = __ASH(-1, OPB_exp); + y->obj = NIL; + } + } + } else if (f != 0) { + OPB_err(104); + typ = OPT_undftyp; + } + NewOp__39(op, typ, &z, y); + break; + case 5: + if (f == 2) { + if (z->class == 7) { + if (OPB_IntToBool(z->conval->intval)) { + z = y; + } + } else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) { + } else { + NewOp__39(op, typ, &z, y); + } + } else if (f != 0) { + OPB_err(94); + z->typ = OPT_undftyp; + } + break; + case 6: + if (!__IN(f, 0x03f1)) { + OPB_err(105); + typ = OPT_undftyp; + } + do_ = 1; + if (__IN(f, 0x70)) { + if ((z->class == 7 && z->conval->intval == 0)) { + do_ = 0; + z = y; + } + if ((y->class == 7 && y->conval->intval == 0)) { + do_ = 0; + } + } + if (do_) { + NewOp__39(op, typ, &z, y); + } + break; + case 7: + if (!__IN(f, 0x03f1)) { + OPB_err(106); + typ = OPT_undftyp; + } + if ((!__IN(f, 0x70) || y->class != 7) || y->conval->intval != 0) { + NewOp__39(op, typ, &z, y); + } + break; + case 8: + if (f == 2) { + if (z->class == 7) { + if (!OPB_IntToBool(z->conval->intval)) { + z = y; + } + } else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) { + } else { + NewOp__39(op, typ, &z, y); + } + } else if (f != 0) { + OPB_err(95); + z->typ = OPT_undftyp; + } + break; + case 9: case 10: + if (__IN(f, 0x6bff) || strings__41(&z, &y)) { + typ = OPT_booltyp; + } else { + OPB_err(107); + typ = OPT_undftyp; + } + NewOp__39(op, typ, &z, y); + break; + case 11: case 12: case 13: case 14: + if (__IN(f, 0x01f9) || strings__41(&z, &y)) { + typ = OPT_booltyp; + } else { + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"ELSE in Op()", (LONGINT)13); + OPM_LogWLn(); + OPB_err(108); + typ = OPT_undftyp; + } + NewOp__39(op, typ, &z, y); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", (LONGINT)32); + OPM_LogWNum(op, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } + *x = z; + Op__38_s = _s.lnk; +} + +void OPB_SetRange (OPT_Node *x, OPT_Node y) +{ + LONGINT k, l; + if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) { + OPB_err(126); + } else if ((__IN((*x)->typ->form, 0x70) && __IN(y->typ->form, 0x70))) { + if ((*x)->class == 7) { + k = (*x)->conval->intval; + if (0 > k || k > (LONGINT)OPM_MaxSet) { + OPB_err(202); + } + } + if (y->class == 7) { + l = y->conval->intval; + if (0 > l || l > (LONGINT)OPM_MaxSet) { + OPB_err(202); + } + } + if (((*x)->class == 7 && y->class == 7)) { + if (k <= l) { + (*x)->conval->setval = __SETRNG(k, l); + } else { + OPB_err(201); + (*x)->conval->setval = __SETRNG(l, k); + } + (*x)->obj = NIL; + } else { + OPB_BindNodes(10, OPT_settyp, &*x, y); + } + } else { + OPB_err(93); + } + (*x)->typ = OPT_settyp; +} + +void OPB_SetElem (OPT_Node *x) +{ + LONGINT k; + if ((*x)->class == 8 || (*x)->class == 9) { + OPB_err(126); + } else if (!__IN((*x)->typ->form, 0x70)) { + OPB_err(93); + } else if ((*x)->class == 7) { + k = (*x)->conval->intval; + if ((0 <= k && k <= (LONGINT)OPM_MaxSet)) { + (*x)->conval->setval = __SETOF(k); + } else { + OPB_err(202); + } + (*x)->obj = NIL; + } else { + OPB_Convert(&*x, OPT_settyp); + } + (*x)->typ = OPT_settyp; +} + +static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode) +{ + INTEGER f, g; + OPT_Struct y = NIL, p = NIL, q = NIL; + if (OPM_Verbose) { + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"PROCEDURE CheckAssign", (LONGINT)22); + OPM_LogWLn(); + } + y = ynode->typ; + f = x->form; + g = y->form; + if (OPM_Verbose) { + OPM_LogWStr((CHAR*)"y.form = ", (LONGINT)10); + OPM_LogWNum(y->form, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"f = ", (LONGINT)5); + OPM_LogWNum(f, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"g = ", (LONGINT)5); + OPM_LogWNum(g, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"ynode.typ.syze = ", (LONGINT)18); + OPM_LogWNum(ynode->typ->size, ((LONGINT)(0))); + OPM_LogWLn(); + } + if (ynode->class == 8 || (ynode->class == 9 && f != 14)) { + OPB_err(126); + } + switch (f) { + case 0: case 10: + break; + case 1: + if (!__IN(g, 0x1a)) { + OPB_err(113); + } + break; + case 2: case 3: case 4: case 9: + if (g != f) { + OPB_err(113); + } + break; + case 5: + if (!__IN(g, 0x30)) { + OPB_err(113); + } + break; + case 6: + if (OPM_LIntSize == 4) { + if (!__IN(g, 0x70)) { + OPB_err(113); + } + } else { + if (!__IN(g, 0x70)) { + OPB_err(113); + } + } + break; + case 7: + if (!__IN(g, 0xf0)) { + OPB_err(113); + } + break; + case 8: + if (!__IN(g, 0x01f0)) { + OPB_err(113); + } + break; + case 13: + if ((x == y || g == 11) || (x == OPT_sysptrtyp && g == 13)) { + } else if (g == 13) { + p = x->BaseTyp; + q = y->BaseTyp; + if ((p->comp == 4 && q->comp == 4)) { + while ((((q != p && q != NIL)) && q != OPT_undftyp)) { + q = q->BaseTyp; + } + if (q == NIL) { + OPB_err(113); + } + } else { + OPB_err(113); + } + } else { + OPB_err(113); + } + break; + case 14: + if (ynode->class == 9) { + OPB_CheckProc(x, ynode->obj); + } else if (x == y || g == 11) { + } else { + OPB_err(113); + } + break; + case 12: case 11: + OPB_err(113); + break; + case 15: + x->pvused = 1; + if (x->comp == 2) { + if ((ynode->class == 7 && g == 3)) { + OPB_CharToString(ynode); + y = ynode->typ; + g = 10; + } + if (x == y) { + } else if (x->BaseTyp == OPT_chartyp) { + if (g == 10) { + if (ynode->conval->intval2 > x->n) { + OPB_err(114); + } + } else if ((__IN(y->comp, 0x0c) && y->BaseTyp == OPT_chartyp)) { + } else { + OPB_err(113); + } + } else { + OPB_err(113); + } + } else if ((x->comp == 3 && x->BaseTyp == OPT_chartyp)) { + if ((__IN(y->comp, 0x0c) && y->BaseTyp == OPT_chartyp)) { + } else { + OPB_err(113); + } + } else if (x->comp == 4) { + if (x == y) { + } else if (y->comp == 4) { + q = y->BaseTyp; + while ((((q != NIL && q != x)) && q != OPT_undftyp)) { + q = q->BaseTyp; + } + if (q == NIL) { + OPB_err(113); + } + } else { + OPB_err(113); + } + } else { + OPB_err(113); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.CheckAssign, f = ", (LONGINT)40); + OPM_LogWNum(f, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + if ((((((ynode->class == 7 && g < f)) && __IN(g, 0xf0))) && __IN(f, 0x01e0))) { + OPB_Convert(&ynode, x); + } +} + +static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo) +{ +} + +void OPB_StPar0 (OPT_Node *par0, INTEGER fctno) +{ + INTEGER f; + OPT_Struct typ = NIL; + OPT_Node x = NIL; + x = *par0; + f = x->typ->form; + switch (fctno) { + case 0: + if ((__IN(f, 0x70) && x->class == 7)) { + if ((0 <= x->conval->intval && x->conval->intval <= 255)) { + OPB_BindNodes(28, OPT_notyp, &x, x); + } else { + OPB_err(218); + } + } else { + OPB_err(69); + } + x->typ = OPT_notyp; + break; + case 1: + typ = OPT_notyp; + if (OPB_NotVar(x)) { + OPB_err(112); + } else if (f == 13) { + if (x->readonly) { + OPB_err(76); + } + f = x->typ->BaseTyp->comp; + if (__IN(f, 0x1c)) { + if (f == 3) { + typ = x->typ->BaseTyp; + } + OPB_BindNodes(19, OPT_notyp, &x, NIL); + x->subcl = 1; + } else { + OPB_err(111); + } + } else { + OPB_err(111); + } + x->typ = typ; + break; + case 2: + OPB_MOp(21, &x); + break; + case 3: + OPB_MOp(22, &x); + break; + case 4: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (f == 3) { + OPB_Convert(&x, OPT_inttyp); + } else { + OPB_err(111); + } + x->typ = OPT_inttyp; + break; + case 5: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x0180)) { + OPB_Convert(&x, OPT_linttyp); + } else { + OPB_err(111); + } + x->typ = OPT_linttyp; + break; + case 6: + OPB_MOp(23, &x); + break; + case 7: + if (x->class == 8) { + switch (f) { + case 2: + x = OPB_NewBoolConst(0); + break; + case 3: + x = OPB_NewIntConst(((LONGINT)(0))); + x->typ = OPT_chartyp; + break; + case 4: + x = OPB_NewIntConst(OPM_MinSInt); + break; + case 5: + x = OPB_NewIntConst(OPM_MinInt); + break; + case 6: + x = OPB_NewIntConst(OPM_MinLInt); + break; + case 9: + x = OPB_NewIntConst(((LONGINT)(0))); + x->typ = OPT_inttyp; + break; + case 7: + x = OPB_NewRealConst(OPM_MinReal, OPT_realtyp); + break; + case 8: + x = OPB_NewRealConst(OPM_MinLReal, OPT_lrltyp); + break; + default: + OPB_err(111); + break; + } + } else { + OPB_err(110); + } + break; + case 8: + if (x->class == 8) { + switch (f) { + case 2: + x = OPB_NewBoolConst(1); + break; + case 3: + x = OPB_NewIntConst(((LONGINT)(255))); + x->typ = OPT_chartyp; + break; + case 4: + x = OPB_NewIntConst(OPM_MaxSInt); + break; + case 5: + x = OPB_NewIntConst(OPM_MaxInt); + break; + case 6: + x = OPB_NewIntConst(OPM_MaxLInt); + break; + case 9: + x = OPB_NewIntConst(OPM_MaxSet); + x->typ = OPT_inttyp; + break; + case 7: + x = OPB_NewRealConst(OPM_MaxReal, OPT_realtyp); + break; + case 8: + x = OPB_NewRealConst(OPM_MaxLReal, OPT_lrltyp); + break; + default: + OPB_err(111); + break; + } + } else { + OPB_err(110); + } + break; + case 9: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x71)) { + OPB_Convert(&x, OPT_chartyp); + } else { + OPB_err(111); + x->typ = OPT_chartyp; + } + break; + case 10: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (f == 5) { + OPB_Convert(&x, OPT_sinttyp); + } else if (f == 6) { + OPB_Convert(&x, OPT_inttyp); + } else if (f == 8) { + OPB_Convert(&x, OPT_realtyp); + } else { + OPB_err(111); + } + break; + case 11: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (f == 4) { + OPB_Convert(&x, OPT_inttyp); + } else if (f == 5) { + OPB_Convert(&x, OPT_linttyp); + } else if (f == 7) { + OPB_Convert(&x, OPT_lrltyp); + } else if (f == 3) { + OPB_Convert(&x, OPT_linttyp); + } else { + OPB_err(111); + } + break; + case 13: case 14: + if (OPB_NotVar(x)) { + OPB_err(112); + } else if (!__IN(f, 0x70)) { + OPB_err(111); + } else if (x->readonly) { + OPB_err(76); + } + break; + case 15: case 16: + if (OPB_NotVar(x)) { + OPB_err(112); + } else if (x->typ != OPT_settyp) { + OPB_err(111); + x->typ = OPT_settyp; + } else if (x->readonly) { + OPB_err(76); + } + break; + case 17: + if (!__IN(x->typ->comp, 0x0c)) { + OPB_err(131); + } + break; + case 18: + if ((x->class == 7 && f == 3)) { + OPB_CharToString(x); + f = 10; + } + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (((!__IN(x->typ->comp, 0x0c) || x->typ->BaseTyp->form != 3) && f != 10)) { + OPB_err(111); + } + break; + case 19: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + if (f != 6) { + OPB_Convert(&x, OPT_linttyp); + } + } else { + OPB_err(111); + x->typ = OPT_linttyp; + } + break; + case 20: + OPB_CheckLeaf(x, 0); + OPB_MOp(24, &x); + break; + case 12: + if (x->class != 8) { + OPB_err(110); + x = OPB_NewIntConst(((LONGINT)(1))); + } else if (__IN(f, 0x63fe) || __IN(x->typ->comp, 0x14)) { + (*OPB_typSize)(x->typ); + x->typ->pvused = 1; + x = OPB_NewIntConst(x->typ->size); + } else { + OPB_err(111); + x = OPB_NewIntConst(((LONGINT)(1))); + } + break; + case 21: + OPB_MOp(25, &x); + break; + case 22: case 23: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (!__IN(f, 0x027a)) { + OPB_err(111); + } + break; + case 24: case 25: case 28: case 31: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if ((x->class == 7 && __IN(f, 0x30))) { + OPB_Convert(&x, OPT_linttyp); + } else if (!__IN(f, 0x2040)) { + OPB_err(111); + x->typ = OPT_linttyp; + } + break; + case 26: case 27: + if ((__IN(f, 0x70) && x->class == 7)) { + if (x->conval->intval < 0 || x->conval->intval > -1) { + OPB_err(220); + } + } else { + OPB_err(69); + } + break; + case 29: + if (x->class != 8) { + OPB_err(110); + } else if (__IN(f, 0x1401) || x->typ->comp == 3) { + OPB_err(111); + } + break; + case 30: + if (OPB_NotVar(x)) { + OPB_err(112); + } else if (f == 13) { + } else { + OPB_err(111); + } + break; + case 32: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + x = OPB_NewBoolConst(0); + } else if (f != 2) { + OPB_err(120); + x = OPB_NewBoolConst(0); + } else { + OPB_MOp(33, &x); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.StPar0, fctno = ", (LONGINT)39); + OPM_LogWNum(fctno, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + *par0 = x; +} + +static struct StPar1__52 { + struct StPar1__52 *lnk; +} *StPar1__52_s; + +static OPT_Node NewOp__53 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right); + +static OPT_Node NewOp__53 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right) +{ + OPT_Node _o_result; + OPT_Node node = NIL; + node = OPT_NewNode(class); + node->subcl = subcl; + node->left = left; + node->right = right; + _o_result = node; + return _o_result; +} + +void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno) +{ + INTEGER f, L; + OPT_Struct typ = NIL; + OPT_Node p = NIL, t = NIL; + struct StPar1__52 _s; + _s.lnk = StPar1__52_s; + StPar1__52_s = &_s; + p = *par0; + f = x->typ->form; + switch (fctno) { + case 13: case 14: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + p->typ = OPT_notyp; + } else { + if (x->typ != p->typ) { + if ((x->class == 7 && __IN(f, 0x70))) { + OPB_Convert(&x, p->typ); + } else { + OPB_err(111); + } + } + p = NewOp__53(19, fctno, p, x); + p->typ = OPT_notyp; + } + break; + case 15: case 16: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (LONGINT)OPM_MaxSet))) { + OPB_err(202); + } + p = NewOp__53(19, fctno, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + break; + case 17: + if (!__IN(f, 0x70) || x->class != 7) { + OPB_err(69); + } else if (f == 4) { + L = (int)x->conval->intval; + typ = p->typ; + while ((L > 0 && __IN(typ->comp, 0x0c))) { + typ = typ->BaseTyp; + L -= 1; + } + if (L != 0 || !__IN(typ->comp, 0x0c)) { + OPB_err(132); + } else { + x->obj = NIL; + if (typ->comp == 3) { + while (p->class == 4) { + p = p->left; + x->conval->intval += 1; + } + p = NewOp__53(12, 19, p, x); + p->typ = OPT_linttyp; + } else { + p = x; + p->conval->intval = typ->n; + OPB_SetIntType(p); + } + } + } else { + OPB_err(132); + } + break; + case 18: + if (OPB_NotVar(x)) { + OPB_err(112); + } else if ((__IN(x->typ->comp, 0x0c) && x->typ->BaseTyp->form == 3)) { + if (x->readonly) { + OPB_err(76); + } + t = x; + x = p; + p = t; + p = NewOp__53(19, 18, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + break; + case 19: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + if ((p->class == 7 && x->class == 7)) { + if (-OPB_maxExp > x->conval->intval || x->conval->intval > OPB_maxExp) { + OPB_err(208); + p->conval->intval = 1; + } else if (x->conval->intval >= 0) { + if (__ABS(p->conval->intval) <= __DIV(2147483647, __ASH(1, x->conval->intval))) { + p->conval->intval = p->conval->intval * __ASH(1, x->conval->intval); + } else { + OPB_err(208); + p->conval->intval = 1; + } + } else { + p->conval->intval = __ASH(p->conval->intval, x->conval->intval); + } + p->obj = NIL; + } else { + p = NewOp__53(12, 17, p, x); + p->typ = OPT_linttyp; + } + } else { + OPB_err(111); + } + break; + case 1: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (p->typ->comp == 3) { + if (__IN(f, 0x70)) { + if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) { + OPB_err(63); + } + } else { + OPB_err(111); + } + p->right = x; + p->typ = p->typ->BaseTyp; + } else { + OPB_err(64); + } + break; + case 22: case 23: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (!__IN(f, 0x70)) { + OPB_err(111); + } else { + if (fctno == 22) { + p = NewOp__53(12, 27, p, x); + } else { + p = NewOp__53(12, 28, p, x); + } + p->typ = p->left->typ; + } + break; + case 24: case 25: case 26: case 27: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x63ff)) { + if (fctno == 24 || fctno == 26) { + if (OPB_NotVar(x)) { + OPB_err(112); + } + t = x; + x = p; + p = t; + } + p = NewOp__53(19, fctno, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + break; + case 28: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + p = NewOp__53(12, 26, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_booltyp; + break; + case 29: + if (((x->class == 8 || x->class == 9) || __IN(f, 0x1401)) || x->typ->comp == 3) { + OPB_err(126); + } + t = OPT_NewNode(11); + t->subcl = 29; + t->left = x; + x = t; + x->typ = p->typ; + p = x; + break; + case 30: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + p = NewOp__53(19, 30, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + break; + case 31: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if ((x->class == 7 && __IN(f, 0x30))) { + OPB_Convert(&x, OPT_linttyp); + } else if (!__IN(f, 0x2040)) { + OPB_err(111); + x->typ = OPT_linttyp; + } + p->link = x; + break; + case 32: + if ((__IN(f, 0x70) && x->class == 7)) { + if ((0 <= x->conval->intval && x->conval->intval <= 255)) { + OPB_BindNodes(28, OPT_notyp, &x, x); + x->conval = OPT_NewConst(); + x->conval->intval = OPM_errpos; + OPB_Construct(15, &p, x); + p->conval = OPT_NewConst(); + p->conval->intval = OPM_errpos; + OPB_Construct(20, &p, NIL); + OPB_OptIf(&p); + if (p == NIL) { + } else if (p->class == 28) { + OPB_err(99); + } else { + p->subcl = 32; + } + } else { + OPB_err(218); + } + } else { + OPB_err(69); + } + break; + default: + OPB_err(64); + break; + } + *par0 = p; + StPar1__52_s = _s.lnk; +} + +void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n) +{ + OPT_Node node = NIL; + INTEGER f; + OPT_Node p = NIL; + p = *par0; + f = x->typ->form; + if (fctno == 1) { + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (p->typ->comp != 3) { + OPB_err(64); + } else if (__IN(f, 0x70)) { + if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) { + OPB_err(63); + } + node = p->right; + while (node->link != NIL) { + node = node->link; + } + node->link = x; + p->typ = p->typ->BaseTyp; + } else { + OPB_err(111); + } + } else if ((fctno == 31 && n == 2)) { + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + node = OPT_NewNode(19); + node->subcl = 31; + node->right = p; + node->left = p->link; + p->link = x; + p = node; + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + } else { + OPB_err(64); + } + *par0 = p; +} + +void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno) +{ + INTEGER dim; + OPT_Node x = NIL, p = NIL; + p = *par0; + if (fctno <= 19) { + if ((fctno == 1 && p->typ != OPT_notyp)) { + if (p->typ->comp == 3) { + OPB_err(65); + } + p->typ = OPT_notyp; + } else if (fctno <= 12) { + if (parno < 1) { + OPB_err(65); + } + } else { + if (((fctno == 13 || fctno == 14) && parno == 1)) { + OPB_BindNodes(19, OPT_notyp, &p, OPB_NewIntConst(((LONGINT)(1)))); + p->subcl = fctno; + p->right->typ = p->left->typ; + } else if ((fctno == 17 && parno == 1)) { + if (p->typ->comp == 3) { + dim = 0; + while (p->class == 4) { + p = p->left; + dim += 1; + } + OPB_BindNodes(12, OPT_linttyp, &p, OPB_NewIntConst(dim)); + p->subcl = 19; + } else { + p = OPB_NewIntConst(p->typ->n); + } + } else if (parno < 2) { + OPB_err(65); + } + } + } else if (fctno == 32) { + if (parno == 1) { + x = NIL; + OPB_BindNodes(28, OPT_notyp, &x, OPB_NewIntConst(((LONGINT)(0)))); + x->conval = OPT_NewConst(); + x->conval->intval = OPM_errpos; + OPB_Construct(15, &p, x); + p->conval = OPT_NewConst(); + p->conval->intval = OPM_errpos; + OPB_Construct(20, &p, NIL); + OPB_OptIf(&p); + if (p == NIL) { + } else if (p->class == 28) { + OPB_err(99); + } else { + p->subcl = 32; + } + } else if (parno < 1) { + OPB_err(65); + } + } else { + if ((parno < 1 || (fctno > 21 && parno < 2)) || (fctno == 31 && parno < 3)) { + OPB_err(65); + } + } + *par0 = p; +} + +static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar) +{ + INTEGER f; + f = atyp->comp; + ftyp = ftyp->BaseTyp; + atyp = atyp->BaseTyp; + if ((fvarpar && ftyp == OPT_bytetyp)) { + if (!__IN(f, 0x0c) || !__IN(atyp->form, 0x1e)) { + if (__IN(18, OPM_opt)) { + OPB_err(-301); + } + } + } else if (__IN(f, 0x0c)) { + if (ftyp->comp == 3) { + OPB_DynArrParCheck(ftyp, atyp, fvarpar); + } else if (ftyp != atyp) { + if ((((!fvarpar && ftyp->form == 13)) && atyp->form == 13)) { + ftyp = ftyp->BaseTyp; + atyp = atyp->BaseTyp; + if ((ftyp->comp == 4 && atyp->comp == 4)) { + while ((((ftyp != atyp && atyp != NIL)) && atyp != OPT_undftyp)) { + atyp = atyp->BaseTyp; + } + if (atyp == NIL) { + OPB_err(113); + } + } else { + OPB_err(66); + } + } else { + OPB_err(66); + } + } + } else { + OPB_err(67); + } +} + +static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp) +{ + if (fp->typ->form == 13) { + if ((*x)->class == 3) { + *x = (*x)->left; + } else { + OPB_err(71); + } + } +} + +void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar) +{ + if (((*x)->obj != NIL && __IN((*x)->obj->mode, 0x22c0))) { + *fpar = (*x)->obj->link; + if ((*x)->obj->mode == 13) { + OPB_CheckReceiver(&(*x)->left, *fpar); + *fpar = (*fpar)->link; + } + } else if (((((*x)->class != 8 && (*x)->typ != NIL)) && (*x)->typ->form == 14)) { + *fpar = (*x)->typ->link; + } else { + OPB_err(121); + *fpar = NIL; + (*x)->typ = OPT_undftyp; + } +} + +void OPB_Param (OPT_Node ap, OPT_Object fp) +{ + OPT_Struct q = NIL; + if (fp->typ->form != 0) { + if (fp->mode == 2) { + if (OPB_NotVar(ap)) { + OPB_err(122); + } else { + OPB_CheckLeaf(ap, 0); + } + if (ap->readonly) { + OPB_err(76); + } + if (fp->typ->comp == 3) { + OPB_DynArrParCheck(fp->typ, ap->typ, 1); + } else if ((fp->typ->comp == 4 && ap->typ->comp == 4)) { + q = ap->typ; + while ((((q != fp->typ && q != NIL)) && q != OPT_undftyp)) { + q = q->BaseTyp; + } + if (q == NIL) { + OPB_err(111); + } + } else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 13)) { + } else if ((ap->typ != fp->typ && !((fp->typ->form == 1 && __IN(ap->typ->form, 0x18))))) { + OPB_err(123); + } else if ((fp->typ->form == 13 && ap->class == 5)) { + OPB_err(123); + } + } else if (fp->typ->comp == 3) { + if ((ap->class == 7 && ap->typ->form == 3)) { + OPB_CharToString(ap); + } + if ((ap->typ->form == 10 && fp->typ->BaseTyp->form == 3)) { + } else if (ap->class >= 7) { + OPB_err(59); + } else { + OPB_DynArrParCheck(fp->typ, ap->typ, 0); + } + } else { + OPB_CheckAssign(fp->typ, ap); + } + } +} + +void OPB_StaticLink (SHORTINT dlev) +{ + OPT_Object scope = NIL; + scope = OPT_topScope; + while (dlev > 0) { + dlev -= 1; + scope->link->conval->setval |= __SETOF(3); + scope = scope->left; + } +} + +void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp) +{ + OPT_Struct typ = NIL; + OPT_Node p = NIL; + SHORTINT lev; + if ((*x)->class == 9) { + typ = (*x)->typ; + lev = (*x)->obj->mnolev; + if (lev > 0) { + OPB_StaticLink(OPT_topScope->mnolev - lev); + } + if ((*x)->obj->mode == 10) { + OPB_err(121); + } + } else if (((*x)->class == 2 && (*x)->obj->mode == 13)) { + typ = (*x)->typ; + (*x)->class = 9; + p = (*x)->left; + (*x)->left = NIL; + p->link = apar; + apar = p; + fp = (*x)->obj->link; + } else { + typ = (*x)->typ->BaseTyp; + } + OPB_BindNodes(13, typ, &*x, apar); + (*x)->obj = fp; +} + +void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc) +{ + OPT_Node x = NIL; + x = OPT_NewNode(18); + x->typ = OPT_notyp; + x->obj = proc; + x->left = *procdec; + x->right = stat; + *procdec = x; +} + +void OPB_Return (OPT_Node *x, OPT_Object proc) +{ + OPT_Node node = NIL; + if (proc == NIL) { + if (*x != NIL) { + OPB_err(124); + } + } else { + if (*x != NIL) { + OPB_CheckAssign(proc->typ, *x); + } else if (proc->typ != OPT_notyp) { + OPB_err(124); + } + } + node = OPT_NewNode(26); + node->typ = OPT_notyp; + node->obj = proc; + node->left = *x; + *x = node; +} + +void OPB_Assign (OPT_Node *x, OPT_Node y) +{ + OPT_Node z = NIL; + SHORTINT subcl; + if ((*x)->class >= 7) { + OPB_err(56); + } + OPB_CheckAssign((*x)->typ, y); + if ((*x)->readonly) { + OPB_err(76); + } + if ((*x)->typ->comp == 4) { + if ((*x)->class == 5) { + z = (*x)->left; + } else { + z = *x; + } + if ((z->class == 3 && z->left->class == 5)) { + z->left = z->left->left; + } + if (((*x)->typ->strobj != NIL && (z->class == 3 || z->class == 1))) { + OPB_BindNodes(6, (*x)->typ, &z, NIL); + *x = z; + } + } else if (((((((*x)->typ->comp == 2 && (*x)->typ->BaseTyp == OPT_chartyp)) && y->typ->form == 10)) && y->conval->intval2 == 1)) { + y->typ = OPT_chartyp; + y->conval->intval = 0; + OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0)))); + } + if ((((((__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp == OPT_chartyp)) && __IN(y->typ->comp, 0x0c))) && y->typ->BaseTyp == OPT_chartyp)) { + subcl = 18; + } else { + subcl = 0; + } + OPB_BindNodes(19, OPT_notyp, &*x, y); + (*x)->subcl = subcl; +} + +void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ) +{ + OPT_Node node = NIL; + node = OPT_NewNode(14); + node->typ = typ; + node->conval = OPT_NewConst(); + node->conval->intval = typ->txtpos; + if (*inittd == NIL) { + *inittd = node; + } else { + (*last)->link = node; + } + *last = node; +} + + +export void *OPB__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPS); + __MODULE_IMPORT(OPT); + __REGMOD("OPB", 0); +/* BEGIN */ + OPB_maxExp = OPB_log(1073741824); + OPB_maxExp = OPB_exp; + __ENDMOD; +} diff --git a/bootstrap/windows-48/OPB.h b/bootstrap/windows-48/OPB.h new file mode 100644 index 00000000..8cd47ee6 --- /dev/null +++ b/bootstrap/windows-48/OPB.h @@ -0,0 +1,49 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPB__h +#define OPB__h + +#include "SYSTEM.h" +#include "OPS.h" +#include "OPT.h" + + +import void (*OPB_typSize)(OPT_Struct); + + +import void OPB_Assign (OPT_Node *x, OPT_Node y); +import void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp); +import void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames); +import void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y); +import void OPB_DeRef (OPT_Node *x); +import OPT_Node OPB_EmptySet (void); +import void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc); +import void OPB_Field (OPT_Node *x, OPT_Object y); +import void OPB_In (OPT_Node *x, OPT_Node y); +import void OPB_Index (OPT_Node *x, OPT_Node y); +import void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ); +import void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y); +import void OPB_MOp (SHORTINT op, OPT_Node *x); +import OPT_Node OPB_NewBoolConst (BOOLEAN boolval); +import OPT_Node OPB_NewIntConst (LONGINT intval); +import OPT_Node OPB_NewLeaf (OPT_Object obj); +import OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ); +import OPT_Node OPB_NewString (OPS_String str, LONGINT len); +import OPT_Node OPB_Nil (void); +import void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y); +import void OPB_OptIf (OPT_Node *x); +import void OPB_Param (OPT_Node ap, OPT_Object fp); +import void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar); +import void OPB_Return (OPT_Node *x, OPT_Object proc); +import void OPB_SetElem (OPT_Node *x); +import void OPB_SetRange (OPT_Node *x, OPT_Node y); +import void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno); +import void OPB_StPar0 (OPT_Node *par0, INTEGER fctno); +import void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno); +import void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n); +import void OPB_StaticLink (SHORTINT dlev); +import void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard); +import void *OPB__init(void); + + +#endif diff --git a/bootstrap/windows-48/OPC.c b/bootstrap/windows-48/OPC.c new file mode 100644 index 00000000..32a1496f --- /dev/null +++ b/bootstrap/windows-48/OPC.c @@ -0,0 +1,2108 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "Configuration.h" +#include "OPM.h" +#include "OPT.h" + + +static INTEGER OPC_indentLevel; +static BOOLEAN OPC_ptrinit, OPC_mainprog, OPC_ansi; +static SHORTINT OPC_hashtab[105]; +static CHAR OPC_keytab[36][9]; +static BOOLEAN OPC_GlbPtrs; +static CHAR OPC_BodyNameExt[13]; + + +export void OPC_Align (LONGINT *adr, LONGINT base); +export void OPC_Andent (OPT_Struct typ); +static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames); +export LONGINT OPC_Base (OPT_Struct typ); +export OPT_Object OPC_BaseTProc (OPT_Object obj); +export void OPC_BegBlk (void); +export void OPC_BegStat (void); +static void OPC_CProcDefs (OPT_Object obj, INTEGER vis); +export void OPC_Case (LONGINT caseVal, INTEGER form); +export void OPC_Cmp (INTEGER rel); +export void OPC_CompleteIdent (OPT_Object obj); +export void OPC_Constant (OPT_Const con, INTEGER form); +static void OPC_DeclareBase (OPT_Object dcl); +static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef); +static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro); +static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty); +static void OPC_DefAnonRecs (OPT_Node n); +export void OPC_DefineInter (OPT_Object proc); +static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty); +static void OPC_DefineTProcTypes (OPT_Object obj); +static void OPC_DefineType (OPT_Struct str); +export void OPC_EndBlk (void); +export void OPC_EndBlk0 (void); +export void OPC_EndStat (void); +export void OPC_EnterBody (void); +export void OPC_EnterProc (OPT_Object proc); +export void OPC_ExitBody (void); +export void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet); +static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *n, LONGINT *curAlign); +static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign); +export void OPC_GenBdy (OPT_Node n); +static void OPC_GenDynTypes (OPT_Node n, INTEGER vis); +export void OPC_GenEnumPtrs (OPT_Object var); +export void OPC_GenHdr (OPT_Node n); +export void OPC_GenHdrIncludes (void); +static void OPC_GenHeaderMsg (void); +export void OPC_Halt (LONGINT n); +export void OPC_Ident (OPT_Object obj); +static void OPC_IdentList (OPT_Object obj, INTEGER vis); +static void OPC_Include (CHAR *name, LONGINT name__len); +static void OPC_IncludeImports (OPT_Object obj, INTEGER vis); +export void OPC_Increment (BOOLEAN decrement); +export void OPC_Indent (INTEGER count); +export void OPC_Init (void); +static void OPC_InitImports (OPT_Object obj); +static void OPC_InitKeywords (void); +export void OPC_InitTDesc (OPT_Struct typ); +static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj); +export void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim); +static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName); +static INTEGER OPC_Length (CHAR *s, LONGINT s__len); +export LONGINT OPC_NofPtrs (OPT_Struct typ); +static INTEGER OPC_PerfectHash (CHAR *s, LONGINT s__len); +static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len); +static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define); +static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis); +static void OPC_PutBase (OPT_Struct typ); +static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt); +static void OPC_RegCmds (OPT_Object obj); +export void OPC_SetInclude (BOOLEAN exclude); +static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause); +static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x); +export void OPC_TDescDecl (OPT_Struct typ); +export void OPC_TypeDefs (OPT_Object obj, INTEGER vis); +export void OPC_TypeOf (OPT_Object ap); +static BOOLEAN OPC_Undefined (OPT_Object obj); + + +void OPC_Init (void) +{ + OPC_indentLevel = 0; + OPC_ptrinit = __IN(5, OPM_opt); + OPC_mainprog = OPM_mainProg || OPM_mainLinkStat; + OPC_ansi = __IN(6, OPM_opt); + if (OPC_ansi) { + __MOVE("__init(void)", OPC_BodyNameExt, 13); + } else { + __MOVE("__init()", OPC_BodyNameExt, 9); + } +} + +void OPC_Indent (INTEGER count) +{ + OPC_indentLevel += count; +} + +void OPC_BegStat (void) +{ + INTEGER i; + i = OPC_indentLevel; + while (i > 0) { + OPM_Write(0x09); + i -= 1; + } +} + +void OPC_EndStat (void) +{ + OPM_Write(';'); + OPM_WriteLn(); +} + +void OPC_BegBlk (void) +{ + OPM_Write('{'); + OPM_WriteLn(); + OPC_indentLevel += 1; +} + +void OPC_EndBlk (void) +{ + OPC_indentLevel -= 1; + OPC_BegStat(); + OPM_Write('}'); + OPM_WriteLn(); +} + +void OPC_EndBlk0 (void) +{ + OPC_indentLevel -= 1; + OPC_BegStat(); + OPM_Write('}'); +} + +static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x) +{ + CHAR ch; + INTEGER i; + __DUP(s, s__len, CHAR); + ch = s[0]; + i = 0; + while (ch != 0x00) { + if (ch == '#') { + OPM_WriteInt(x); + } else { + OPM_Write(ch); + } + i += 1; + ch = s[__X(i, s__len)]; + } + __DEL(s); +} + +static INTEGER OPC_Length (CHAR *s, LONGINT s__len) +{ + INTEGER _o_result; + INTEGER i; + i = 0; + while (s[__X(i, s__len)] != 0x00) { + i += 1; + } + _o_result = i; + return _o_result; +} + +static INTEGER OPC_PerfectHash (CHAR *s, LONGINT s__len) +{ + INTEGER _o_result; + INTEGER i, h; + i = 0; + h = 0; + while ((s[__X(i, s__len)] != 0x00 && i < 5)) { + h = 3 * h + (int)s[__X(i, s__len)]; + i += 1; + } + _o_result = (int)__MOD(h, 105); + return _o_result; +} + +void OPC_Ident (OPT_Object obj) +{ + INTEGER mode, level, h; + mode = obj->mode; + level = obj->mnolev; + if ((__IN(mode, 0x62) && level > 0) || __IN(mode, 0x14)) { + OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256))); + h = OPC_PerfectHash((void*)obj->name, ((LONGINT)(256))); + if (OPC_hashtab[__X(h, ((LONGINT)(105)))] >= 0) { + if (__STRCMP(OPC_keytab[__X(OPC_hashtab[__X(h, ((LONGINT)(105)))], ((LONGINT)(36)))], obj->name) == 0) { + OPM_Write('_'); + } + } + } else { + if (mode != 5 || obj->linkadr != 2) { + if (mode == 13) { + OPC_Ident(obj->link->typ->strobj); + } else if (level < 0) { + OPM_WriteStringVar((void*)OPT_GlbMod[__X(-level, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + if (OPM_currFile == 0) { + OPT_GlbMod[__X(-level, ((LONGINT)(64)))]->vis = 1; + } + } else { + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + } + OPM_Write('_'); + } else if (obj == OPT_sysptrtyp->strobj || obj == OPT_bytetyp->strobj) { + OPM_WriteString((CHAR*)"SYSTEM_", (LONGINT)8); + } + OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256))); + } +} + +static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause) +{ + INTEGER pointers; + *openClause = 0; + if (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->comp != 4)) { + if (__IN(typ->comp, 0x0c)) { + OPC_Stars(typ->BaseTyp, &*openClause); + *openClause = typ->comp == 2; + } else if (typ->form == 14) { + OPM_Write('('); + OPM_Write('*'); + } else { + pointers = 0; + while (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->form == 13)) { + pointers += 1; + typ = typ->BaseTyp; + } + if (pointers > 0) { + if (typ->comp != 3) { + OPC_Stars(typ, &*openClause); + } + if (*openClause) { + OPM_Write('('); + *openClause = 0; + } + while (pointers > 0) { + OPM_Write('*'); + pointers -= 1; + } + } + } + } +} + +static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef) +{ + OPT_Struct typ = NIL; + BOOLEAN varPar, openClause; + INTEGER form, comp; + typ = dcl->typ; + varPar = ((dcl->mode == 2 && typ->comp != 2) || typ->comp == 3) || scopeDef; + OPC_Stars(typ, &openClause); + if (varPar) { + if (openClause) { + OPM_Write('('); + } + OPM_Write('*'); + } + if (dcl->name[0] != 0x00) { + OPC_Ident(dcl); + } + if ((varPar && openClause)) { + OPM_Write(')'); + } + openClause = 0; + for (;;) { + form = typ->form; + comp = typ->comp; + if (((typ->strobj != NIL && typ->strobj->name[0] != 0x00) || form == 12) || comp == 4) { + break; + } else if ((form == 13 && typ->BaseTyp->comp != 3)) { + openClause = 1; + } else if (form == 14 || __IN(comp, 0x0c)) { + if (openClause) { + OPM_Write(')'); + openClause = 0; + } + if (form == 14) { + if (OPC_ansi) { + OPM_Write(')'); + OPC_AnsiParamList(typ->link, 0); + } else { + OPM_WriteString((CHAR*)")()", (LONGINT)4); + } + break; + } else if (comp == 2) { + OPM_Write('['); + OPM_WriteInt(typ->n); + OPM_Write(']'); + } + } else { + break; + } + typ = typ->BaseTyp; + } +} + +void OPC_Andent (OPT_Struct typ) +{ + if (typ->strobj == NIL || typ->align >= 65536) { + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + OPC_Str1((CHAR*)"__#", (LONGINT)4, __ASHR(typ->align, 16)); + } else { + OPC_Ident(typ->strobj); + } +} + +static BOOLEAN OPC_Undefined (OPT_Object obj) +{ + BOOLEAN _o_result; + _o_result = (((obj->mnolev >= 0 && obj->linkadr != (LONGINT)(3 + OPM_currFile))) && obj->linkadr != 2) || obj->name[0] == 0x00; + return _o_result; +} + +static void OPC_DeclareBase (OPT_Object dcl) +{ + OPT_Struct typ = NIL, prev = NIL; + OPT_Object obj = NIL; + INTEGER nofdims; + LONGINT off, n, dummy; + typ = dcl->typ; + prev = typ; + while ((((((((typ->strobj == NIL || typ->comp == 3) || OPC_Undefined(typ->strobj)) && typ->comp != 4)) && typ->form != 12)) && !((typ->form == 13 && typ->BaseTyp->comp == 3)))) { + prev = typ; + typ = typ->BaseTyp; + } + obj = typ->strobj; + if (typ->form == 12) { + OPM_WriteString((CHAR*)"void", (LONGINT)5); + } else if ((obj != NIL && !OPC_Undefined(obj))) { + OPC_Ident(obj); + } else if (typ->comp == 4) { + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPC_Andent(typ); + if ((prev->form != 13 && (obj != NIL || dcl->name[0] == 0x00))) { + if ((typ->BaseTyp != NIL && typ->BaseTyp->strobj->vis != 0)) { + OPM_WriteString((CHAR*)" { /* ", (LONGINT)7); + OPC_Ident(typ->BaseTyp->strobj); + OPM_WriteString((CHAR*)" */", (LONGINT)4); + OPM_WriteLn(); + OPC_Indent(1); + } else { + OPM_Write(' '); + OPC_BegBlk(); + } + OPC_FieldList(typ, 1, &off, &n, &dummy); + OPC_EndBlk0(); + } + } else if ((typ->form == 13 && typ->BaseTyp->comp == 3)) { + typ = typ->BaseTyp->BaseTyp; + nofdims = 1; + while (typ->comp == 3) { + nofdims += 1; + typ = typ->BaseTyp; + } + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPC_BegBlk(); + OPC_BegStat(); + OPC_Str1((CHAR*)"LONGINT len[#]", (LONGINT)15, nofdims); + OPC_EndStat(); + OPC_BegStat(); + __NEW(obj, OPT_ObjDesc); + __NEW(obj->typ, OPT_StrDesc); + obj->typ->form = 15; + obj->typ->comp = 2; + obj->typ->n = 1; + obj->typ->BaseTyp = typ; + obj->mode = 4; + __MOVE("data", obj->name, 5); + obj->linkadr = 0; + OPC_DeclareBase(obj); + OPM_Write(' '); + OPC_DeclareObj(obj, 0); + OPC_EndStat(); + OPC_EndBlk0(); + } +} + +LONGINT OPC_NofPtrs (OPT_Struct typ) +{ + LONGINT _o_result; + OPT_Object fld = NIL; + OPT_Struct btyp = NIL; + LONGINT n; + if ((typ->form == 13 && typ->sysflag == 0)) { + _o_result = 1; + return _o_result; + } else if ((typ->comp == 4 && __MASK(typ->sysflag, -256) == 0)) { + btyp = typ->BaseTyp; + if (btyp != NIL) { + n = OPC_NofPtrs(btyp); + } else { + n = 0; + } + fld = typ->link; + while ((fld != NIL && fld->mode == 4)) { + if (__STRCMP(fld->name, "@ptr") != 0) { + n = n + OPC_NofPtrs(fld->typ); + } else { + n += 1; + } + fld = fld->link; + } + _o_result = n; + return _o_result; + } else if (typ->comp == 2) { + btyp = typ->BaseTyp; + n = typ->n; + while (btyp->comp == 2) { + n = btyp->n * n; + btyp = btyp->BaseTyp; + } + _o_result = OPC_NofPtrs(btyp) * n; + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt) +{ + OPT_Object fld = NIL; + OPT_Struct btyp = NIL; + LONGINT n, i; + if ((typ->form == 13 && typ->sysflag == 0)) { + OPM_WriteInt(adr); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + *cnt += 1; + if (__MASK(*cnt, -16) == 0) { + OPM_WriteLn(); + OPM_Write(0x09); + } + } else if ((typ->comp == 4 && __MASK(typ->sysflag, -256) == 0)) { + btyp = typ->BaseTyp; + if (btyp != NIL) { + OPC_PutPtrOffsets(btyp, adr, &*cnt); + } + fld = typ->link; + while ((fld != NIL && fld->mode == 4)) { + if (__STRCMP(fld->name, "@ptr") != 0) { + OPC_PutPtrOffsets(fld->typ, adr + fld->adr, &*cnt); + } else { + OPM_WriteInt(adr + fld->adr); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + *cnt += 1; + if (__MASK(*cnt, -16) == 0) { + OPM_WriteLn(); + OPM_Write(0x09); + } + } + fld = fld->link; + } + } else if (typ->comp == 2) { + btyp = typ->BaseTyp; + n = typ->n; + while (btyp->comp == 2) { + n = btyp->n * n; + btyp = btyp->BaseTyp; + } + if (OPC_NofPtrs(btyp) > 0) { + i = 0; + while (i < n) { + OPC_PutPtrOffsets(btyp, adr + i * btyp->size, &*cnt); + i += 1; + } + } + } +} + +static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj) +{ + if (obj != NIL) { + OPC_InitTProcs(typ, obj->left); + if (obj->mode == 13) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"__INITBP(", (LONGINT)10); + OPC_Ident(typ); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(obj); + OPC_Str1((CHAR*)", #)", (LONGINT)5, __ASHR(obj->adr, 16)); + OPC_EndStat(); + } + OPC_InitTProcs(typ, obj->right); + } +} + +static void OPC_PutBase (OPT_Struct typ) +{ + if (typ != NIL) { + OPC_PutBase(typ->BaseTyp); + OPC_Ident(typ->strobj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + } +} + +static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName) +{ + OPT_Struct typ = NIL; + INTEGER dim; + if (showParamName) { + OPC_Ident(par); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + } + dim = 1; + typ = par->typ->BaseTyp; + while (typ->comp == 3) { + if (ansiDefine) { + OPM_WriteString((CHAR*)", LONGINT ", (LONGINT)11); + } else { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + } + if (showParamName) { + OPC_Ident(par); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + OPM_WriteInt(dim); + } + typ = typ->BaseTyp; + dim += 1; + } +} + +static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro) +{ + OPM_Write('('); + while (par != NIL) { + if (macro) { + OPM_WriteStringVar((void*)par->name, ((LONGINT)(256))); + } else { + if ((par->mode == 1 && par->typ->form == 7)) { + OPM_Write('_'); + } + OPC_Ident(par); + } + if (par->typ->comp == 3) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_LenList(par, 0, 1); + } else if ((par->mode == 2 && par->typ->comp == 4)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteStringVar((void*)par->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } + par = par->link; + if (par != NIL) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + } + } + OPM_Write(')'); +} + +static void OPC_DefineTProcTypes (OPT_Object obj) +{ + OPT_Object par = NIL; + if (obj->typ != OPT_notyp) { + OPC_DefineType(obj->typ); + } + if (OPC_ansi) { + par = obj->link; + while (par != NIL) { + OPC_DefineType(par->typ); + par = par->link; + } + } +} + +static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty) +{ + if (obj != NIL) { + OPC_DeclareTProcs(obj->left, &*empty); + if (obj->mode == 13) { + if (obj->typ != OPT_notyp) { + OPC_DefineType(obj->typ); + } + if (OPM_currFile == 0) { + if (obj->vis == 1) { + OPC_DefineTProcTypes(obj); + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + *empty = 0; + OPC_ProcHeader(obj, 0); + } + } else { + *empty = 0; + OPC_DefineTProcTypes(obj); + if (obj->vis == 0) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + } + OPC_ProcHeader(obj, 0); + } + } + OPC_DeclareTProcs(obj->right, &*empty); + } +} + +OPT_Object OPC_BaseTProc (OPT_Object obj) +{ + OPT_Object _o_result; + OPT_Struct typ = NIL, base = NIL; + LONGINT mno; + typ = obj->link->typ; + if (typ->form == 13) { + typ = typ->BaseTyp; + } + base = typ->BaseTyp; + mno = __ASHR(obj->adr, 16); + while ((base != NIL && mno < base->n)) { + typ = base; + base = typ->BaseTyp; + } + OPT_FindField(obj->name, typ, &obj); + _o_result = obj; + return _o_result; +} + +static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty) +{ + if (obj != NIL) { + OPC_DefineTProcMacros(obj->left, &*empty); + if ((((obj->mode == 13 && obj == OPC_BaseTProc(obj))) && (OPM_currFile != 0 || obj->vis == 1))) { + OPM_WriteString((CHAR*)"#define __", (LONGINT)11); + OPC_Ident(obj); + OPC_DeclareParams(obj->link, 1); + OPM_WriteString((CHAR*)" __SEND(", (LONGINT)9); + if (obj->link->typ->form == 13) { + OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10); + OPC_Ident(obj->link); + OPM_Write(')'); + } else { + OPC_Ident(obj->link); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } + OPC_Str1((CHAR*)", #, ", (LONGINT)6, __ASHR(obj->adr, 16)); + if (obj->typ == OPT_notyp) { + OPM_WriteString((CHAR*)"void", (LONGINT)5); + } else { + OPC_Ident(obj->typ->strobj); + } + OPM_WriteString((CHAR*)"(*)", (LONGINT)4); + if (OPC_ansi) { + OPC_AnsiParamList(obj->link, 0); + } else { + OPM_WriteString((CHAR*)"()", (LONGINT)3); + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_DeclareParams(obj->link, 1); + OPM_Write(')'); + OPM_WriteLn(); + } + OPC_DefineTProcMacros(obj->right, &*empty); + } +} + +static void OPC_DefineType (OPT_Struct str) +{ + OPT_Object obj = NIL, field = NIL, par = NIL; + BOOLEAN empty; + if (OPM_currFile == 1 || str->ref < 255) { + obj = str->strobj; + if (obj == NIL || OPC_Undefined(obj)) { + if (obj != NIL) { + if (obj->linkadr == 1) { + if (str->form != 13) { + OPM_Mark(244, str->txtpos); + obj->linkadr = 2; + } + } else { + obj->linkadr = 1; + } + } + if (str->comp == 4) { + if (str->BaseTyp != NIL) { + OPC_DefineType(str->BaseTyp); + } + field = str->link; + while ((field != NIL && field->mode == 4)) { + if (field->vis != 0 || OPM_currFile == 1) { + OPC_DefineType(field->typ); + } + field = field->link; + } + } else if (str->form == 13) { + if (str->BaseTyp->comp != 4) { + OPC_DefineType(str->BaseTyp); + } + } else if (__IN(str->comp, 0x0c)) { + OPC_DefineType(str->BaseTyp); + } else if (str->form == 14) { + if (str->BaseTyp != OPT_notyp) { + OPC_DefineType(str->BaseTyp); + } + field = str->link; + while (field != NIL) { + OPC_DefineType(field->typ); + field = field->link; + } + } + } + if ((obj != NIL && OPC_Undefined(obj))) { + OPM_WriteString((CHAR*)"typedef", (LONGINT)8); + OPM_WriteLn(); + OPM_Write(0x09); + OPC_Indent(1); + obj->linkadr = 1; + OPC_DeclareBase(obj); + OPM_Write(' '); + obj->typ->strobj = NIL; + OPC_DeclareObj(obj, 0); + obj->typ->strobj = obj; + obj->linkadr = 3 + OPM_currFile; + OPC_EndStat(); + OPC_Indent(-1); + OPM_WriteLn(); + if (obj->typ->comp == 4) { + empty = 1; + OPC_DeclareTProcs(str->link, &empty); + OPC_DefineTProcMacros(str->link, &empty); + if (!empty) { + OPM_WriteLn(); + } + } + } + } +} + +static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len) +{ + BOOLEAN _o_result; + INTEGER i; + BOOLEAN r; + __DUP(y, y__len, CHAR); + i = 0; + while ((*x)[__X(i + 1, ((LONGINT)(256)))] == y[__X(i, y__len)]) { + i += 1; + } + r = y[__X(i, y__len)] == 0x00; + _o_result = r; + __DEL(y); + return _o_result; +} + +static void OPC_CProcDefs (OPT_Object obj, INTEGER vis) +{ + INTEGER i; + OPT_ConstExt ext = NIL; + INTEGER _for__9; + if (obj != NIL) { + OPC_CProcDefs(obj->left, vis); + if ((((obj->mode == 9 && (int)obj->vis >= vis)) && obj->adr == 1)) { + ext = obj->conval->ext; + i = 1; + if (((*ext)[1] != '#' && !(OPC_Prefixed(ext, (CHAR*)"extern ", (LONGINT)8) || OPC_Prefixed(ext, (CHAR*)"import ", (LONGINT)8)))) { + OPM_WriteString((CHAR*)"#define ", (LONGINT)9); + OPC_Ident(obj); + OPC_DeclareParams(obj->link, 1); + OPM_Write(0x09); + } + _for__9 = (int)(*obj->conval->ext)[0]; + i = i; + while (i <= _for__9) { + OPM_Write((*obj->conval->ext)[__X(i, ((LONGINT)(256)))]); + i += 1; + } + OPM_WriteLn(); + } + OPC_CProcDefs(obj->right, vis); + } +} + +void OPC_TypeDefs (OPT_Object obj, INTEGER vis) +{ + if (obj != NIL) { + OPC_TypeDefs(obj->left, vis); + if ((obj->mode == 5 && obj->typ->txtpos > 0)) { + OPC_DefineType(obj->typ); + } + OPC_TypeDefs(obj->right, vis); + } +} + +static void OPC_DefAnonRecs (OPT_Node n) +{ + OPT_Object o = NIL; + OPT_Struct typ = NIL; + while ((n != NIL && n->class == 14)) { + typ = n->typ; + if ((typ->strobj == NIL && (OPM_currFile == 1 || typ->ref < 255))) { + OPC_DefineType(typ); + __NEW(o, OPT_ObjDesc); + o->typ = typ; + o->name[0] = 0x00; + OPC_DeclareBase(o); + OPC_EndStat(); + OPM_WriteLn(); + } + n = n->link; + } +} + +void OPC_TDescDecl (OPT_Struct typ) +{ + LONGINT nofptrs; + OPT_Object o = NIL; + OPC_BegStat(); + OPM_WriteString((CHAR*)"__TDESC(", (LONGINT)9); + OPC_Andent(typ); + OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1); + OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ)); + OPM_Write('\"'); + if (typ->strobj != NIL) { + OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256))); + } + OPC_Str1((CHAR*)"\", #), {", (LONGINT)9, typ->size); + nofptrs = 0; + OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs); + OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (LONGINT)OPM_LIntSize)); + OPC_EndStat(); +} + +void OPC_InitTDesc (OPT_Struct typ) +{ + OPC_BegStat(); + OPM_WriteString((CHAR*)"__INITYP(", (LONGINT)10); + OPC_Andent(typ); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (typ->BaseTyp != NIL) { + OPC_Andent(typ->BaseTyp); + } else { + OPC_Andent(typ); + } + OPC_Str1((CHAR*)", #)", (LONGINT)5, typ->extlev); + OPC_EndStat(); + if (typ->strobj != NIL) { + OPC_InitTProcs(typ->strobj, typ->link); + } +} + +void OPC_Align (LONGINT *adr, LONGINT base) +{ + switch (base) { + case 2: + *adr += __MASK(*adr, -2); + break; + case 4: + *adr += __MASK(-*adr, -4); + break; + case 8: + *adr += __MASK(-*adr, -8); + break; + case 16: + *adr += __MASK(-*adr, -16); + break; + default: + break; + } +} + +LONGINT OPC_Base (OPT_Struct typ) +{ + LONGINT _o_result; + switch (typ->form) { + case 1: + _o_result = 1; + return _o_result; + break; + case 3: + _o_result = OPM_CharAlign; + return _o_result; + break; + case 2: + _o_result = OPM_BoolAlign; + return _o_result; + break; + case 4: + _o_result = OPM_SIntAlign; + return _o_result; + break; + case 5: + _o_result = OPM_IntAlign; + return _o_result; + break; + case 6: + _o_result = OPM_LIntAlign; + return _o_result; + break; + case 7: + _o_result = OPM_RealAlign; + return _o_result; + break; + case 8: + _o_result = OPM_LRealAlign; + return _o_result; + break; + case 9: + _o_result = OPM_SetAlign; + return _o_result; + break; + case 13: + _o_result = OPM_PointerAlign; + return _o_result; + break; + case 14: + _o_result = OPM_ProcAlign; + return _o_result; + break; + case 15: + if (typ->comp == 4) { + _o_result = __MASK(typ->align, -65536); + return _o_result; + } else { + _o_result = OPC_Base(typ->BaseTyp); + return _o_result; + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPC.Base, typ^form = ", (LONGINT)40); + OPM_LogWNum(typ->form, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + __RETCHK; +} + +static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign) +{ + LONGINT adr; + adr = off; + OPC_Align(&adr, align); + if ((*curAlign < align && gap - (adr - off) >= align)) { + gap -= (adr - off) + align; + OPC_BegStat(); + if (align == (LONGINT)OPM_IntSize) { + OPM_WriteString((CHAR*)"INTEGER", (LONGINT)8); + } else if (align == (LONGINT)OPM_LIntSize) { + OPM_WriteString((CHAR*)"LONGINT", (LONGINT)8); + } else if (align == (LONGINT)OPM_LRealSize) { + OPM_WriteString((CHAR*)"LONGREAL", (LONGINT)9); + } + OPC_Str1((CHAR*)" _prvt#", (LONGINT)8, *n); + *n += 1; + OPC_EndStat(); + *curAlign = align; + } + if (gap > 0) { + OPC_BegStat(); + OPC_Str1((CHAR*)"char _prvt#", (LONGINT)12, *n); + *n += 1; + OPC_Str1((CHAR*)"[#]", (LONGINT)4, gap); + OPC_EndStat(); + } +} + +static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *n, LONGINT *curAlign) +{ + OPT_Object fld = NIL; + OPT_Struct base = NIL; + LONGINT gap, adr, align, fldAlign; + fld = typ->link; + align = __MASK(typ->align, -65536); + if (typ->BaseTyp != NIL) { + OPC_FieldList(typ->BaseTyp, 0, &*off, &*n, &*curAlign); + } else { + *off = 0; + *n = 0; + *curAlign = 1; + } + while ((fld != NIL && fld->mode == 4)) { + if ((OPM_currFile == 0 && fld->vis == 0) || (((OPM_currFile == 1 && fld->vis == 0)) && typ->mno != 0)) { + fld = fld->link; + while ((((fld != NIL && fld->mode == 4)) && fld->vis == 0)) { + fld = fld->link; + } + } else { + adr = *off; + fldAlign = OPC_Base(fld->typ); + OPC_Align(&adr, fldAlign); + gap = fld->adr - adr; + if (fldAlign > *curAlign) { + *curAlign = fldAlign; + } + if (gap > 0) { + OPC_FillGap(gap, *off, align, &*n, &*curAlign); + } + OPC_BegStat(); + OPC_DeclareBase(fld); + OPM_Write(' '); + OPC_DeclareObj(fld, 0); + *off = fld->adr + fld->typ->size; + base = fld->typ; + fld = fld->link; + while ((((((((fld != NIL && fld->mode == 4)) && fld->typ == base)) && fld->adr == *off)) && ((OPM_currFile == 1 || fld->vis != 0) || fld->typ->strobj == NIL))) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_DeclareObj(fld, 0); + *off = fld->adr + fld->typ->size; + fld = fld->link; + } + OPC_EndStat(); + } + } + if (last) { + adr = typ->size - (LONGINT)__ASHR(typ->sysflag, 8); + if (adr == 0) { + gap = 1; + } else { + gap = adr - *off; + } + if (gap > 0) { + OPC_FillGap(gap, *off, align, &*n, &*curAlign); + } + } +} + +static void OPC_IdentList (OPT_Object obj, INTEGER vis) +{ + OPT_Struct base = NIL; + BOOLEAN first; + INTEGER lastvis; + base = NIL; + first = 1; + while ((obj != NIL && obj->mode != 13)) { + if ((__IN(vis, 0x05) || (vis == 1 && obj->vis != 0)) || (vis == 3 && !obj->leaf)) { + if (obj->typ != base || (int)obj->vis != lastvis) { + if (!first) { + OPC_EndStat(); + } + first = 0; + base = obj->typ; + lastvis = obj->vis; + OPC_BegStat(); + if ((vis == 1 && obj->vis != 0)) { + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + } else if ((obj->mnolev == 0 && vis == 0)) { + if (obj->vis == 0) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + } + } + if ((((vis == 2 && obj->mode == 1)) && base->form == 7)) { + OPM_WriteString((CHAR*)"double", (LONGINT)7); + } else { + OPC_DeclareBase(obj); + } + } else { + OPM_Write(','); + } + OPM_Write(' '); + if ((((vis == 2 && obj->mode == 1)) && base->form == 7)) { + OPM_Write('_'); + } + OPC_DeclareObj(obj, vis == 3); + if (obj->typ->comp == 3) { + OPC_EndStat(); + OPC_BegStat(); + base = OPT_linttyp; + OPM_WriteString((CHAR*)"LONGINT ", (LONGINT)9); + OPC_LenList(obj, 0, 1); + } else if ((obj->mode == 2 && obj->typ->comp == 4)) { + OPC_EndStat(); + OPC_BegStat(); + OPM_WriteString((CHAR*)"LONGINT *", (LONGINT)10); + OPC_Ident(obj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + base = NIL; + } else if ((((((OPC_ptrinit && vis == 0)) && obj->mnolev > 0)) && obj->typ->form == 13)) { + OPM_WriteString((CHAR*)" = NIL", (LONGINT)7); + } + } + obj = obj->link; + } + if (!first) { + OPC_EndStat(); + } +} + +static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames) +{ + CHAR name[32]; + OPM_Write('('); + if (obj == NIL || obj->mode == 13) { + OPM_WriteString((CHAR*)"void", (LONGINT)5); + } else { + for (;;) { + OPC_DeclareBase(obj); + if (showParamNames) { + OPM_Write(' '); + OPC_DeclareObj(obj, 0); + } else { + __COPY(obj->name, name, ((LONGINT)(32))); + obj->name[0] = 0x00; + OPC_DeclareObj(obj, 0); + __COPY(name, obj->name, ((LONGINT)(256))); + } + if (obj->typ->comp == 3) { + OPM_WriteString((CHAR*)", LONGINT ", (LONGINT)11); + OPC_LenList(obj, 1, showParamNames); + } else if ((obj->mode == 2 && obj->typ->comp == 4)) { + OPM_WriteString((CHAR*)", LONGINT *", (LONGINT)12); + if (showParamNames) { + OPC_Ident(obj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } + } + if (obj->link == NIL || obj->link->mode == 13) { + break; + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + obj = obj->link; + } + } + OPM_Write(')'); +} + +static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define) +{ + if (proc->typ == OPT_notyp) { + OPM_WriteString((CHAR*)"void", (LONGINT)5); + } else { + OPC_Ident(proc->typ->strobj); + } + OPM_Write(' '); + OPC_Ident(proc); + OPM_Write(' '); + if (OPC_ansi) { + OPC_AnsiParamList(proc->link, 1); + if (!define) { + OPM_Write(';'); + } + OPM_WriteLn(); + } else if (define) { + OPC_DeclareParams(proc->link, 0); + OPM_WriteLn(); + OPC_Indent(1); + OPC_IdentList(proc->link, 2); + OPC_Indent(-1); + } else { + OPM_WriteString((CHAR*)"();", (LONGINT)4); + OPM_WriteLn(); + } +} + +static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis) +{ + if (obj != NIL) { + OPC_ProcPredefs(obj->left, vis); + if ((((__IN(obj->mode, 0xc0) && obj->vis >= vis)) && (obj->history != 4 || obj->mode == 6))) { + if (vis == 1) { + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + } else if (obj->vis == 0) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + } + OPC_ProcHeader(obj, 0); + } + OPC_ProcPredefs(obj->right, vis); + } +} + +static void OPC_Include (CHAR *name, LONGINT name__len) +{ + __DUP(name, name__len, CHAR); + OPM_WriteString((CHAR*)"#include ", (LONGINT)10); + OPM_Write('\"'); + OPM_WriteStringVar((void*)name, name__len); + OPM_WriteString((CHAR*)".h", (LONGINT)3); + OPM_Write('\"'); + OPM_WriteLn(); + __DEL(name); +} + +static void OPC_IncludeImports (OPT_Object obj, INTEGER vis) +{ + if (obj != NIL) { + OPC_IncludeImports(obj->left, vis); + if ((((obj->mode == 11 && obj->mnolev != 0)) && (int)OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->vis >= vis)) { + OPC_Include(OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + } + OPC_IncludeImports(obj->right, vis); + } +} + +static void OPC_GenDynTypes (OPT_Node n, INTEGER vis) +{ + OPT_Struct typ = NIL; + while ((n != NIL && n->class == 14)) { + typ = n->typ; + if (vis == 0 || typ->ref < 255) { + OPC_BegStat(); + if (vis == 1) { + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + } else if ((typ->strobj != NIL && typ->strobj->mnolev > 0)) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + } + OPM_WriteString((CHAR*)"LONGINT *", (LONGINT)10); + OPC_Andent(typ); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPC_EndStat(); + } + n = n->link; + } +} + +void OPC_GenHdr (OPT_Node n) +{ + OPM_currFile = 0; + OPC_DefAnonRecs(n); + OPC_TypeDefs(OPT_topScope->right, 1); + OPM_WriteLn(); + OPC_IdentList(OPT_topScope->scope, 1); + OPM_WriteLn(); + OPC_GenDynTypes(n, 1); + OPM_WriteLn(); + OPC_ProcPredefs(OPT_topScope->right, 1); + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + OPM_WriteString((CHAR*)"void *", (LONGINT)7); + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + OPM_WriteString(OPC_BodyNameExt, ((LONGINT)(13))); + OPC_EndStat(); + OPM_WriteLn(); + OPC_CProcDefs(OPT_topScope->right, 1); + OPM_WriteLn(); + OPM_WriteString((CHAR*)"#endif", (LONGINT)7); + OPM_WriteLn(); +} + +static void OPC_GenHeaderMsg (void) +{ + INTEGER i; + OPM_WriteString((CHAR*)"/*", (LONGINT)3); + OPM_WriteString((CHAR*)" voc ", (LONGINT)6); + OPM_Write(' '); + OPM_WriteString((CHAR*)"1.2 [2016/06/15] for gcc LP64 on cygwin", (LONGINT)40); + OPM_Write(' '); + i = 0; + while (i <= 31) { + if (__IN(i, OPM_glbopt)) { + switch (i) { + case 0: + OPM_Write('x'); + break; + case 2: + OPM_Write('r'); + break; + case 3: + OPM_Write('t'); + break; + case 4: + OPM_Write('s'); + break; + case 5: + OPM_Write('p'); + break; + case 6: + OPM_Write('k'); + break; + case 7: + OPM_Write('a'); + break; + case 9: + OPM_Write('e'); + break; + case 10: + OPM_Write('m'); + break; + case 13: + OPM_Write('S'); + break; + case 14: + OPM_Write('c'); + break; + case 15: + OPM_Write('M'); + break; + case 16: + OPM_Write('f'); + break; + case 17: + OPM_Write('F'); + break; + case 18: + OPM_Write('v'); + break; + default: + OPM_LogWStr((CHAR*)"( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg", (LONGINT)126); + OPM_LogWLn(); + break; + } + } + i += 1; + } + OPM_WriteString((CHAR*)" */", (LONGINT)4); + OPM_WriteLn(); +} + +void OPC_GenHdrIncludes (void) +{ + OPM_currFile = 2; + OPC_GenHeaderMsg(); + OPM_WriteLn(); + OPM_WriteString((CHAR*)"#ifndef ", (LONGINT)9); + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + OPM_WriteString((CHAR*)"__h", (LONGINT)4); + OPM_WriteLn(); + OPM_WriteString((CHAR*)"#define ", (LONGINT)9); + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + OPM_WriteString((CHAR*)"__h", (LONGINT)4); + OPM_WriteLn(); + OPM_WriteLn(); + if (OPM_LIntSize == 8) { + OPM_WriteString((CHAR*)"#define LARGE", (LONGINT)14); + OPM_WriteLn(); + } + OPC_Include((CHAR*)"SYSTEM", (LONGINT)7); + OPC_IncludeImports(OPT_topScope->right, 1); + OPM_WriteLn(); +} + +void OPC_GenBdy (OPT_Node n) +{ + OPM_currFile = 1; + OPC_GenHeaderMsg(); + if (OPM_LIntSize == 8) { + OPM_WriteString((CHAR*)"#define LARGE", (LONGINT)14); + OPM_WriteLn(); + } + OPC_Include((CHAR*)"SYSTEM", (LONGINT)7); + OPC_IncludeImports(OPT_topScope->right, 0); + OPM_WriteLn(); + OPC_DefAnonRecs(n); + OPC_TypeDefs(OPT_topScope->right, 0); + OPM_WriteLn(); + OPC_IdentList(OPT_topScope->scope, 0); + OPM_WriteLn(); + OPC_GenDynTypes(n, 0); + OPM_WriteLn(); + OPC_ProcPredefs(OPT_topScope->right, 0); + OPM_WriteLn(); + OPC_CProcDefs(OPT_topScope->right, 0); + OPM_WriteLn(); +} + +static void OPC_RegCmds (OPT_Object obj) +{ + if (obj != NIL) { + OPC_RegCmds(obj->left); + if ((obj->mode == 7 && obj->history != 4)) { + if ((((obj->vis != 0 && obj->link == NIL)) && obj->typ == OPT_notyp)) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"__REGCMD(\"", (LONGINT)11); + OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"\", ", (LONGINT)4); + OPC_Ident(obj); + OPM_Write(')'); + OPC_EndStat(); + } + } + OPC_RegCmds(obj->right); + } +} + +static void OPC_InitImports (OPT_Object obj) +{ + if (obj != NIL) { + OPC_InitImports(obj->left); + if ((obj->mode == 11 && obj->mnolev != 0)) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"__MODULE_IMPORT(", (LONGINT)17); + OPM_WriteStringVar((void*)OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + OPM_Write(')'); + OPC_EndStat(); + } + OPC_InitImports(obj->right); + } +} + +void OPC_GenEnumPtrs (OPT_Object var) +{ + OPT_Struct typ = NIL; + LONGINT n; + OPC_GlbPtrs = 0; + while (var != NIL) { + typ = var->typ; + if (OPC_NofPtrs(typ) > 0) { + if (!OPC_GlbPtrs) { + OPC_GlbPtrs = 1; + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + if (OPC_ansi) { + OPM_WriteString((CHAR*)"void EnumPtrs(void (*P)(void*))", (LONGINT)32); + } else { + OPM_WriteString((CHAR*)"void EnumPtrs(P)", (LONGINT)17); + OPM_WriteLn(); + OPM_Write(0x09); + OPM_WriteString((CHAR*)"void (*P)();", (LONGINT)13); + } + OPM_WriteLn(); + OPC_BegBlk(); + } + OPC_BegStat(); + if (typ->form == 13) { + OPM_WriteString((CHAR*)"P(", (LONGINT)3); + OPC_Ident(var); + OPM_Write(')'); + } else if (typ->comp == 4) { + OPM_WriteString((CHAR*)"__ENUMR(&", (LONGINT)10); + OPC_Ident(var); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(typ); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPC_Str1((CHAR*)", #", (LONGINT)4, typ->size); + OPM_WriteString((CHAR*)", 1, P)", (LONGINT)8); + } else if (typ->comp == 2) { + n = typ->n; + typ = typ->BaseTyp; + while (typ->comp == 2) { + n = n * typ->n; + typ = typ->BaseTyp; + } + if (typ->form == 13) { + OPM_WriteString((CHAR*)"__ENUMP(", (LONGINT)9); + OPC_Ident(var); + OPC_Str1((CHAR*)", #, P)", (LONGINT)8, n); + } else if (typ->comp == 4) { + OPM_WriteString((CHAR*)"__ENUMR(", (LONGINT)9); + OPC_Ident(var); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(typ); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPC_Str1((CHAR*)", #", (LONGINT)4, typ->size); + OPC_Str1((CHAR*)", #, P)", (LONGINT)8, n); + } + } + OPC_EndStat(); + } + var = var->link; + } + if (OPC_GlbPtrs) { + OPC_EndBlk(); + OPM_WriteLn(); + } +} + +void OPC_EnterBody (void) +{ + OPM_WriteLn(); + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + if (OPC_mainprog) { + if (OPC_ansi) { + OPM_WriteString((CHAR*)"int main(int argc, char **argv)", (LONGINT)32); + OPM_WriteLn(); + } else { + OPM_WriteString((CHAR*)"main(argc, argv)", (LONGINT)17); + OPM_WriteLn(); + OPM_Write(0x09); + OPM_WriteString((CHAR*)"int argc; char **argv;", (LONGINT)23); + OPM_WriteLn(); + } + } else { + OPM_WriteString((CHAR*)"void *", (LONGINT)7); + OPM_WriteString(OPM_modName, ((LONGINT)(32))); + OPM_WriteString(OPC_BodyNameExt, ((LONGINT)(13))); + OPM_WriteLn(); + } + OPC_BegBlk(); + OPC_BegStat(); + if (OPC_mainprog) { + OPM_WriteString((CHAR*)"__INIT(argc, argv)", (LONGINT)19); + } else { + OPM_WriteString((CHAR*)"__DEFMOD", (LONGINT)9); + } + OPC_EndStat(); + if ((OPC_mainprog && 0)) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"/*don`t do it!*/ printf(\"DEMO VERSION: DO NOT USE THIS PROGRAM FOR ANY COMMERCIAL PURPOSE\\n\")", (LONGINT)94); + OPC_EndStat(); + } + OPC_InitImports(OPT_topScope->right); + OPC_BegStat(); + if (OPC_mainprog) { + OPM_WriteString((CHAR*)"__REGMAIN(\"", (LONGINT)12); + } else { + OPM_WriteString((CHAR*)"__REGMOD(\"", (LONGINT)11); + } + OPM_WriteString(OPM_modName, ((LONGINT)(32))); + if (OPC_GlbPtrs) { + OPM_WriteString((CHAR*)"\", EnumPtrs)", (LONGINT)13); + } else { + OPM_WriteString((CHAR*)"\", 0)", (LONGINT)6); + } + OPC_EndStat(); + if (__STRCMP(OPM_modName, "SYSTEM") != 0) { + OPC_RegCmds(OPT_topScope); + } +} + +void OPC_ExitBody (void) +{ + OPC_BegStat(); + if (OPC_mainprog) { + OPM_WriteString((CHAR*)"__FINI;", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ENDMOD;", (LONGINT)10); + } + OPM_WriteLn(); + OPC_EndBlk(); +} + +void OPC_DefineInter (OPT_Object proc) +{ + OPT_Object scope = NIL; + scope = proc->scope; + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_Write(' '); + OPC_BegBlk(); + OPC_IdentList(proc->link, 3); + OPC_IdentList(scope->scope, 3); + OPC_BegStat(); + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_Write(' '); + OPM_Write('*'); + OPM_WriteString((CHAR*)"lnk", (LONGINT)4); + OPC_EndStat(); + OPC_EndBlk0(); + OPM_Write(' '); + OPM_Write('*'); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPC_EndStat(); + OPM_WriteLn(); + OPC_ProcPredefs(scope->right, 0); + OPM_WriteLn(); +} + +void OPC_EnterProc (OPT_Object proc) +{ + OPT_Object var = NIL, scope = NIL; + OPT_Struct typ = NIL; + INTEGER dim; + if (proc->vis != 1) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } + OPC_ProcHeader(proc, 1); + OPC_BegBlk(); + if (proc->typ != OPT_notyp) { + OPC_BegStat(); + OPC_Ident(proc->typ->strobj); + OPM_WriteString((CHAR*)" _o_result;", (LONGINT)12); + OPM_WriteLn(); + } + scope = proc->scope; + OPC_IdentList(scope->scope, 0); + if (!scope->leaf) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_Write(' '); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPC_EndStat(); + } + var = proc->link; + while (var != NIL) { + if ((var->typ->comp == 2 && var->mode == 1)) { + OPC_BegStat(); + if (var->typ->strobj == NIL) { + OPM_Mark(200, var->typ->txtpos); + } else { + OPC_Ident(var->typ->strobj); + } + OPM_Write(' '); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__copy", (LONGINT)7); + OPC_EndStat(); + } + var = var->link; + } + if (!OPC_ansi) { + var = proc->link; + while (var != NIL) { + if ((var->typ->form == 7 && var->mode == 1)) { + OPC_BegStat(); + OPC_Ident(var->typ->strobj); + OPM_Write(' '); + OPC_Ident(var); + OPM_WriteString((CHAR*)" = _", (LONGINT)5); + OPC_Ident(var); + OPC_EndStat(); + } + var = var->link; + } + } + var = proc->link; + while (var != NIL) { + if ((((__IN(var->typ->comp, 0x0c) && var->mode == 1)) && var->typ->sysflag == 0)) { + OPC_BegStat(); + if (var->typ->comp == 2) { + OPM_WriteString((CHAR*)"__DUPARR(", (LONGINT)10); + OPC_Ident(var); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (var->typ->strobj == NIL) { + OPM_Mark(200, var->typ->txtpos); + } else { + OPC_Ident(var->typ->strobj); + } + } else { + OPM_WriteString((CHAR*)"__DUP(", (LONGINT)7); + OPC_Ident(var); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + typ = var->typ->BaseTyp; + dim = 1; + while (typ->comp == 3) { + OPM_WriteString((CHAR*)" * ", (LONGINT)4); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + OPM_WriteInt(dim); + typ = typ->BaseTyp; + dim += 1; + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (typ->strobj == NIL) { + OPM_Mark(200, typ->txtpos); + } else { + OPC_Ident(typ->strobj); + } + } + OPM_Write(')'); + OPC_EndStat(); + } + var = var->link; + } + if (!scope->leaf) { + var = proc->link; + while (var != NIL) { + if (!var->leaf) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPC_Ident(var); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + if (__IN(var->typ->comp, 0x0c)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } else if (var->mode != 2) { + OPM_Write('&'); + } + OPC_Ident(var); + if (var->typ->comp == 3) { + typ = var->typ; + dim = 0; + do { + OPM_WriteString((CHAR*)"; ", (LONGINT)3); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + if (dim != 0) { + OPM_WriteInt(dim); + } + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + if (dim != 0) { + OPM_WriteInt(dim); + } + typ = typ->BaseTyp; + } while (!(typ->comp != 3)); + } else if ((var->mode == 2 && var->typ->comp == 4)) { + OPM_WriteString((CHAR*)"; ", (LONGINT)3); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } + OPC_EndStat(); + } + var = var->link; + } + var = scope->scope; + while (var != NIL) { + if (!var->leaf) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPC_Ident(var); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + if (var->typ->comp != 2) { + OPM_Write('&'); + } else { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } + OPC_Ident(var); + OPC_EndStat(); + } + var = var->link; + } + OPC_BegStat(); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPM_WriteString((CHAR*)"lnk", (LONGINT)4); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPC_EndStat(); + OPC_BegStat(); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPM_Write('&'); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPC_EndStat(); + } +} + +void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet) +{ + OPT_Object var = NIL; + BOOLEAN indent; + indent = eoBlock; + if ((implicitRet && proc->typ != OPT_notyp)) { + OPM_Write(0x09); + OPM_WriteString((CHAR*)"__RETCHK;", (LONGINT)10); + OPM_WriteLn(); + } else if (!eoBlock || implicitRet) { + if (!proc->scope->leaf) { + if (indent) { + OPC_BegStat(); + } else { + indent = 1; + } + OPM_WriteStringVar((void*)proc->scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPM_WriteString((CHAR*)"lnk", (LONGINT)4); + OPC_EndStat(); + } + var = proc->link; + while (var != NIL) { + if ((((var->typ->comp == 3 && var->mode == 1)) && var->typ->sysflag == 0)) { + if (indent) { + OPC_BegStat(); + } else { + indent = 1; + } + OPM_WriteString((CHAR*)"__DEL(", (LONGINT)7); + OPC_Ident(var); + OPM_Write(')'); + OPC_EndStat(); + } + var = var->link; + } + } + if (eoBlock) { + OPC_EndBlk(); + OPM_WriteLn(); + } else if (indent) { + OPC_BegStat(); + } +} + +void OPC_CompleteIdent (OPT_Object obj) +{ + INTEGER comp, level; + level = obj->mnolev; + if (obj->adr == 1) { + if (obj->typ->comp == 4) { + OPC_Ident(obj); + OPM_WriteString((CHAR*)"__", (LONGINT)3); + } else { + OPM_WriteString((CHAR*)"((", (LONGINT)3); + OPC_Ident(obj->typ->strobj); + OPM_Write(')'); + OPC_Ident(obj); + OPM_Write(')'); + } + } else if ((level != OPM_level && level > 0)) { + comp = obj->typ->comp; + if ((obj->mode != 2 && comp != 3)) { + OPM_Write('*'); + } + OPM_WriteStringVar((void*)obj->scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_WriteString((CHAR*)"->", (LONGINT)3); + OPC_Ident(obj); + } else { + OPC_Ident(obj); + } +} + +void OPC_TypeOf (OPT_Object ap) +{ + INTEGER i; + __ASSERT(ap->typ->comp == 4, 0); + if (ap->mode == 2) { + if ((int)ap->mnolev != OPM_level) { + OPM_WriteStringVar((void*)ap->scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s->", (LONGINT)5); + OPC_Ident(ap); + } else { + OPC_Ident(ap); + } + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } else if (ap->typ->strobj != NIL) { + OPC_Ident(ap->typ->strobj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } else { + OPC_Andent(ap->typ); + } +} + +void OPC_Cmp (INTEGER rel) +{ + switch (rel) { + case 9: + OPM_WriteString((CHAR*)" == ", (LONGINT)5); + break; + case 10: + OPM_WriteString((CHAR*)" != ", (LONGINT)5); + break; + case 11: + OPM_WriteString((CHAR*)" < ", (LONGINT)4); + break; + case 12: + OPM_WriteString((CHAR*)" <= ", (LONGINT)5); + break; + case 13: + OPM_WriteString((CHAR*)" > ", (LONGINT)4); + break; + case 14: + OPM_WriteString((CHAR*)" >= ", (LONGINT)5); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPC.Cmp, rel = ", (LONGINT)34); + OPM_LogWNum(rel, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } +} + +void OPC_Case (LONGINT caseVal, INTEGER form) +{ + CHAR ch; + OPM_WriteString((CHAR*)"case ", (LONGINT)6); + switch (form) { + case 3: + ch = (CHAR)caseVal; + if ((ch >= ' ' && ch <= '~')) { + OPM_Write('\''); + if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') { + OPM_Write('\\'); + OPM_Write(ch); + } else { + OPM_Write(ch); + } + OPM_Write('\''); + } else { + OPM_WriteString((CHAR*)"0x", (LONGINT)3); + OPM_WriteHex(caseVal); + } + break; + case 4: case 5: case 6: + OPM_WriteInt(caseVal); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPC.Case, form = ", (LONGINT)36); + OPM_LogWNum(form, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + OPM_WriteString((CHAR*)": ", (LONGINT)3); +} + +void OPC_SetInclude (BOOLEAN exclude) +{ + if (exclude) { + OPM_WriteString((CHAR*)" &= ~", (LONGINT)6); + } else { + OPM_WriteString((CHAR*)" |= ", (LONGINT)5); + } +} + +void OPC_Increment (BOOLEAN decrement) +{ + if (decrement) { + OPM_WriteString((CHAR*)" -= ", (LONGINT)5); + } else { + OPM_WriteString((CHAR*)" += ", (LONGINT)5); + } +} + +void OPC_Halt (LONGINT n) +{ + OPC_Str1((CHAR*)"__HALT(#)", (LONGINT)10, n); +} + +void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim) +{ + if (array->comp == 3) { + OPC_CompleteIdent(obj); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + if (dim != 0) { + OPM_WriteInt(dim); + } + } else { + while (dim > 0) { + array = array->BaseTyp; + dim -= 1; + } + OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12); + OPM_WriteInt(array->n); + OPM_WriteString((CHAR*)"))", (LONGINT)3); + } +} + +void OPC_Constant (OPT_Const con, INTEGER form) +{ + INTEGER i, len; + CHAR ch; + SET s; + LONGINT hex; + BOOLEAN skipLeading; + switch (form) { + case 1: + OPM_WriteInt(con->intval); + break; + case 2: + OPM_WriteInt(con->intval); + break; + case 3: + ch = (CHAR)con->intval; + if ((ch >= ' ' && ch <= '~')) { + OPM_Write('\''); + if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') { + OPM_Write('\\'); + } + OPM_Write(ch); + OPM_Write('\''); + } else { + OPM_WriteString((CHAR*)"0x", (LONGINT)3); + OPM_WriteHex(con->intval); + } + break; + case 4: case 5: case 6: + OPM_WriteInt(con->intval); + break; + case 7: + OPM_WriteReal(con->realval, 'f'); + break; + case 8: + OPM_WriteReal(con->realval, 0x00); + break; + case 9: + OPM_WriteString((CHAR*)"0x", (LONGINT)3); + skipLeading = 1; + s = con->setval; + i = 32; + do { + hex = 0; + do { + i -= 1; + hex = __ASHL(hex, 1); + if (__IN(i, s)) { + hex += 1; + } + } while (!(__MASK(i, -8) == 0)); + if (hex != 0 || !skipLeading) { + OPM_WriteHex(hex); + skipLeading = 0; + } + } while (!(i == 0)); + if (skipLeading) { + OPM_Write('0'); + } + break; + case 10: + OPM_Write('\"'); + len = (int)con->intval2 - 1; + i = 0; + while (i < len) { + ch = (*con->ext)[__X(i, ((LONGINT)(256)))]; + if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') { + OPM_Write('\\'); + } + OPM_Write(ch); + i += 1; + } + OPM_Write('\"'); + break; + case 11: + OPM_WriteString((CHAR*)"NIL", (LONGINT)4); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPC.Constant, form = ", (LONGINT)40); + OPM_LogWNum(form, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } +} + +static struct InitKeywords__47 { + SHORTINT *n; + struct InitKeywords__47 *lnk; +} *InitKeywords__47_s; + +static void Enter__48 (CHAR *s, LONGINT s__len); + +static void Enter__48 (CHAR *s, LONGINT s__len) +{ + INTEGER h; + __DUP(s, s__len, CHAR); + h = OPC_PerfectHash((void*)s, s__len); + OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__47_s->n; + __COPY(s, OPC_keytab[__X(*InitKeywords__47_s->n, ((LONGINT)(36)))], ((LONGINT)(9))); + *InitKeywords__47_s->n += 1; + __DEL(s); +} + +static void OPC_InitKeywords (void) +{ + SHORTINT n, i; + struct InitKeywords__47 _s; + _s.n = &n; + _s.lnk = InitKeywords__47_s; + InitKeywords__47_s = &_s; + n = 0; + i = 0; + while (i <= 104) { + OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1; + i += 1; + } + Enter__48((CHAR*)"asm", (LONGINT)4); + Enter__48((CHAR*)"auto", (LONGINT)5); + Enter__48((CHAR*)"break", (LONGINT)6); + Enter__48((CHAR*)"case", (LONGINT)5); + Enter__48((CHAR*)"char", (LONGINT)5); + Enter__48((CHAR*)"const", (LONGINT)6); + Enter__48((CHAR*)"continue", (LONGINT)9); + Enter__48((CHAR*)"default", (LONGINT)8); + Enter__48((CHAR*)"do", (LONGINT)3); + Enter__48((CHAR*)"double", (LONGINT)7); + Enter__48((CHAR*)"else", (LONGINT)5); + Enter__48((CHAR*)"enum", (LONGINT)5); + Enter__48((CHAR*)"extern", (LONGINT)7); + Enter__48((CHAR*)"export", (LONGINT)7); + Enter__48((CHAR*)"float", (LONGINT)6); + Enter__48((CHAR*)"for", (LONGINT)4); + Enter__48((CHAR*)"fortran", (LONGINT)8); + Enter__48((CHAR*)"goto", (LONGINT)5); + Enter__48((CHAR*)"if", (LONGINT)3); + Enter__48((CHAR*)"import", (LONGINT)7); + Enter__48((CHAR*)"int", (LONGINT)4); + Enter__48((CHAR*)"long", (LONGINT)5); + Enter__48((CHAR*)"register", (LONGINT)9); + Enter__48((CHAR*)"return", (LONGINT)7); + Enter__48((CHAR*)"short", (LONGINT)6); + Enter__48((CHAR*)"signed", (LONGINT)7); + Enter__48((CHAR*)"sizeof", (LONGINT)7); + Enter__48((CHAR*)"static", (LONGINT)7); + Enter__48((CHAR*)"struct", (LONGINT)7); + Enter__48((CHAR*)"switch", (LONGINT)7); + Enter__48((CHAR*)"typedef", (LONGINT)8); + Enter__48((CHAR*)"union", (LONGINT)6); + Enter__48((CHAR*)"unsigned", (LONGINT)9); + Enter__48((CHAR*)"void", (LONGINT)5); + Enter__48((CHAR*)"volatile", (LONGINT)9); + Enter__48((CHAR*)"while", (LONGINT)6); + InitKeywords__47_s = _s.lnk; +} + + +export void *OPC__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPT); + __REGMOD("OPC", 0); + __REGCMD("BegBlk", OPC_BegBlk); + __REGCMD("BegStat", OPC_BegStat); + __REGCMD("EndBlk", OPC_EndBlk); + __REGCMD("EndBlk0", OPC_EndBlk0); + __REGCMD("EndStat", OPC_EndStat); + __REGCMD("EnterBody", OPC_EnterBody); + __REGCMD("ExitBody", OPC_ExitBody); + __REGCMD("GenHdrIncludes", OPC_GenHdrIncludes); + __REGCMD("Init", OPC_Init); +/* BEGIN */ + OPC_InitKeywords(); + __ENDMOD; +} diff --git a/bootstrap/windows-48/OPC.h b/bootstrap/windows-48/OPC.h new file mode 100644 index 00000000..713ea3b2 --- /dev/null +++ b/bootstrap/windows-48/OPC.h @@ -0,0 +1,49 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPC__h +#define OPC__h + +#include "SYSTEM.h" +#include "OPT.h" + + + + +import void OPC_Align (LONGINT *adr, LONGINT base); +import void OPC_Andent (OPT_Struct typ); +import LONGINT OPC_Base (OPT_Struct typ); +import OPT_Object OPC_BaseTProc (OPT_Object obj); +import void OPC_BegBlk (void); +import void OPC_BegStat (void); +import void OPC_Case (LONGINT caseVal, INTEGER form); +import void OPC_Cmp (INTEGER rel); +import void OPC_CompleteIdent (OPT_Object obj); +import void OPC_Constant (OPT_Const con, INTEGER form); +import void OPC_DefineInter (OPT_Object proc); +import void OPC_EndBlk (void); +import void OPC_EndBlk0 (void); +import void OPC_EndStat (void); +import void OPC_EnterBody (void); +import void OPC_EnterProc (OPT_Object proc); +import void OPC_ExitBody (void); +import void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet); +import void OPC_GenBdy (OPT_Node n); +import void OPC_GenEnumPtrs (OPT_Object var); +import void OPC_GenHdr (OPT_Node n); +import void OPC_GenHdrIncludes (void); +import void OPC_Halt (LONGINT n); +import void OPC_Ident (OPT_Object obj); +import void OPC_Increment (BOOLEAN decrement); +import void OPC_Indent (INTEGER count); +import void OPC_Init (void); +import void OPC_InitTDesc (OPT_Struct typ); +import void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim); +import LONGINT OPC_NofPtrs (OPT_Struct typ); +import void OPC_SetInclude (BOOLEAN exclude); +import void OPC_TDescDecl (OPT_Struct typ); +import void OPC_TypeDefs (OPT_Object obj, INTEGER vis); +import void OPC_TypeOf (OPT_Object ap); +import void *OPC__init(void); + + +#endif diff --git a/bootstrap/windows-48/OPM.c b/bootstrap/windows-48/OPM.c new file mode 100644 index 00000000..3d68d2be --- /dev/null +++ b/bootstrap/windows-48/OPM.c @@ -0,0 +1,1091 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "Configuration.h" +#include "Console.h" +#include "Files.h" +#include "Platform.h" +#include "Strings.h" +#include "Texts.h" +#include "errors.h" +#include "vt100.h" + +typedef + CHAR OPM_FileName[32]; + + +static CHAR OPM_SourceFileName[256]; +export INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_CharAlign, OPM_BoolAlign, OPM_SIntAlign, OPM_IntAlign, OPM_LIntAlign, OPM_SetAlign, OPM_RealAlign, OPM_LRealAlign, OPM_PointerAlign, OPM_ProcAlign, OPM_RecAlign, OPM_MaxSet; +export LONGINT OPM_MinSInt, OPM_MinInt, OPM_MinLInt, OPM_MaxSInt, OPM_MaxInt, OPM_MaxLInt, OPM_MaxIndex; +export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; +export BOOLEAN OPM_noerr; +export LONGINT OPM_curpos, OPM_errpos, OPM_breakpc; +export INTEGER OPM_currFile, OPM_level, OPM_pc, OPM_entno; +export CHAR OPM_modName[32]; +export CHAR OPM_objname[64]; +export SET OPM_opt, OPM_glbopt; +static LONGINT OPM_ErrorLineStartPos, OPM_ErrorLineLimitPos, OPM_ErrorLineNumber, OPM_lasterrpos; +static Texts_Reader OPM_inR; +static Texts_Text OPM_Log; +static Texts_Writer OPM_W; +static Files_Rider OPM_oldSF, OPM_newSF; +static Files_Rider OPM_R[3]; +static Files_File OPM_oldSFile, OPM_newSFile, OPM_HFile, OPM_BFile, OPM_HIFile; +static INTEGER OPM_S; +export BOOLEAN OPM_dontAsm, OPM_dontLink, OPM_mainProg, OPM_mainLinkStat, OPM_notColorOutput, OPM_forceNewSym, OPM_Verbose; +static CHAR OPM_OBERON[1024]; +static CHAR OPM_MODULES[1024]; + + +static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F); +export void OPM_CloseFiles (void); +export void OPM_CloseOldSym (void); +export void OPM_DeleteNewSym (void); +export void OPM_FPrint (LONGINT *fp, LONGINT val); +export void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr); +export void OPM_FPrintReal (LONGINT *fp, REAL real); +export void OPM_FPrintSet (LONGINT *fp, SET set); +static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT pos); +export void OPM_Get (CHAR *ch); +static void OPM_GetProperties (void); +static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align); +export void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len); +export void OPM_InitOptions (void); +static void OPM_LogErrMsg (INTEGER n); +export void OPM_LogW (CHAR ch); +export void OPM_LogWLn (void); +export void OPM_LogWNum (LONGINT i, LONGINT len); +export void OPM_LogWStr (CHAR *s, LONGINT s__len); +static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len); +export void OPM_Mark (INTEGER n, LONGINT pos); +static INTEGER OPM_Min (INTEGER a, INTEGER b); +export void OPM_NewSym (CHAR *modName, LONGINT modName__len); +export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done); +export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len); +export BOOLEAN OPM_OpenPar (void); +export void OPM_RegisterNewSym (void); +static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt); +static void OPM_ShowLine (LONGINT pos); +export void OPM_SymRCh (CHAR *ch); +export LONGINT OPM_SymRInt (void); +export void OPM_SymRLReal (LONGREAL *lr); +export void OPM_SymRReal (REAL *r); +export void OPM_SymRSet (SET *s); +export void OPM_SymWCh (CHAR ch); +export void OPM_SymWInt (LONGINT i); +export void OPM_SymWLReal (LONGREAL lr); +export void OPM_SymWReal (REAL r); +export void OPM_SymWSet (SET s); +static void OPM_VerboseListSizes (void); +export void OPM_Write (CHAR ch); +export void OPM_WriteHex (LONGINT i); +export void OPM_WriteInt (LONGINT i); +export void OPM_WriteLn (void); +export void OPM_WriteReal (LONGREAL r, CHAR suffx); +export void OPM_WriteString (CHAR *s, LONGINT s__len); +export void OPM_WriteStringVar (CHAR *s, LONGINT s__len); +export BOOLEAN OPM_eofSF (void); +export void OPM_err (INTEGER n); +static LONGINT OPM_minus (LONGINT i); +static LONGINT OPM_power0 (LONGINT i, LONGINT j); + + +void OPM_LogW (CHAR ch) +{ + Console_Char(ch); +} + +void OPM_LogWStr (CHAR *s, LONGINT s__len) +{ + __DUP(s, s__len, CHAR); + Console_String(s, s__len); + __DEL(s); +} + +void OPM_LogWNum (LONGINT i, LONGINT len) +{ + Console_Int(i, len); +} + +void OPM_LogWLn (void) +{ + Console_Ln(); +} + +static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt) +{ + INTEGER i; + i = 1; + while (s[__X(i, s__len)] != 0x00) { + switch (s[__X(i, s__len)]) { + case 'e': + *opt = *opt ^ 0x0200; + break; + case 's': + *opt = *opt ^ 0x10; + break; + case 'm': + *opt = *opt ^ 0x0400; + break; + case 'x': + *opt = *opt ^ 0x01; + break; + case 'r': + *opt = *opt ^ 0x04; + break; + case 't': + *opt = *opt ^ 0x08; + break; + case 'a': + *opt = *opt ^ 0x80; + break; + case 'k': + *opt = *opt ^ 0x40; + break; + case 'p': + *opt = *opt ^ 0x20; + break; + case 'S': + *opt = *opt ^ 0x2000; + break; + case 'c': + *opt = *opt ^ 0x4000; + break; + case 'M': + *opt = *opt ^ 0x8000; + break; + case 'f': + *opt = *opt ^ 0x010000; + break; + case 'F': + *opt = *opt ^ 0x020000; + break; + case 'V': + *opt = *opt ^ 0x040000; + break; + case 'B': + if (s[__X(i + 1, s__len)] != 0x00) { + i += 1; + OPM_IntSize = (int)s[__X(i, s__len)] - 48; + } + if (s[__X(i + 1, s__len)] != 0x00) { + i += 1; + OPM_PointerSize = (int)s[__X(i, s__len)] - 48; + } + if (s[__X(i + 1, s__len)] != 0x00) { + i += 1; + OPM_Alignment = (int)s[__X(i, s__len)] - 48; + } + __ASSERT(OPM_IntSize == 2 || OPM_IntSize == 4, 0); + __ASSERT(OPM_PointerSize == 4 || OPM_PointerSize == 8, 0); + __ASSERT(OPM_Alignment == 4 || OPM_Alignment == 8, 0); + break; + default: + OPM_LogWStr((CHAR*)" warning: option ", (LONGINT)19); + OPM_LogW('-'); + OPM_LogW(s[__X(i, s__len)]); + OPM_LogWStr((CHAR*)" ignored", (LONGINT)9); + OPM_LogWLn(); + break; + } + i += 1; + } +} + +BOOLEAN OPM_OpenPar (void) +{ + BOOLEAN _o_result; + CHAR s[256]; + if (Platform_ArgCount == 1) { + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Vishap Oberon-2 compiler v", (LONGINT)27); + OPM_LogWStr((CHAR*)"1.2 [2016/06/15] for gcc LP64 on cygwin", (LONGINT)40); + OPM_LogW('.'); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Based on Ofront by Software Templ OEG, continued by Norayr Chilingarian and others.", (LONGINT)84); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Usage:", (LONGINT)7); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + OPM_LogWStr((CHAR*)"voc", (LONGINT)4); + OPM_LogWStr((CHAR*)" options {files {options}}.", (LONGINT)28); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Where options = [\"-\" {option} ].", (LONGINT)33); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" m - generate code for main module", (LONGINT)36); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" M - generate code for main module and link object statically", (LONGINT)63); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" s - generate new symbol file", (LONGINT)31); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" e - allow extending the module interface", (LONGINT)43); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" r - check value ranges", (LONGINT)25); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" a - don\'t check ASSERTs at runtime, use this option in tested production code", (LONGINT)80); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" t - don\'t check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" S - don\'t call external assembler/compiler, only generate C code", (LONGINT)67); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" c - don\'t call linker", (LONGINT)24); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" f - don\'t use color output", (LONGINT)29); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" V - verbose output", (LONGINT)21); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Initial options specify defaults for all files.", (LONGINT)48); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Options following a filename are specific to that file.", (LONGINT)56); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Repeating an option toggles its value.", (LONGINT)39); + OPM_LogWLn(); + _o_result = 0; + return _o_result; + } else { + OPM_S = 1; + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + OPM_glbopt = 0xe9; + while (s[0] == '-') { + OPM_ScanOptions((void*)s, ((LONGINT)(256)), &OPM_glbopt); + OPM_S += 1; + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + } + _o_result = 1; + return _o_result; + } + __RETCHK; +} + +void OPM_InitOptions (void) +{ + CHAR s[256]; + OPM_opt = OPM_glbopt; + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + while (s[0] == '-') { + OPM_ScanOptions((void*)s, ((LONGINT)(256)), &OPM_opt); + OPM_S += 1; + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + } + OPM_dontAsm = __IN(13, OPM_opt); + OPM_dontLink = __IN(14, OPM_opt); + OPM_mainProg = __IN(10, OPM_opt); + OPM_mainLinkStat = __IN(15, OPM_opt); + OPM_notColorOutput = __IN(16, OPM_opt); + OPM_forceNewSym = __IN(17, OPM_opt); + OPM_Verbose = __IN(18, OPM_opt); + if (OPM_mainLinkStat) { + OPM_glbopt |= __SETOF(10); + } + OPM_GetProperties(); +} + +void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len) +{ + Texts_Text T = NIL; + LONGINT beg, end, time; + CHAR s[256]; + *done = 0; + OPM_curpos = 0; + if (OPM_S >= Platform_ArgCount) { + return; + } + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + __NEW(T, Texts_TextDesc); + Texts_Open(T, s, ((LONGINT)(256))); + OPM_LogWStr(s, ((LONGINT)(256))); + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + __COPY(s, mname, mname__len); + __COPY(s, OPM_SourceFileName, ((LONGINT)(256))); + if (T->len == 0) { + OPM_LogWStr(s, ((LONGINT)(256))); + OPM_LogWStr((CHAR*)" not found.", (LONGINT)12); + OPM_LogWLn(); + } else { + Texts_OpenReader(&OPM_inR, Texts_Reader__typ, T, ((LONGINT)(0))); + *done = 1; + } + OPM_S += 1; + OPM_level = 0; + OPM_noerr = 1; + OPM_errpos = OPM_curpos; + OPM_lasterrpos = OPM_curpos - 10; + OPM_ErrorLineStartPos = 0; + OPM_ErrorLineLimitPos = 0; + OPM_ErrorLineNumber = 0; +} + +void OPM_Get (CHAR *ch) +{ + Texts_Read(&OPM_inR, Texts_Reader__typ, &*ch); + if (*ch == 0x0d) { + OPM_curpos = Texts_Pos(&OPM_inR, Texts_Reader__typ); + } else { + OPM_curpos += 1; + } + if ((*ch < 0x09 && !OPM_inR.eot)) { + *ch = ' '; + } +} + +static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len) +{ + INTEGER i, j; + CHAR ch; + __DUP(ext, ext__len, CHAR); + i = 0; + for (;;) { + ch = name[__X(i, name__len)]; + if (ch == 0x00) { + break; + } + FName[__X(i, FName__len)] = ch; + i += 1; + } + j = 0; + do { + ch = ext[__X(j, ext__len)]; + FName[__X(i, FName__len)] = ch; + i += 1; + j += 1; + } while (!(ch == 0x00)); + __DEL(ext); +} + +static void OPM_LogErrMsg (INTEGER n) +{ + Texts_Scanner S; + Texts_Text T = NIL; + CHAR ch; + INTEGER i; + CHAR buf[1024]; + if (n >= 0) { + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"31m", (LONGINT)4); + } + OPM_LogWStr((CHAR*)" err ", (LONGINT)7); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + } else { + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"35m", (LONGINT)4); + } + OPM_LogWStr((CHAR*)" warning ", (LONGINT)11); + n = -n; + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + } + OPM_LogWNum(n, ((LONGINT)(1))); + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + OPM_LogWStr(errors_errors[__X(n, ((LONGINT)(350)))], ((LONGINT)(128))); +} + +static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT pos) +{ + CHAR ch, cheol; + if (pos < OPM_ErrorLineStartPos) { + OPM_ErrorLineStartPos = 0; + OPM_ErrorLineLimitPos = 0; + OPM_ErrorLineNumber = 0; + } + if (pos < OPM_ErrorLineLimitPos) { + Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos); + return; + } + Files_Set(&*r, r__typ, f, OPM_ErrorLineLimitPos); + Files_Read(&*r, r__typ, (void*)&ch); + while ((OPM_ErrorLineLimitPos < pos && !(*r).eof)) { + OPM_ErrorLineStartPos = OPM_ErrorLineLimitPos; + OPM_ErrorLineNumber += 1; + while ((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) { + Files_Read(&*r, r__typ, (void*)&ch); + OPM_ErrorLineLimitPos += 1; + } + cheol = ch; + Files_Read(&*r, r__typ, (void*)&ch); + OPM_ErrorLineLimitPos += 1; + if ((cheol == 0x0d && ch == 0x0a)) { + OPM_ErrorLineLimitPos += 1; + Files_Read(&*r, r__typ, (void*)&ch); + } + } + Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos); +} + +static void OPM_ShowLine (LONGINT pos) +{ + Files_File f = NIL; + Files_Rider r; + CHAR line[1023]; + INTEGER i; + CHAR ch; + f = Files_Old(OPM_SourceFileName, ((LONGINT)(256))); + OPM_FindLine(f, &r, Files_Rider__typ, pos); + i = 0; + Files_Read(&r, Files_Rider__typ, (void*)&ch); + while ((((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) && i < 1022)) { + line[__X(i, ((LONGINT)(1023)))] = ch; + i += 1; + Files_Read(&r, Files_Rider__typ, (void*)&ch); + } + line[__X(i, ((LONGINT)(1023)))] = 0x00; + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWNum(OPM_ErrorLineNumber, ((LONGINT)(4))); + OPM_LogWStr((CHAR*)": ", (LONGINT)3); + OPM_LogWStr(line, ((LONGINT)(1023))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" ", (LONGINT)7); + if (pos >= OPM_ErrorLineLimitPos) { + pos = OPM_ErrorLineLimitPos - 1; + } + i = (int)(pos - OPM_ErrorLineStartPos); + while (i > 0) { + OPM_LogW(' '); + i -= 1; + } + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"32m", (LONGINT)4); + } + OPM_LogW('^'); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + Files_Close(f); +} + +void OPM_Mark (INTEGER n, LONGINT pos) +{ + if (pos == -1) { + pos = 0; + } + if (n >= 0) { + OPM_noerr = 0; + if (pos < OPM_lasterrpos || OPM_lasterrpos + 9 < pos) { + OPM_lasterrpos = pos; + OPM_ShowLine(pos); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + if (n < 249) { + OPM_LogWStr((CHAR*)" pos", (LONGINT)6); + OPM_LogWNum(pos, ((LONGINT)(6))); + OPM_LogErrMsg(n); + } else if (n == 255) { + OPM_LogWStr((CHAR*)"pos", (LONGINT)4); + OPM_LogWNum(pos, ((LONGINT)(6))); + OPM_LogWStr((CHAR*)" pc ", (LONGINT)6); + OPM_LogWNum(OPM_breakpc, ((LONGINT)(1))); + } else if (n == 254) { + OPM_LogWStr((CHAR*)"pc not found", (LONGINT)13); + } else { + OPM_LogWStr(OPM_objname, ((LONGINT)(64))); + if (n == 253) { + OPM_LogWStr((CHAR*)" is new, compile with option e", (LONGINT)31); + } else if (n == 252) { + OPM_LogWStr((CHAR*)" is redefined, compile with option s", (LONGINT)37); + } else if (n == 251) { + OPM_LogWStr((CHAR*)" is redefined (private part only), compile with option s", (LONGINT)57); + } else if (n == 250) { + OPM_LogWStr((CHAR*)" is no longer visible, compile with option s", (LONGINT)45); + } else if (n == 249) { + OPM_LogWStr((CHAR*)" is not consistently imported, recompile imports", (LONGINT)49); + } + } + } + } else { + if (pos >= 0) { + OPM_ShowLine(pos); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" pos", (LONGINT)6); + OPM_LogWNum(pos, ((LONGINT)(6))); + } + OPM_LogErrMsg(n); + if (pos < 0) { + OPM_LogWLn(); + } + } +} + +void OPM_err (INTEGER n) +{ + OPM_Mark(n, OPM_errpos); +} + +void OPM_FPrint (LONGINT *fp, LONGINT val) +{ + *fp = __ROTL((LONGINT)((SET)*fp ^ (SET)val), 1, LONGINT); +} + +void OPM_FPrintSet (LONGINT *fp, SET set) +{ + OPM_FPrint(&*fp, (LONGINT)set); +} + +void OPM_FPrintReal (LONGINT *fp, REAL real) +{ + OPM_FPrint(&*fp, __VAL(LONGINT, real)); +} + +void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr) +{ + LONGINT l, h; + __GET((LONGINT)(uintptr_t)&lr, l, LONGINT); + __GET((LONGINT)(uintptr_t)&lr + 4, h, LONGINT); + OPM_FPrint(&*fp, l); + OPM_FPrint(&*fp, h); +} + +static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align) +{ + __DUP(name, name__len, CHAR); + if (((*S).class == 1 && __STRCMP((*S).s, name) == 0)) { + Texts_Scan(&*S, S__typ); + if ((*S).class == 3) { + *size = (int)(*S).i; + Texts_Scan(&*S, S__typ); + } else { + OPM_Mark(-157, ((LONGINT)(-1))); + } + if ((*S).class == 3) { + *align = (int)(*S).i; + Texts_Scan(&*S, S__typ); + } else { + OPM_Mark(-157, ((LONGINT)(-1))); + } + } else { + OPM_Mark(-157, ((LONGINT)(-1))); + } + __DEL(name); +} + +static LONGINT OPM_minus (LONGINT i) +{ + LONGINT _o_result; + _o_result = -i; + return _o_result; +} + +static LONGINT OPM_power0 (LONGINT i, LONGINT j) +{ + LONGINT _o_result; + LONGINT k, p; + k = 1; + p = i; + do { + p = p * i; + k += 1; + } while (!(k == j)); + _o_result = p; + return _o_result; +} + +static void OPM_VerboseListSizes (void) +{ + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Type Size Alignement", (LONGINT)29); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"CHAR ", (LONGINT)14); + OPM_LogWNum(OPM_CharSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_CharAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"BOOLEAN ", (LONGINT)14); + OPM_LogWNum(OPM_BoolSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_BoolAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"SHORTINT ", (LONGINT)14); + OPM_LogWNum(OPM_SIntSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_SIntAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"INTEGER ", (LONGINT)14); + OPM_LogWNum(OPM_IntSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_IntAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"LONGINT ", (LONGINT)14); + OPM_LogWNum(OPM_LIntSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_LIntAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"SET ", (LONGINT)14); + OPM_LogWNum(OPM_SetSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_SetAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"REAL ", (LONGINT)14); + OPM_LogWNum(OPM_RealSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_RealAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"LONGREAL ", (LONGINT)14); + OPM_LogWNum(OPM_LRealSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_LRealAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"PTR ", (LONGINT)14); + OPM_LogWNum(OPM_PointerSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_PointerAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"PROC ", (LONGINT)14); + OPM_LogWNum(OPM_ProcSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_ProcAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"RECORD ", (LONGINT)14); + OPM_LogWNum(OPM_RecSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_RecAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Min shortint ", (LONGINT)14); + OPM_LogWNum(OPM_MinSInt, ((LONGINT)(4))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Max shortint ", (LONGINT)14); + OPM_LogWNum(OPM_MaxSInt, ((LONGINT)(4))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Min integer ", (LONGINT)14); + OPM_LogWNum(OPM_MinInt, ((LONGINT)(4))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Max integer ", (LONGINT)14); + OPM_LogWNum(OPM_MaxInt, ((LONGINT)(4))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Min longint ", (LONGINT)14); + OPM_LogWNum(OPM_MinLInt, ((LONGINT)(4))); + OPM_LogWLn(); +} + +static INTEGER OPM_Min (INTEGER a, INTEGER b) +{ + INTEGER _o_result; + if (a < b) { + _o_result = a; + return _o_result; + } else { + _o_result = b; + return _o_result; + } + __RETCHK; +} + +static void OPM_GetProperties (void) +{ + LONGINT base; + OPM_ProcSize = OPM_PointerSize; + OPM_LIntSize = __ASHL(OPM_IntSize, 1); + OPM_SetSize = OPM_LIntSize; + OPM_CharAlign = OPM_Min(OPM_Alignment, OPM_CharSize); + OPM_BoolAlign = OPM_Min(OPM_Alignment, OPM_BoolSize); + OPM_SIntAlign = OPM_Min(OPM_Alignment, OPM_SIntSize); + OPM_RecAlign = OPM_Min(OPM_Alignment, OPM_RecSize); + OPM_RealAlign = OPM_Min(OPM_Alignment, OPM_RealSize); + OPM_LRealAlign = OPM_Min(OPM_Alignment, OPM_LRealSize); + OPM_PointerAlign = OPM_Min(OPM_Alignment, OPM_PointerSize); + OPM_ProcAlign = OPM_Min(OPM_Alignment, OPM_ProcSize); + OPM_IntAlign = OPM_Min(OPM_Alignment, OPM_IntSize); + OPM_LIntAlign = OPM_Min(OPM_Alignment, OPM_LIntSize); + OPM_SetAlign = OPM_Min(OPM_Alignment, OPM_SetSize); + base = -2; + OPM_MinSInt = __ASH(base, __ASHL(OPM_SIntSize, 3) - 2); + OPM_MaxSInt = OPM_minus(OPM_MinSInt + 1); + OPM_MinInt = __ASH(base, __ASHL(OPM_IntSize, 3) - 2); + OPM_MaxInt = OPM_minus(OPM_MinInt + 1); + OPM_MinLInt = __ASH(base, __ASHL(OPM_LIntSize, 3) - 2); + OPM_MaxLInt = OPM_minus(OPM_MinLInt + 1); + if (OPM_RealSize == 4) { + OPM_MaxReal = 3.40282346000000e+038; + } else if (OPM_RealSize == 8) { + OPM_MaxReal = 1.79769296342094e+308; + } + if (OPM_LRealSize == 4) { + OPM_MaxLReal = 3.40282346000000e+038; + } else if (OPM_LRealSize == 8) { + OPM_MaxLReal = 1.79769296342094e+308; + } + OPM_MinReal = -OPM_MaxReal; + OPM_MinLReal = -OPM_MaxLReal; + OPM_MaxSet = __ASHL(OPM_SetSize, 3) - 1; + OPM_MaxIndex = OPM_MaxLInt; + if (OPM_Verbose) { + OPM_VerboseListSizes(); + } +} + +void OPM_SymRCh (CHAR *ch) +{ + Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&*ch); +} + +LONGINT OPM_SymRInt (void) +{ + LONGINT _o_result; + LONGINT k; + Files_ReadNum(&OPM_oldSF, Files_Rider__typ, &k); + _o_result = k; + return _o_result; +} + +void OPM_SymRSet (SET *s) +{ + Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (LONGINT*)&*s); +} + +void OPM_SymRReal (REAL *r) +{ + Files_ReadReal(&OPM_oldSF, Files_Rider__typ, &*r); +} + +void OPM_SymRLReal (LONGREAL *lr) +{ + Files_ReadLReal(&OPM_oldSF, Files_Rider__typ, &*lr); +} + +void OPM_CloseOldSym (void) +{ +} + +void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done) +{ + CHAR ch; + OPM_FileName fileName; + OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5); + OPM_oldSFile = Files_Old(fileName, ((LONGINT)(32))); + *done = OPM_oldSFile != NIL; + if (*done) { + Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, ((LONGINT)(0))); + Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ch); + if (ch != 0xf7) { + OPM_err(-306); + OPM_CloseOldSym(); + *done = 0; + } + } +} + +BOOLEAN OPM_eofSF (void) +{ + BOOLEAN _o_result; + _o_result = OPM_oldSF.eof; + return _o_result; +} + +void OPM_SymWCh (CHAR ch) +{ + Files_Write(&OPM_newSF, Files_Rider__typ, ch); +} + +void OPM_SymWInt (LONGINT i) +{ + Files_WriteNum(&OPM_newSF, Files_Rider__typ, i); +} + +void OPM_SymWSet (SET s) +{ + Files_WriteNum(&OPM_newSF, Files_Rider__typ, (LONGINT)s); +} + +void OPM_SymWReal (REAL r) +{ + Files_WriteReal(&OPM_newSF, Files_Rider__typ, r); +} + +void OPM_SymWLReal (LONGREAL lr) +{ + Files_WriteLReal(&OPM_newSF, Files_Rider__typ, lr); +} + +void OPM_RegisterNewSym (void) +{ + if (__STRCMP(OPM_modName, "SYSTEM") != 0 || __IN(10, OPM_opt)) { + Files_Register(OPM_newSFile); + } +} + +void OPM_DeleteNewSym (void) +{ +} + +void OPM_NewSym (CHAR *modName, LONGINT modName__len) +{ + OPM_FileName fileName; + OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5); + OPM_newSFile = Files_New(fileName, ((LONGINT)(32))); + if (OPM_newSFile != NIL) { + Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, ((LONGINT)(0))); + Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7); + } else { + OPM_err(153); + } +} + +void OPM_Write (CHAR ch) +{ + Files_Write(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, ch); +} + +void OPM_WriteString (CHAR *s, LONGINT s__len) +{ + INTEGER i; + i = 0; + while (s[__X(i, s__len)] != 0x00) { + i += 1; + } + Files_WriteBytes(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, (void*)s, s__len * ((LONGINT)(1)), i); +} + +void OPM_WriteStringVar (CHAR *s, LONGINT s__len) +{ + INTEGER i; + i = 0; + while (s[__X(i, s__len)] != 0x00) { + i += 1; + } + Files_WriteBytes(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, (void*)s, s__len * ((LONGINT)(1)), i); +} + +void OPM_WriteHex (LONGINT i) +{ + CHAR s[3]; + INTEGER digit; + digit = __ASHR((int)i, 4); + if (digit < 10) { + s[0] = (CHAR)(48 + digit); + } else { + s[0] = (CHAR)(87 + digit); + } + digit = __MASK((int)i, -16); + if (digit < 10) { + s[1] = (CHAR)(48 + digit); + } else { + s[1] = (CHAR)(87 + digit); + } + s[2] = 0x00; + OPM_WriteString(s, ((LONGINT)(3))); +} + +void OPM_WriteInt (LONGINT i) +{ + CHAR s[20]; + LONGINT i1, k; + if (i == OPM_MinInt || i == OPM_MinLInt) { + OPM_Write('('); + OPM_WriteInt(i + 1); + OPM_WriteString((CHAR*)"-1)", (LONGINT)4); + } else { + i1 = __ABS(i); + s[0] = (CHAR)(__MOD(i1, 10) + 48); + i1 = __DIV(i1, 10); + k = 1; + while (i1 > 0) { + s[__X(k, ((LONGINT)(20)))] = (CHAR)(__MOD(i1, 10) + 48); + i1 = __DIV(i1, 10); + k += 1; + } + if (i < 0) { + s[__X(k, ((LONGINT)(20)))] = '-'; + k += 1; + } + while (k > 0) { + k -= 1; + OPM_Write(s[__X(k, ((LONGINT)(20)))]); + } + } +} + +void OPM_WriteReal (LONGREAL r, CHAR suffx) +{ + Texts_Writer W; + Texts_Text T = NIL; + Texts_Reader R; + CHAR s[32]; + CHAR ch; + INTEGER i; + if ((((r < OPM_MaxLInt && r > OPM_MinLInt)) && r == (__ENTIER(r)))) { + if (suffx == 'f') { + OPM_WriteString((CHAR*)"(REAL)", (LONGINT)7); + } else { + OPM_WriteString((CHAR*)"(LONGREAL)", (LONGINT)11); + } + OPM_WriteInt(__ENTIER(r)); + } else { + Texts_OpenWriter(&W, Texts_Writer__typ); + if (suffx == 'f') { + Texts_WriteLongReal(&W, Texts_Writer__typ, r, 16); + } else { + Texts_WriteLongReal(&W, Texts_Writer__typ, r, 23); + } + __NEW(T, Texts_TextDesc); + Texts_Open(T, (CHAR*)"", (LONGINT)1); + Texts_Append(T, W.buf); + Texts_OpenReader(&R, Texts_Reader__typ, T, ((LONGINT)(0))); + i = 0; + Texts_Read(&R, Texts_Reader__typ, &ch); + while (ch != 0x00) { + s[__X(i, ((LONGINT)(32)))] = ch; + i += 1; + Texts_Read(&R, Texts_Reader__typ, &ch); + } + s[__X(i, ((LONGINT)(32)))] = 0x00; + i = 0; + ch = s[0]; + while ((ch != 'D' && ch != 0x00)) { + i += 1; + ch = s[__X(i, ((LONGINT)(32)))]; + } + if (ch == 'D') { + s[__X(i, ((LONGINT)(32)))] = 'e'; + } + OPM_WriteString(s, ((LONGINT)(32))); + } +} + +void OPM_WriteLn (void) +{ + Files_Write(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, 0x0a); +} + +static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F) +{ + Files_Rider R1; + CHAR buffer[4096]; + if (F != NIL) { + Files_Set(&R1, Files_Rider__typ, F, ((LONGINT)(0))); + Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, ((LONGINT)(4096)), ((LONGINT)(4096))); + while (4096 - R1.res > 0) { + Files_WriteBytes(&*R, R__typ, (void*)buffer, ((LONGINT)(4096)), 4096 - R1.res); + Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, ((LONGINT)(4096)), ((LONGINT)(4096))); + } + } +} + +void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len) +{ + CHAR FName[32]; + __COPY(moduleName, OPM_modName, ((LONGINT)(32))); + OPM_HFile = Files_New((CHAR*)"", (LONGINT)1); + if (OPM_HFile != NIL) { + Files_Set(&OPM_R[0], Files_Rider__typ, OPM_HFile, ((LONGINT)(0))); + } else { + OPM_err(153); + } + OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, ((LONGINT)(32)), (CHAR*)".c", (LONGINT)3); + OPM_BFile = Files_New(FName, ((LONGINT)(32))); + if (OPM_BFile != NIL) { + Files_Set(&OPM_R[1], Files_Rider__typ, OPM_BFile, ((LONGINT)(0))); + } else { + OPM_err(153); + } + OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, ((LONGINT)(32)), (CHAR*)".h", (LONGINT)3); + OPM_HIFile = Files_New(FName, ((LONGINT)(32))); + if (OPM_HIFile != NIL) { + Files_Set(&OPM_R[2], Files_Rider__typ, OPM_HIFile, ((LONGINT)(0))); + } else { + OPM_err(153); + } +} + +void OPM_CloseFiles (void) +{ + CHAR FName[32]; + INTEGER res; + if (OPM_noerr) { + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + OPM_LogWNum(Files_Pos(&OPM_R[1], Files_Rider__typ), ((LONGINT)(0))); + OPM_LogWStr((CHAR*)" chars.", (LONGINT)8); + } + if (OPM_noerr) { + if (__STRCMP(OPM_modName, "SYSTEM") == 0) { + if (!__IN(10, OPM_opt)) { + Files_Register(OPM_BFile); + } + } else if (!__IN(10, OPM_opt)) { + OPM_Append(&OPM_R[2], Files_Rider__typ, OPM_HFile); + Files_Register(OPM_HIFile); + Files_Register(OPM_BFile); + } else { + OPM_MakeFileName((void*)OPM_modName, ((LONGINT)(32)), (void*)FName, ((LONGINT)(32)), (CHAR*)".h", (LONGINT)3); + Files_Delete(FName, ((LONGINT)(32)), &res); + OPM_MakeFileName((void*)OPM_modName, ((LONGINT)(32)), (void*)FName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5); + Files_Delete(FName, ((LONGINT)(32)), &res); + Files_Register(OPM_BFile); + } + } + OPM_HFile = NIL; + OPM_BFile = NIL; + OPM_HIFile = NIL; + OPM_newSFile = NIL; + OPM_oldSFile = NIL; + Files_Set(&OPM_R[0], Files_Rider__typ, NIL, ((LONGINT)(0))); + Files_Set(&OPM_R[1], Files_Rider__typ, NIL, ((LONGINT)(0))); + Files_Set(&OPM_R[2], Files_Rider__typ, NIL, ((LONGINT)(0))); + Files_Set(&OPM_newSF, Files_Rider__typ, NIL, ((LONGINT)(0))); + Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, ((LONGINT)(0))); +} + +static void EnumPtrs(void (*P)(void*)) +{ + __ENUMR(&OPM_inR, Texts_Reader__typ, 48, 1, P); + P(OPM_Log); + __ENUMR(&OPM_W, Texts_Writer__typ, 36, 1, P); + __ENUMR(&OPM_oldSF, Files_Rider__typ, 20, 1, P); + __ENUMR(&OPM_newSF, Files_Rider__typ, 20, 1, P); + __ENUMR(OPM_R, Files_Rider__typ, 20, 3, P); + P(OPM_oldSFile); + P(OPM_newSFile); + P(OPM_HFile); + P(OPM_BFile); + P(OPM_HIFile); +} + + +export void *OPM__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Console); + __MODULE_IMPORT(Files); + __MODULE_IMPORT(Platform); + __MODULE_IMPORT(Strings); + __MODULE_IMPORT(Texts); + __MODULE_IMPORT(errors); + __MODULE_IMPORT(vt100); + __REGMOD("OPM", EnumPtrs); + __REGCMD("CloseFiles", OPM_CloseFiles); + __REGCMD("CloseOldSym", OPM_CloseOldSym); + __REGCMD("DeleteNewSym", OPM_DeleteNewSym); + __REGCMD("InitOptions", OPM_InitOptions); + __REGCMD("LogWLn", OPM_LogWLn); + __REGCMD("RegisterNewSym", OPM_RegisterNewSym); + __REGCMD("WriteLn", OPM_WriteLn); +/* BEGIN */ + Texts_OpenWriter(&OPM_W, Texts_Writer__typ); + OPM_MODULES[0] = 0x00; + Platform_GetEnv((CHAR*)"MODULES", (LONGINT)8, (void*)OPM_MODULES, ((LONGINT)(1024))); + __MOVE(".", OPM_OBERON, 2); + Platform_GetEnv((CHAR*)"OBERON", (LONGINT)7, (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append((CHAR*)";.;", (LONGINT)4, (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append(OPM_MODULES, ((LONGINT)(1024)), (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append((CHAR*)";", (LONGINT)2, (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append((CHAR*)"/sym;", (LONGINT)6, (void*)OPM_OBERON, ((LONGINT)(1024))); + Files_SetSearchPath(OPM_OBERON, ((LONGINT)(1024))); + OPM_CharSize = 1; + OPM_BoolSize = 1; + OPM_SIntSize = 1; + OPM_RecSize = 1; + OPM_ByteSize = 1; + OPM_RealSize = 4; + OPM_LRealSize = 8; + OPM_PointerSize = 8; + OPM_Alignment = 8; + OPM_IntSize = 4; + __ENDMOD; +} diff --git a/bootstrap/windows-48/OPM.h b/bootstrap/windows-48/OPM.h new file mode 100644 index 00000000..68bf3af0 --- /dev/null +++ b/bootstrap/windows-48/OPM.h @@ -0,0 +1,63 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPM__h +#define OPM__h + +#include "SYSTEM.h" + + +import INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_CharAlign, OPM_BoolAlign, OPM_SIntAlign, OPM_IntAlign, OPM_LIntAlign, OPM_SetAlign, OPM_RealAlign, OPM_LRealAlign, OPM_PointerAlign, OPM_ProcAlign, OPM_RecAlign, OPM_MaxSet; +import LONGINT OPM_MinSInt, OPM_MinInt, OPM_MinLInt, OPM_MaxSInt, OPM_MaxInt, OPM_MaxLInt, OPM_MaxIndex; +import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; +import BOOLEAN OPM_noerr; +import LONGINT OPM_curpos, OPM_errpos, OPM_breakpc; +import INTEGER OPM_currFile, OPM_level, OPM_pc, OPM_entno; +import CHAR OPM_modName[32]; +import CHAR OPM_objname[64]; +import SET OPM_opt, OPM_glbopt; +import BOOLEAN OPM_dontAsm, OPM_dontLink, OPM_mainProg, OPM_mainLinkStat, OPM_notColorOutput, OPM_forceNewSym, OPM_Verbose; + + +import void OPM_CloseFiles (void); +import void OPM_CloseOldSym (void); +import void OPM_DeleteNewSym (void); +import void OPM_FPrint (LONGINT *fp, LONGINT val); +import void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr); +import void OPM_FPrintReal (LONGINT *fp, REAL real); +import void OPM_FPrintSet (LONGINT *fp, SET set); +import void OPM_Get (CHAR *ch); +import void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len); +import void OPM_InitOptions (void); +import void OPM_LogW (CHAR ch); +import void OPM_LogWLn (void); +import void OPM_LogWNum (LONGINT i, LONGINT len); +import void OPM_LogWStr (CHAR *s, LONGINT s__len); +import void OPM_Mark (INTEGER n, LONGINT pos); +import void OPM_NewSym (CHAR *modName, LONGINT modName__len); +import void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done); +import void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len); +import BOOLEAN OPM_OpenPar (void); +import void OPM_RegisterNewSym (void); +import void OPM_SymRCh (CHAR *ch); +import LONGINT OPM_SymRInt (void); +import void OPM_SymRLReal (LONGREAL *lr); +import void OPM_SymRReal (REAL *r); +import void OPM_SymRSet (SET *s); +import void OPM_SymWCh (CHAR ch); +import void OPM_SymWInt (LONGINT i); +import void OPM_SymWLReal (LONGREAL lr); +import void OPM_SymWReal (REAL r); +import void OPM_SymWSet (SET s); +import void OPM_Write (CHAR ch); +import void OPM_WriteHex (LONGINT i); +import void OPM_WriteInt (LONGINT i); +import void OPM_WriteLn (void); +import void OPM_WriteReal (LONGREAL r, CHAR suffx); +import void OPM_WriteString (CHAR *s, LONGINT s__len); +import void OPM_WriteStringVar (CHAR *s, LONGINT s__len); +import BOOLEAN OPM_eofSF (void); +import void OPM_err (INTEGER n); +import void *OPM__init(void); + + +#endif diff --git a/bootstrap/windows-48/OPP.c b/bootstrap/windows-48/OPP.c new file mode 100644 index 00000000..f0530bb4 --- /dev/null +++ b/bootstrap/windows-48/OPP.c @@ -0,0 +1,1873 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "OPB.h" +#include "OPM.h" +#include "OPS.h" +#include "OPT.h" + +struct OPP__1 { + LONGINT low, high; +}; + +typedef + struct OPP__1 OPP_CaseTable[128]; + + +static SHORTINT OPP_sym, OPP_level; +static INTEGER OPP_LoopLevel; +static OPT_Node OPP_TDinit, OPP_lastTDinit; +static INTEGER OPP_nofFwdPtr; +static OPT_Struct OPP_FwdPtr[64]; + +export LONGINT *OPP__1__typ; + +static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar); +static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned); +static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq); +static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab); +static void OPP_CheckMark (SHORTINT *vis); +static void OPP_CheckSym (INTEGER s); +static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_); +static void OPP_ConstExpression (OPT_Node *x); +static void OPP_Element (OPT_Node *x); +static void OPP_Expression (OPT_Node *x); +static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b); +static void OPP_Factor (OPT_Node *x); +static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp); +export void OPP_Module (OPT_Node *prog, SET opt); +static void OPP_PointerType (OPT_Struct *typ); +static void OPP_ProcedureDeclaration (OPT_Node *x); +static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec); +static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned); +static void OPP_Sets (OPT_Node *x); +static void OPP_SimpleExpression (OPT_Node *x); +static void OPP_StandProcCall (OPT_Node *x); +static void OPP_StatSeq (OPT_Node *stat); +static void OPP_Term (OPT_Node *x); +static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned); +static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned); +static void OPP_err (INTEGER n); +static void OPP_qualident (OPT_Object *id); +static void OPP_selector (OPT_Node *x); + + +static void OPP_err (INTEGER n) +{ + OPM_err(n); +} + +static void OPP_CheckSym (INTEGER s) +{ + if ((int)OPP_sym == s) { + OPS_Get(&OPP_sym); + } else { + OPM_err(s); + } +} + +static void OPP_qualident (OPT_Object *id) +{ + OPT_Object obj = NIL; + SHORTINT lev; + OPT_Find(&obj); + OPS_Get(&OPP_sym); + if ((((OPP_sym == 18 && obj != NIL)) && obj->mode == 11)) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPT_FindImport(obj, &obj); + OPS_Get(&OPP_sym); + } else { + OPP_err(38); + obj = NIL; + } + } + if (obj == NIL) { + OPP_err(0); + obj = OPT_NewObj(); + obj->mode = 1; + obj->typ = OPT_undftyp; + obj->adr = 0; + } else { + lev = obj->mnolev; + if ((__IN(obj->mode, 0x06) && lev != OPP_level)) { + obj->leaf = 0; + if (lev > 0) { + OPB_StaticLink(OPP_level - lev); + } + } + } + *id = obj; +} + +static void OPP_ConstExpression (OPT_Node *x) +{ + OPP_Expression(&*x); + if ((*x)->class != 7) { + OPP_err(50); + *x = OPB_NewIntConst(((LONGINT)(1))); + } +} + +static void OPP_CheckMark (SHORTINT *vis) +{ + OPS_Get(&OPP_sym); + if (OPP_sym == 1 || OPP_sym == 7) { + if (OPP_level > 0) { + OPP_err(47); + } + if (OPP_sym == 1) { + *vis = 1; + } else { + *vis = 2; + } + OPS_Get(&OPP_sym); + } else { + *vis = 0; + } +} + +static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_) +{ + OPT_Node x = NIL; + LONGINT sf; + if (OPP_sym == 31) { + OPS_Get(&OPP_sym); + if (!OPT_SYSimported) { + OPP_err(135); + } + OPP_ConstExpression(&x); + if (__IN(x->typ->form, 0x70)) { + sf = x->conval->intval; + if (sf < 0 || sf > 1) { + OPP_err(220); + sf = 0; + } + } else { + OPP_err(51); + sf = 0; + } + *sysflag = (int)sf; + OPP_CheckSym(23); + } else { + *sysflag = default_; + } +} + +static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned) +{ + OPT_Object fld = NIL, first = NIL, last = NIL, base = NIL; + OPT_Struct ftyp = NIL; + INTEGER sysflag; + *typ = OPT_NewStr(15, 4); + (*typ)->BaseTyp = NIL; + OPP_CheckSysFlag(&sysflag, -1); + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPP_qualident(&base); + if ((base->mode == 5 && base->typ->comp == 4)) { + if (base->typ == *banned) { + OPP_err(58); + } else { + base->typ->pvused = 1; + (*typ)->BaseTyp = base->typ; + (*typ)->extlev = base->typ->extlev + 1; + (*typ)->sysflag = base->typ->sysflag; + } + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + OPP_CheckSym(22); + } + if (sysflag >= 0) { + (*typ)->sysflag = sysflag; + } + OPT_OpenScope(0, NIL); + first = NIL; + last = NIL; + for (;;) { + if (OPP_sym == 38) { + for (;;) { + if (OPP_sym == 38) { + if ((*typ)->BaseTyp != NIL) { + OPT_FindField(OPS_name, (*typ)->BaseTyp, &fld); + if (fld != NIL) { + OPP_err(1); + } + } + OPT_Insert(OPS_name, &fld); + OPP_CheckMark(&fld->vis); + fld->mode = 4; + fld->link = NIL; + fld->typ = OPT_undftyp; + if (first == NIL) { + first = fld; + } + if (last == NIL) { + (*typ)->link = fld; + } else { + last->link = fld; + } + last = fld; + } else { + OPP_err(38); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(19); + } else { + break; + } + } + OPP_CheckSym(20); + OPP_Type(&ftyp, &*banned); + ftyp->pvused = 1; + if (ftyp->comp == 3) { + ftyp = OPT_undftyp; + OPP_err(88); + } + while (first != NIL) { + first->typ = ftyp; + first = first->link; + } + } + if (OPP_sym == 39) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(39); + } else { + break; + } + } + OPT_CloseScope(); +} + +static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned) +{ + OPT_Node x = NIL; + LONGINT n; + INTEGER sysflag; + OPP_CheckSysFlag(&sysflag, 0); + if (OPP_sym == 25) { + *typ = OPT_NewStr(15, 3); + (*typ)->mno = 0; + (*typ)->sysflag = sysflag; + OPS_Get(&OPP_sym); + OPP_Type(&(*typ)->BaseTyp, &*banned); + (*typ)->BaseTyp->pvused = 1; + if ((*typ)->BaseTyp->comp == 3) { + (*typ)->n = (*typ)->BaseTyp->n + 1; + } else { + (*typ)->n = 0; + } + } else { + *typ = OPT_NewStr(15, 2); + (*typ)->sysflag = sysflag; + OPP_ConstExpression(&x); + if (__IN(x->typ->form, 0x70)) { + n = x->conval->intval; + if (n <= 0 || n > OPM_MaxIndex) { + OPP_err(63); + n = 1; + } + } else { + OPP_err(51); + n = 1; + } + (*typ)->n = n; + if (OPP_sym == 25) { + OPS_Get(&OPP_sym); + OPP_Type(&(*typ)->BaseTyp, &*banned); + (*typ)->BaseTyp->pvused = 1; + } else if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + if (OPP_sym != 25) { + OPP_ArrayType(&(*typ)->BaseTyp, &*banned); + } + } else { + OPP_err(35); + } + if ((*typ)->BaseTyp->comp == 3) { + (*typ)->BaseTyp = OPT_undftyp; + OPP_err(88); + } + } +} + +static void OPP_PointerType (OPT_Struct *typ) +{ + OPT_Object id = NIL; + *typ = OPT_NewStr(13, 1); + OPP_CheckSysFlag(&(*typ)->sysflag, 0); + OPP_CheckSym(28); + if (OPP_sym == 38) { + OPT_Find(&id); + if (id == NIL) { + if (OPP_nofFwdPtr < 64) { + OPP_FwdPtr[__X(OPP_nofFwdPtr, ((LONGINT)(64)))] = *typ; + OPP_nofFwdPtr += 1; + } else { + OPP_err(224); + } + (*typ)->link = OPT_NewObj(); + __COPY(OPS_name, (*typ)->link->name, ((LONGINT)(256))); + (*typ)->BaseTyp = OPT_undftyp; + OPS_Get(&OPP_sym); + } else { + OPP_qualident(&id); + if (id->mode == 5) { + if (__IN(id->typ->comp, 0x1c)) { + (*typ)->BaseTyp = id->typ; + } else { + (*typ)->BaseTyp = OPT_undftyp; + OPP_err(57); + } + } else { + (*typ)->BaseTyp = OPT_undftyp; + OPP_err(52); + } + } + } else { + OPP_Type(&(*typ)->BaseTyp, &OPT_notyp); + if (!__IN((*typ)->BaseTyp->comp, 0x1c)) { + (*typ)->BaseTyp = OPT_undftyp; + OPP_err(57); + } + } +} + +static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp) +{ + SHORTINT mode; + OPT_Object par = NIL, first = NIL, last = NIL, res = NIL; + OPT_Struct typ = NIL; + first = NIL; + last = *firstPar; + if (OPP_sym == 38 || OPP_sym == 60) { + for (;;) { + if (OPP_sym == 60) { + OPS_Get(&OPP_sym); + mode = 2; + } else { + mode = 1; + } + for (;;) { + if (OPP_sym == 38) { + OPT_Insert(OPS_name, &par); + OPS_Get(&OPP_sym); + par->mode = mode; + par->link = NIL; + if (first == NIL) { + first = par; + } + if (*firstPar == NIL) { + *firstPar = par; + } else { + last->link = par; + } + last = par; + } else { + OPP_err(38); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(19); + } else if (OPP_sym == 60) { + OPP_err(19); + OPS_Get(&OPP_sym); + } else { + break; + } + } + OPP_CheckSym(20); + OPP_Type(&typ, &OPT_notyp); + if (mode == 1) { + typ->pvused = 1; + } + while (first != NIL) { + first->typ = typ; + first = first->link; + } + if (OPP_sym == 39) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(39); + } else { + break; + } + } + } + OPP_CheckSym(22); + if (OPP_sym == 20) { + OPS_Get(&OPP_sym); + *resTyp = OPT_undftyp; + if (OPP_sym == 38) { + OPP_qualident(&res); + if (res->mode == 5) { + if (res->typ->form < 15) { + *resTyp = res->typ; + } else { + OPP_err(54); + } + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + } else { + *resTyp = OPT_notyp; + } +} + +static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned) +{ + OPT_Object id = NIL; + *typ = OPT_undftyp; + if (OPP_sym < 30) { + OPP_err(12); + do { + OPS_Get(&OPP_sym); + } while (!(OPP_sym >= 30)); + } + if (OPP_sym == 38) { + OPP_qualident(&id); + if (id->mode == 5) { + if (id->typ != *banned) { + *typ = id->typ; + } else { + OPP_err(58); + } + } else { + OPP_err(52); + } + } else if (OPP_sym == 54) { + OPS_Get(&OPP_sym); + OPP_ArrayType(&*typ, &*banned); + } else if (OPP_sym == 55) { + OPS_Get(&OPP_sym); + OPP_RecordType(&*typ, &*banned); + OPB_Inittd(&OPP_TDinit, &OPP_lastTDinit, *typ); + OPP_CheckSym(41); + } else if (OPP_sym == 56) { + OPS_Get(&OPP_sym); + OPP_PointerType(&*typ); + } else if (OPP_sym == 61) { + OPS_Get(&OPP_sym); + *typ = OPT_NewStr(14, 1); + OPP_CheckSysFlag(&(*typ)->sysflag, 0); + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPT_OpenScope(OPP_level, NIL); + OPP_FormalParameters(&(*typ)->link, &(*typ)->BaseTyp); + OPT_CloseScope(); + } else { + (*typ)->BaseTyp = OPT_notyp; + (*typ)->link = NIL; + } + } else { + OPP_err(12); + } + for (;;) { + if (((OPP_sym >= 39 && OPP_sym <= 42) || OPP_sym == 22) || OPP_sym == 64) { + break; + } + OPP_err(15); + if (OPP_sym == 38) { + break; + } + OPS_Get(&OPP_sym); + } +} + +static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned) +{ + OPP_TypeDecl(&*typ, &*banned); + if (((((*typ)->form == 13 && (*typ)->BaseTyp == OPT_undftyp)) && (*typ)->strobj == NIL)) { + OPP_err(0); + } +} + +static void OPP_selector (OPT_Node *x) +{ + OPT_Object obj = NIL, proc = NIL; + OPT_Node y = NIL; + OPT_Struct typ = NIL; + OPS_Name name; + for (;;) { + if (OPP_sym == 31) { + OPS_Get(&OPP_sym); + for (;;) { + if (((*x)->typ != NIL && (*x)->typ->form == 13)) { + OPB_DeRef(&*x); + } + OPP_Expression(&y); + OPB_Index(&*x, y); + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else { + break; + } + } + OPP_CheckSym(23); + } else if (OPP_sym == 18) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + __COPY(OPS_name, name, ((LONGINT)(256))); + OPS_Get(&OPP_sym); + if ((*x)->typ != NIL) { + if ((*x)->typ->form == 13) { + OPB_DeRef(&*x); + } + if ((*x)->typ->comp == 4) { + OPT_FindField(name, (*x)->typ, &obj); + OPB_Field(&*x, obj); + if ((obj != NIL && obj->mode == 13)) { + if (OPP_sym == 17) { + OPS_Get(&OPP_sym); + y = (*x)->left; + if (y->class == 3) { + y = y->left; + } + if (y->obj != NIL) { + proc = OPT_topScope; + while ((proc->link != NIL && proc->link->mode != 13)) { + proc = proc->left; + } + if (proc->link == NIL || proc->link->link != y->obj) { + OPP_err(75); + } + typ = y->obj->typ; + if (typ->form == 13) { + typ = typ->BaseTyp; + } + OPT_FindField((*x)->obj->name, typ->BaseTyp, &proc); + if (proc != NIL) { + (*x)->subcl = 1; + } else { + OPP_err(74); + } + } else { + OPP_err(75); + } + } + if ((obj->typ != OPT_notyp && OPP_sym != 30)) { + OPP_err(30); + } + } + } else { + OPP_err(53); + } + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + } else if (OPP_sym == 17) { + OPS_Get(&OPP_sym); + OPB_DeRef(&*x); + } else if ((((((OPP_sym == 30 && (*x)->class < 7)) && (*x)->typ->form != 14)) && ((*x)->obj == NIL || (*x)->obj->mode != 13))) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPP_qualident(&obj); + if (obj->mode == 5) { + OPB_TypTest(&*x, obj, 1); + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + OPP_CheckSym(22); + } else { + break; + } + } +} + +static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar) +{ + OPT_Node apar = NIL, last = NIL; + *aparlist = NIL; + last = NIL; + if (OPP_sym != 22) { + for (;;) { + OPP_Expression(&apar); + if (fpar != NIL) { + OPB_Param(apar, fpar); + OPB_Link(&*aparlist, &last, apar); + fpar = fpar->link; + } else { + OPP_err(64); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if ((30 <= OPP_sym && OPP_sym <= 38)) { + OPP_err(19); + } else { + break; + } + } + } + if (fpar != NIL) { + OPP_err(65); + } +} + +static void OPP_StandProcCall (OPT_Node *x) +{ + OPT_Node y = NIL; + SHORTINT m; + INTEGER n; + m = (int)(*x)->obj->adr; + n = 0; + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + if (OPP_sym != 22) { + for (;;) { + if (n == 0) { + OPP_Expression(&*x); + OPB_StPar0(&*x, m); + n = 1; + } else if (n == 1) { + OPP_Expression(&y); + OPB_StPar1(&*x, y, m); + n = 2; + } else { + OPP_Expression(&y); + OPB_StParN(&*x, y, m, n); + n += 1; + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if ((30 <= OPP_sym && OPP_sym <= 38)) { + OPP_err(19); + } else { + break; + } + } + OPP_CheckSym(22); + } else { + OPS_Get(&OPP_sym); + } + OPB_StFct(&*x, m, n); + } else { + OPP_err(30); + } + if ((OPP_level > 0 && (m == 1 || m == 30))) { + OPT_topScope->link->leaf = 0; + } +} + +static void OPP_Element (OPT_Node *x) +{ + OPT_Node y = NIL; + OPP_Expression(&*x); + if (OPP_sym == 21) { + OPS_Get(&OPP_sym); + OPP_Expression(&y); + OPB_SetRange(&*x, y); + } else { + OPB_SetElem(&*x); + } +} + +static void OPP_Sets (OPT_Node *x) +{ + OPT_Node y = NIL; + if (OPP_sym != 24) { + OPP_Element(&*x); + for (;;) { + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if ((30 <= OPP_sym && OPP_sym <= 38)) { + OPP_err(19); + } else { + break; + } + OPP_Element(&y); + OPB_Op(6, &*x, y); + } + } else { + *x = OPB_EmptySet(); + } + OPP_CheckSym(24); +} + +static void OPP_Factor (OPT_Node *x) +{ + OPT_Object fpar = NIL, id = NIL; + OPT_Node apar = NIL; + if (OPP_sym < 30) { + OPP_err(13); + do { + OPS_Get(&OPP_sym); + } while (!(OPP_sym >= 30)); + } + if (OPP_sym == 38) { + OPP_qualident(&id); + *x = OPB_NewLeaf(id); + OPP_selector(&*x); + if (((*x)->class == 9 && (*x)->obj->mode == 8)) { + OPP_StandProcCall(&*x); + } else if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPB_PrepCall(&*x, &fpar); + OPP_ActualParameters(&apar, fpar); + OPB_Call(&*x, apar, fpar); + OPP_CheckSym(22); + if (OPP_level > 0) { + OPT_topScope->link->leaf = 0; + } + } + } else if (OPP_sym == 35) { + switch (OPS_numtyp) { + case 1: + *x = OPB_NewIntConst(OPS_intval); + (*x)->typ = OPT_chartyp; + break; + case 2: + *x = OPB_NewIntConst(OPS_intval); + break; + case 3: + *x = OPB_NewRealConst(OPS_realval, OPT_realtyp); + break; + case 4: + *x = OPB_NewRealConst(OPS_lrlval, OPT_lrltyp); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPP.Factor, OPS.numtyp = ", (LONGINT)44); + OPM_LogWNum(OPS_numtyp, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + OPS_Get(&OPP_sym); + } else if (OPP_sym == 37) { + *x = OPB_NewString(OPS_str, OPS_intval); + OPS_Get(&OPP_sym); + } else if (OPP_sym == 36) { + *x = OPB_Nil(); + OPS_Get(&OPP_sym); + } else if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPP_Expression(&*x); + OPP_CheckSym(22); + } else if (OPP_sym == 31) { + OPS_Get(&OPP_sym); + OPP_err(30); + OPP_Expression(&*x); + OPP_CheckSym(22); + } else if (OPP_sym == 32) { + OPS_Get(&OPP_sym); + OPP_Sets(&*x); + } else if (OPP_sym == 33) { + OPS_Get(&OPP_sym); + OPP_Factor(&*x); + OPB_MOp(33, &*x); + } else { + OPP_err(13); + OPS_Get(&OPP_sym); + *x = NIL; + } + if (*x == NIL) { + *x = OPB_NewIntConst(((LONGINT)(1))); + (*x)->typ = OPT_undftyp; + } +} + +static void OPP_Term (OPT_Node *x) +{ + OPT_Node y = NIL; + SHORTINT mulop; + OPP_Factor(&*x); + while ((1 <= OPP_sym && OPP_sym <= 5)) { + mulop = OPP_sym; + OPS_Get(&OPP_sym); + OPP_Factor(&y); + OPB_Op(mulop, &*x, y); + } +} + +static void OPP_SimpleExpression (OPT_Node *x) +{ + OPT_Node y = NIL; + SHORTINT addop; + if (OPP_sym == 7) { + OPS_Get(&OPP_sym); + OPP_Term(&*x); + OPB_MOp(7, &*x); + } else if (OPP_sym == 6) { + OPS_Get(&OPP_sym); + OPP_Term(&*x); + OPB_MOp(6, &*x); + } else { + OPP_Term(&*x); + } + while ((6 <= OPP_sym && OPP_sym <= 8)) { + addop = OPP_sym; + OPS_Get(&OPP_sym); + OPP_Term(&y); + OPB_Op(addop, &*x, y); + } +} + +static void OPP_Expression (OPT_Node *x) +{ + OPT_Node y = NIL; + OPT_Object obj = NIL; + SHORTINT relation; + OPP_SimpleExpression(&*x); + if ((9 <= OPP_sym && OPP_sym <= 14)) { + relation = OPP_sym; + OPS_Get(&OPP_sym); + OPP_SimpleExpression(&y); + OPB_Op(relation, &*x, y); + } else if (OPP_sym == 15) { + OPS_Get(&OPP_sym); + OPP_SimpleExpression(&y); + OPB_In(&*x, y); + } else if (OPP_sym == 16) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPP_qualident(&obj); + if (obj->mode == 5) { + OPB_TypTest(&*x, obj, 0); + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + } +} + +static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec) +{ + OPT_Object obj = NIL; + *typ = OPT_undftyp; + *rec = NIL; + if (OPP_sym == 60) { + OPS_Get(&OPP_sym); + *mode = 2; + } else { + *mode = 1; + } + __COPY(OPS_name, name, ((LONGINT)(256))); + OPP_CheckSym(38); + OPP_CheckSym(20); + if (OPP_sym == 38) { + OPT_Find(&obj); + OPS_Get(&OPP_sym); + if (obj == NIL) { + OPP_err(0); + } else if (obj->mode != 5) { + OPP_err(72); + } else { + *typ = obj->typ; + *rec = *typ; + if ((*rec)->form == 13) { + *rec = (*rec)->BaseTyp; + } + if (!((((*mode == 1 && (*typ)->form == 13)) && (*rec)->comp == 4) || (*mode == 2 && (*typ)->comp == 4))) { + OPP_err(70); + *rec = NIL; + } + if ((*rec != NIL && (*rec)->mno != OPP_level)) { + OPP_err(72); + *rec = NIL; + } + } + } else { + OPP_err(38); + } + OPP_CheckSym(22); + if (*rec == NIL) { + *rec = OPT_NewStr(15, 4); + (*rec)->BaseTyp = NIL; + } +} + +static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b) +{ + BOOLEAN _o_result; + if ((b->form == 13 && x->form == 13)) { + b = b->BaseTyp; + x = x->BaseTyp; + } + if ((b->comp == 4 && x->comp == 4)) { + do { + x = x->BaseTyp; + } while (!(x == NIL || x == b)); + } + _o_result = x == b; + return _o_result; +} + +static struct ProcedureDeclaration__16 { + OPT_Node *x; + OPT_Object *proc, *fwd; + OPS_Name *name; + SHORTINT *mode, *vis; + BOOLEAN *forward; + struct ProcedureDeclaration__16 *lnk; +} *ProcedureDeclaration__16_s; + +static void Body__17 (void); +static void GetCode__19 (void); +static void GetParams__21 (void); +static void TProcDecl__23 (void); + +static void GetCode__19 (void) +{ + OPT_ConstExt ext = NIL; + INTEGER n; + LONGINT c; + ext = OPT_NewExt(); + (*ProcedureDeclaration__16_s->proc)->conval->ext = ext; + n = 0; + if (OPP_sym == 37) { + while (OPS_str[__X(n, ((LONGINT)(256)))] != 0x00) { + (*ext)[__X(n + 1, ((LONGINT)(256)))] = OPS_str[__X(n, ((LONGINT)(256)))]; + n += 1; + } + (*ext)[0] = (CHAR)n; + OPS_Get(&OPP_sym); + } else { + for (;;) { + if (OPP_sym == 35) { + c = OPS_intval; + n += 1; + if ((c < 0 || c > 255) || n == 256) { + OPP_err(64); + c = 1; + n = 1; + } + OPS_Get(&OPP_sym); + (*ext)[__X(n, ((LONGINT)(256)))] = (CHAR)c; + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 35) { + OPP_err(19); + } else { + (*ext)[0] = (CHAR)n; + break; + } + } + } + (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1); +} + +static void GetParams__21 (void) +{ + (*ProcedureDeclaration__16_s->proc)->vis = *ProcedureDeclaration__16_s->vis; + (*ProcedureDeclaration__16_s->proc)->mode = *ProcedureDeclaration__16_s->mode; + (*ProcedureDeclaration__16_s->proc)->typ = OPT_notyp; + (*ProcedureDeclaration__16_s->proc)->conval = OPT_NewConst(); + (*ProcedureDeclaration__16_s->proc)->conval->setval = 0x0; + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPP_FormalParameters(&(*ProcedureDeclaration__16_s->proc)->link, &(*ProcedureDeclaration__16_s->proc)->typ); + } + if (*ProcedureDeclaration__16_s->fwd != NIL) { + OPB_CheckParameters((*ProcedureDeclaration__16_s->proc)->link, (*ProcedureDeclaration__16_s->fwd)->link, 1); + if ((*ProcedureDeclaration__16_s->proc)->typ != (*ProcedureDeclaration__16_s->fwd)->typ) { + OPP_err(117); + } + *ProcedureDeclaration__16_s->proc = *ProcedureDeclaration__16_s->fwd; + OPT_topScope = (*ProcedureDeclaration__16_s->proc)->scope; + if (*ProcedureDeclaration__16_s->mode == 10) { + (*ProcedureDeclaration__16_s->proc)->mode = 10; + } + } +} + +static void Body__17 (void) +{ + OPT_Node procdec = NIL, statseq = NIL; + LONGINT c; + c = OPM_errpos; + (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1); + OPP_CheckSym(39); + OPP_Block(&procdec, &statseq); + OPB_Enter(&procdec, statseq, *ProcedureDeclaration__16_s->proc); + *ProcedureDeclaration__16_s->x = procdec; + (*ProcedureDeclaration__16_s->x)->conval = OPT_NewConst(); + (*ProcedureDeclaration__16_s->x)->conval->intval = c; + if (OPP_sym == 38) { + if (__STRCMP(OPS_name, (*ProcedureDeclaration__16_s->proc)->name) != 0) { + OPP_err(4); + } + OPS_Get(&OPP_sym); + } else { + OPP_err(38); + } +} + +static void TProcDecl__23 (void) +{ + OPT_Object baseProc = NIL; + OPT_Struct objTyp = NIL, recTyp = NIL; + SHORTINT objMode; + OPS_Name objName; + OPS_Get(&OPP_sym); + *ProcedureDeclaration__16_s->mode = 13; + if (OPP_level > 0) { + OPP_err(73); + } + OPP_Receiver(&objMode, objName, &objTyp, &recTyp); + if (OPP_sym == 38) { + __COPY(OPS_name, *ProcedureDeclaration__16_s->name, ((LONGINT)(256))); + OPP_CheckMark(&*ProcedureDeclaration__16_s->vis); + OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp, &*ProcedureDeclaration__16_s->fwd); + OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp->BaseTyp, &baseProc); + if ((baseProc != NIL && baseProc->mode != 13)) { + baseProc = NIL; + } + if (*ProcedureDeclaration__16_s->fwd == baseProc) { + *ProcedureDeclaration__16_s->fwd = NIL; + } + if ((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mnolev != OPP_level)) { + *ProcedureDeclaration__16_s->fwd = NIL; + } + if ((((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mode == 13)) && !__IN(1, (*ProcedureDeclaration__16_s->fwd)->conval->setval))) { + *ProcedureDeclaration__16_s->proc = OPT_NewObj(); + (*ProcedureDeclaration__16_s->proc)->leaf = 1; + if ((*ProcedureDeclaration__16_s->fwd)->vis != *ProcedureDeclaration__16_s->vis) { + OPP_err(118); + } + } else { + if (*ProcedureDeclaration__16_s->fwd != NIL) { + OPP_err(1); + *ProcedureDeclaration__16_s->fwd = NIL; + } + OPT_OpenScope(0, NIL); + OPT_topScope->right = recTyp->link; + OPT_Insert(*ProcedureDeclaration__16_s->name, &*ProcedureDeclaration__16_s->proc); + recTyp->link = OPT_topScope->right; + OPT_CloseScope(); + } + OPP_level += 1; + OPT_OpenScope(OPP_level, *ProcedureDeclaration__16_s->proc); + OPT_Insert(objName, &(*ProcedureDeclaration__16_s->proc)->link); + (*ProcedureDeclaration__16_s->proc)->link->mode = objMode; + (*ProcedureDeclaration__16_s->proc)->link->typ = objTyp; + GetParams__21(); + if (baseProc != NIL) { + if (objMode != baseProc->link->mode || !OPP_Extends(objTyp, baseProc->link->typ)) { + OPP_err(115); + } + OPB_CheckParameters((*ProcedureDeclaration__16_s->proc)->link->link, baseProc->link->link, 0); + if ((*ProcedureDeclaration__16_s->proc)->typ != baseProc->typ) { + OPP_err(117); + } + if ((((((baseProc->vis == 1 && (*ProcedureDeclaration__16_s->proc)->vis == 0)) && recTyp->strobj != NIL)) && recTyp->strobj->vis == 1)) { + OPP_err(109); + } + (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(2); + } + if (!*ProcedureDeclaration__16_s->forward) { + Body__17(); + } + OPP_level -= 1; + OPT_CloseScope(); + } else { + OPP_err(38); + } +} + +static void OPP_ProcedureDeclaration (OPT_Node *x) +{ + OPT_Object proc = NIL, fwd = NIL; + OPS_Name name; + SHORTINT mode, vis; + BOOLEAN forward; + struct ProcedureDeclaration__16 _s; + _s.x = x; + _s.proc = &proc; + _s.fwd = &fwd; + _s.name = (void*)name; + _s.mode = &mode; + _s.vis = &vis; + _s.forward = &forward; + _s.lnk = ProcedureDeclaration__16_s; + ProcedureDeclaration__16_s = &_s; + proc = NIL; + forward = 0; + *x = NIL; + mode = 6; + if ((OPP_sym != 38 && OPP_sym != 30)) { + if (OPP_sym == 1) { + } else if (OPP_sym == 17) { + forward = 1; + } else if (OPP_sym == 6) { + mode = 10; + } else if (OPP_sym == 7) { + mode = 9; + } else { + OPP_err(38); + } + if ((__IN(mode, 0x0600) && !OPT_SYSimported)) { + OPP_err(135); + } + OPS_Get(&OPP_sym); + } + if (OPP_sym == 30) { + TProcDecl__23(); + } else if (OPP_sym == 38) { + OPT_Find(&fwd); + __COPY(OPS_name, name, ((LONGINT)(256))); + OPP_CheckMark(&vis); + if ((vis != 0 && mode == 6)) { + mode = 7; + } + if ((fwd != NIL && (fwd->mnolev != OPP_level || fwd->mode == 8))) { + fwd = NIL; + } + if ((((fwd != NIL && __IN(fwd->mode, 0xc0))) && !__IN(1, fwd->conval->setval))) { + proc = OPT_NewObj(); + proc->leaf = 1; + if (fwd->vis != vis) { + OPP_err(118); + } + } else { + if (fwd != NIL) { + OPP_err(1); + fwd = NIL; + } + OPT_Insert(name, &proc); + } + if ((mode != 6 && OPP_level > 0)) { + OPP_err(73); + } + OPP_level += 1; + OPT_OpenScope(OPP_level, proc); + proc->link = NIL; + GetParams__21(); + if (mode == 9) { + GetCode__19(); + } else if (!forward) { + Body__17(); + } + OPP_level -= 1; + OPT_CloseScope(); + } else { + OPP_err(38); + } + ProcedureDeclaration__16_s = _s.lnk; +} + +static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab) +{ + OPT_Node x = NIL, y = NIL, lastlab = NIL; + INTEGER i, f; + LONGINT xval, yval; + *lab = NIL; + lastlab = NIL; + for (;;) { + OPP_ConstExpression(&x); + f = x->typ->form; + if (__IN(f, 0x78)) { + xval = x->conval->intval; + } else { + OPP_err(61); + xval = 1; + } + if (__IN(f, 0x70)) { + if (LabelForm < f) { + OPP_err(60); + } + } else if (LabelForm != f) { + OPP_err(60); + } + if (OPP_sym == 21) { + OPS_Get(&OPP_sym); + OPP_ConstExpression(&y); + yval = y->conval->intval; + if (((int)y->typ->form != f && !((__IN(f, 0x70) && __IN(y->typ->form, 0x70))))) { + OPP_err(60); + } + if (yval < xval) { + OPP_err(63); + yval = xval; + } + } else { + yval = xval; + } + x->conval->intval2 = yval; + i = *n; + if (i < 128) { + for (;;) { + if (i == 0) { + break; + } + if (tab[__X(i - 1, ((LONGINT)(128)))].low <= yval) { + if (tab[__X(i - 1, ((LONGINT)(128)))].high >= xval) { + OPP_err(62); + } + break; + } + tab[__X(i, ((LONGINT)(128)))] = tab[__X(i - 1, ((LONGINT)(128)))]; + i -= 1; + } + tab[__X(i, ((LONGINT)(128)))].low = xval; + tab[__X(i, ((LONGINT)(128)))].high = yval; + *n += 1; + } else { + OPP_err(213); + } + OPB_Link(&*lab, &lastlab, x); + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 35 || OPP_sym == 38) { + OPP_err(19); + } else { + break; + } + } +} + +static struct StatSeq__30 { + LONGINT *pos; + struct StatSeq__30 *lnk; +} *StatSeq__30_s; + +static void CasePart__31 (OPT_Node *x); +static void CheckBool__33 (OPT_Node *x); +static void SetPos__35 (OPT_Node x); + +static void CasePart__31 (OPT_Node *x) +{ + INTEGER n; + LONGINT low, high; + BOOLEAN e; + OPP_CaseTable tab; + OPT_Node cases = NIL, lab = NIL, y = NIL, lastcase = NIL; + OPP_Expression(&*x); + *StatSeq__30_s->pos = OPM_errpos; + if ((*x)->class == 8 || (*x)->class == 9) { + OPP_err(126); + } else if (!__IN((*x)->typ->form, 0x78)) { + OPP_err(125); + } + OPP_CheckSym(25); + cases = NIL; + lastcase = NIL; + n = 0; + for (;;) { + if (OPP_sym < 40) { + OPP_CaseLabelList(&lab, (*x)->typ->form, &n, tab); + OPP_CheckSym(20); + OPP_StatSeq(&y); + OPB_Construct(17, &lab, y); + OPB_Link(&cases, &lastcase, lab); + } + if (OPP_sym == 40) { + OPS_Get(&OPP_sym); + } else { + break; + } + } + if (n > 0) { + low = tab[0].low; + high = tab[__X(n - 1, ((LONGINT)(128)))].high; + if (high - low > 512) { + OPP_err(209); + } + } else { + low = 1; + high = 0; + } + e = OPP_sym == 42; + if (e) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&y); + } else { + y = NIL; + OPM_Mark(-307, OPM_curpos); + } + OPB_Construct(16, &cases, y); + OPB_Construct(21, &*x, cases); + cases->conval = OPT_NewConst(); + cases->conval->intval = low; + cases->conval->intval2 = high; + if (e) { + cases->conval->setval = 0x02; + } else { + cases->conval->setval = 0x0; + } +} + +static void SetPos__35 (OPT_Node x) +{ + x->conval = OPT_NewConst(); + x->conval->intval = *StatSeq__30_s->pos; +} + +static void CheckBool__33 (OPT_Node *x) +{ + if ((*x)->class == 8 || (*x)->class == 9) { + OPP_err(126); + *x = OPB_NewBoolConst(0); + } else if ((*x)->typ->form != 2) { + OPP_err(120); + *x = OPB_NewBoolConst(0); + } + *StatSeq__30_s->pos = OPM_errpos; +} + +static void OPP_StatSeq (OPT_Node *stat) +{ + OPT_Object fpar = NIL, id = NIL, t = NIL, obj = NIL; + OPT_Struct idtyp = NIL; + BOOLEAN e; + OPT_Node s = NIL, x = NIL, y = NIL, z = NIL, apar = NIL, last = NIL, lastif = NIL; + LONGINT pos; + OPS_Name name; + struct StatSeq__30 _s; + _s.pos = &pos; + _s.lnk = StatSeq__30_s; + StatSeq__30_s = &_s; + *stat = NIL; + last = NIL; + for (;;) { + x = NIL; + if (OPP_sym < 38) { + OPP_err(14); + do { + OPS_Get(&OPP_sym); + } while (!(OPP_sym >= 38)); + } + if (OPP_sym == 38) { + OPP_qualident(&id); + x = OPB_NewLeaf(id); + OPP_selector(&x); + if (OPP_sym == 34) { + OPS_Get(&OPP_sym); + OPP_Expression(&y); + OPB_Assign(&x, y); + } else if (OPP_sym == 9) { + OPP_err(34); + OPS_Get(&OPP_sym); + OPP_Expression(&y); + OPB_Assign(&x, y); + } else if ((x->class == 9 && x->obj->mode == 8)) { + OPP_StandProcCall(&x); + if ((x != NIL && x->typ != OPT_notyp)) { + OPP_err(55); + } + } else { + OPB_PrepCall(&x, &fpar); + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPP_ActualParameters(&apar, fpar); + OPP_CheckSym(22); + } else { + apar = NIL; + if (fpar != NIL) { + OPP_err(65); + } + } + OPB_Call(&x, apar, fpar); + if (x->typ != OPT_notyp) { + OPP_err(55); + } + if (OPP_level > 0) { + OPT_topScope->link->leaf = 0; + } + } + pos = OPM_errpos; + } else if (OPP_sym == 45) { + OPS_Get(&OPP_sym); + OPP_Expression(&x); + CheckBool__33(&x); + OPP_CheckSym(26); + OPP_StatSeq(&y); + OPB_Construct(15, &x, y); + SetPos__35(x); + lastif = x; + while (OPP_sym == 43) { + OPS_Get(&OPP_sym); + OPP_Expression(&y); + CheckBool__33(&y); + OPP_CheckSym(26); + OPP_StatSeq(&z); + OPB_Construct(15, &y, z); + SetPos__35(y); + OPB_Link(&x, &lastif, y); + } + if (OPP_sym == 42) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&y); + } else { + y = NIL; + } + OPB_Construct(20, &x, y); + OPP_CheckSym(41); + OPB_OptIf(&x); + pos = OPM_errpos; + } else if (OPP_sym == 46) { + OPS_Get(&OPP_sym); + CasePart__31(&x); + OPP_CheckSym(41); + } else if (OPP_sym == 47) { + OPS_Get(&OPP_sym); + OPP_Expression(&x); + CheckBool__33(&x); + OPP_CheckSym(27); + OPP_StatSeq(&y); + OPB_Construct(22, &x, y); + OPP_CheckSym(41); + } else if (OPP_sym == 48) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&x); + if (OPP_sym == 44) { + OPS_Get(&OPP_sym); + OPP_Expression(&y); + CheckBool__33(&y); + } else { + OPP_err(44); + } + OPB_Construct(23, &x, y); + } else if (OPP_sym == 49) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPP_qualident(&id); + if (!__IN(id->typ->form, 0x70)) { + OPP_err(68); + } + OPP_CheckSym(34); + OPP_Expression(&y); + pos = OPM_errpos; + x = OPB_NewLeaf(id); + OPB_Assign(&x, y); + SetPos__35(x); + OPP_CheckSym(28); + OPP_Expression(&y); + pos = OPM_errpos; + if (y->class != 7) { + __MOVE("@@", name, 3); + OPT_Insert(name, &t); + __MOVE("@for", t->name, 5); + t->mode = 1; + t->typ = x->left->typ; + obj = OPT_topScope->scope; + if (obj == NIL) { + OPT_topScope->scope = t; + } else { + while (obj->link != NIL) { + obj = obj->link; + } + obj->link = t; + } + z = OPB_NewLeaf(t); + OPB_Assign(&z, y); + SetPos__35(z); + OPB_Link(&*stat, &last, z); + y = OPB_NewLeaf(t); + } else if (y->typ->form < 4 || y->typ->form > x->left->typ->form) { + OPP_err(113); + } + OPB_Link(&*stat, &last, x); + if (OPP_sym == 29) { + OPS_Get(&OPP_sym); + OPP_ConstExpression(&z); + } else { + z = OPB_NewIntConst(((LONGINT)(1))); + } + pos = OPM_errpos; + x = OPB_NewLeaf(id); + if (z->conval->intval > 0) { + OPB_Op(12, &x, y); + } else if (z->conval->intval < 0) { + OPB_Op(14, &x, y); + } else { + OPP_err(63); + OPB_Op(14, &x, y); + } + OPP_CheckSym(27); + OPP_StatSeq(&s); + y = OPB_NewLeaf(id); + OPB_StPar1(&y, z, 13); + SetPos__35(y); + if (s == NIL) { + s = y; + } else { + z = s; + while (z->link != NIL) { + z = z->link; + } + z->link = y; + } + OPP_CheckSym(41); + OPB_Construct(22, &x, s); + } else { + OPP_err(38); + } + } else if (OPP_sym == 50) { + OPS_Get(&OPP_sym); + OPP_LoopLevel += 1; + OPP_StatSeq(&x); + OPP_LoopLevel -= 1; + OPB_Construct(24, &x, NIL); + OPP_CheckSym(41); + pos = OPM_errpos; + } else if (OPP_sym == 51) { + OPS_Get(&OPP_sym); + idtyp = NIL; + x = NIL; + for (;;) { + if (OPP_sym == 38) { + OPP_qualident(&id); + y = OPB_NewLeaf(id); + if ((((id != NIL && id->typ->form == 13)) && (id->mode == 2 || !id->leaf))) { + OPP_err(245); + } + OPP_CheckSym(20); + if (OPP_sym == 38) { + OPP_qualident(&t); + if (t->mode == 5) { + if (id != NIL) { + idtyp = id->typ; + OPB_TypTest(&y, t, 0); + id->typ = t->typ; + } else { + OPP_err(130); + } + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + } else { + OPP_err(38); + } + pos = OPM_errpos; + OPP_CheckSym(27); + OPP_StatSeq(&s); + OPB_Construct(15, &y, s); + SetPos__35(y); + if (idtyp != NIL) { + id->typ = idtyp; + idtyp = NIL; + } + if (x == NIL) { + x = y; + lastif = x; + } else { + OPB_Link(&x, &lastif, y); + } + if (OPP_sym == 40) { + OPS_Get(&OPP_sym); + } else { + break; + } + } + e = OPP_sym == 42; + if (e) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&s); + } else { + s = NIL; + } + OPB_Construct(27, &x, s); + OPP_CheckSym(41); + if (e) { + x->subcl = 1; + } + } else if (OPP_sym == 52) { + OPS_Get(&OPP_sym); + if (OPP_LoopLevel == 0) { + OPP_err(46); + } + OPB_Construct(25, &x, NIL); + pos = OPM_errpos; + } else if (OPP_sym == 53) { + OPS_Get(&OPP_sym); + if (OPP_sym < 39) { + OPP_Expression(&x); + } + if (OPP_level > 0) { + OPB_Return(&x, OPT_topScope->link); + } else { + OPB_Return(&x, NIL); + } + pos = OPM_errpos; + } + if (x != NIL) { + SetPos__35(x); + OPB_Link(&*stat, &last, x); + } + if (OPP_sym == 39) { + OPS_Get(&OPP_sym); + } else if (OPP_sym <= 38 || (45 <= OPP_sym && OPP_sym <= 53)) { + OPP_err(39); + } else { + break; + } + } + StatSeq__30_s = _s.lnk; +} + +static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq) +{ + OPT_Struct typ = NIL; + OPT_Object obj = NIL, first = NIL, last = NIL; + OPT_Node x = NIL, lastdec = NIL; + INTEGER i; + first = NIL; + last = NIL; + OPP_nofFwdPtr = 0; + for (;;) { + if (OPP_sym == 58) { + OPS_Get(&OPP_sym); + while (OPP_sym == 38) { + OPT_Insert(OPS_name, &obj); + OPP_CheckMark(&obj->vis); + obj->typ = OPT_sinttyp; + obj->mode = 1; + if (OPP_sym == 9) { + OPS_Get(&OPP_sym); + OPP_ConstExpression(&x); + } else if (OPP_sym == 34) { + OPP_err(9); + OPS_Get(&OPP_sym); + OPP_ConstExpression(&x); + } else { + OPP_err(9); + x = OPB_NewIntConst(((LONGINT)(1))); + } + obj->mode = 3; + obj->typ = x->typ; + obj->conval = x->conval; + OPP_CheckSym(39); + } + } + if (OPP_sym == 59) { + OPS_Get(&OPP_sym); + while (OPP_sym == 38) { + OPT_Insert(OPS_name, &obj); + obj->mode = 5; + obj->typ = OPT_undftyp; + OPP_CheckMark(&obj->vis); + if (OPP_sym == 9) { + OPS_Get(&OPP_sym); + OPP_TypeDecl(&obj->typ, &obj->typ); + } else if (OPP_sym == 34 || OPP_sym == 20) { + OPP_err(9); + OPS_Get(&OPP_sym); + OPP_TypeDecl(&obj->typ, &obj->typ); + } else { + OPP_err(9); + } + if (obj->typ->strobj == NIL) { + obj->typ->strobj = obj; + } + if (__IN(obj->typ->comp, 0x1c)) { + i = 0; + while (i < OPP_nofFwdPtr) { + typ = OPP_FwdPtr[__X(i, ((LONGINT)(64)))]; + i += 1; + if (__STRCMP(typ->link->name, obj->name) == 0) { + typ->BaseTyp = obj->typ; + typ->link->name[0] = 0x00; + } + } + } + OPP_CheckSym(39); + } + } + if (OPP_sym == 60) { + OPS_Get(&OPP_sym); + while (OPP_sym == 38) { + for (;;) { + if (OPP_sym == 38) { + OPT_Insert(OPS_name, &obj); + OPP_CheckMark(&obj->vis); + obj->mode = 1; + obj->link = NIL; + obj->leaf = obj->vis == 0; + obj->typ = OPT_undftyp; + if (first == NIL) { + first = obj; + } + if (last == NIL) { + OPT_topScope->scope = obj; + } else { + last->link = obj; + } + last = obj; + } else { + OPP_err(38); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(19); + } else { + break; + } + } + OPP_CheckSym(20); + OPP_Type(&typ, &OPT_notyp); + typ->pvused = 1; + if (typ->comp == 3) { + typ = OPT_undftyp; + OPP_err(88); + } + while (first != NIL) { + first->typ = typ; + first = first->link; + } + OPP_CheckSym(39); + } + } + if (OPP_sym < 58 || OPP_sym > 60) { + break; + } + } + i = 0; + while (i < OPP_nofFwdPtr) { + if (OPP_FwdPtr[__X(i, ((LONGINT)(64)))]->link->name[0] != 0x00) { + OPP_err(128); + } + OPP_FwdPtr[__X(i, ((LONGINT)(64)))] = NIL; + i += 1; + } + OPT_topScope->adr = OPM_errpos; + *procdec = NIL; + lastdec = NIL; + while (OPP_sym == 61) { + OPS_Get(&OPP_sym); + OPP_ProcedureDeclaration(&x); + if (x != NIL) { + if (lastdec == NIL) { + *procdec = x; + } else { + lastdec->link = x; + } + lastdec = x; + } + OPP_CheckSym(39); + } + if (OPP_sym == 57) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&*statseq); + } else { + *statseq = NIL; + } + if ((OPP_level == 0 && OPP_TDinit != NIL)) { + OPP_lastTDinit->link = *statseq; + *statseq = OPP_TDinit; + } + OPP_CheckSym(41); +} + +void OPP_Module (OPT_Node *prog, SET opt) +{ + OPS_Name impName, aliasName; + OPT_Node procdec = NIL, statseq = NIL; + LONGINT c; + BOOLEAN done; + OPS_Init(); + OPP_LoopLevel = 0; + OPP_level = 0; + OPS_Get(&OPP_sym); + if (OPP_sym == 63) { + OPS_Get(&OPP_sym); + } else { + OPP_err(16); + } + if (OPP_sym == 38) { + OPM_LogWStr((CHAR*)"compiling ", (LONGINT)11); + OPM_LogWStr(OPS_name, ((LONGINT)(256))); + OPM_LogW('.'); + OPT_Init(OPS_name, opt); + OPS_Get(&OPP_sym); + OPP_CheckSym(39); + if (OPP_sym == 62) { + OPS_Get(&OPP_sym); + for (;;) { + if (OPP_sym == 38) { + __COPY(OPS_name, aliasName, ((LONGINT)(256))); + __COPY(aliasName, impName, ((LONGINT)(256))); + OPS_Get(&OPP_sym); + if (OPP_sym == 34) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + __COPY(OPS_name, impName, ((LONGINT)(256))); + OPS_Get(&OPP_sym); + } else { + OPP_err(38); + } + } + OPT_Import(aliasName, impName, &done); + } else { + OPP_err(38); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(19); + } else { + break; + } + } + OPP_CheckSym(39); + } + if (OPM_noerr) { + OPP_TDinit = NIL; + OPP_lastTDinit = NIL; + c = OPM_errpos; + OPP_Block(&procdec, &statseq); + OPB_Enter(&procdec, statseq, NIL); + *prog = procdec; + (*prog)->conval = OPT_NewConst(); + (*prog)->conval->intval = c; + if (OPP_sym == 38) { + if (__STRCMP(OPS_name, OPT_SelfName) != 0) { + OPP_err(4); + } + OPS_Get(&OPP_sym); + } else { + OPP_err(38); + } + if (OPP_sym != 18) { + OPP_err(18); + } + } + } else { + OPP_err(38); + } + OPP_TDinit = NIL; + OPP_lastTDinit = NIL; +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(OPP_TDinit); + P(OPP_lastTDinit); + __ENUMP(OPP_FwdPtr, 64, P); +} + +__TDESC(OPP__1, 1, 0) = {__TDFLDS("", 8), {-4}}; + +export void *OPP__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPB); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPS); + __MODULE_IMPORT(OPT); + __REGMOD("OPP", EnumPtrs); + __INITYP(OPP__1, OPP__1, 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/windows-48/OPP.h b/bootstrap/windows-48/OPP.h new file mode 100644 index 00000000..1e0a1809 --- /dev/null +++ b/bootstrap/windows-48/OPP.h @@ -0,0 +1,16 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPP__h +#define OPP__h + +#include "SYSTEM.h" +#include "OPT.h" + + + + +import void OPP_Module (OPT_Node *prog, SET opt); +import void *OPP__init(void); + + +#endif diff --git a/bootstrap/windows-48/OPS.c b/bootstrap/windows-48/OPS.c new file mode 100644 index 00000000..88944148 --- /dev/null +++ b/bootstrap/windows-48/OPS.c @@ -0,0 +1,623 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tspkaSfF */ +#include "SYSTEM.h" +#include "OPM.h" + +typedef + CHAR OPS_Name[256]; + +typedef + CHAR OPS_String[256]; + + +export OPS_Name OPS_name; +export OPS_String OPS_str; +export INTEGER OPS_numtyp; +export LONGINT OPS_intval; +export REAL OPS_realval; +export LONGREAL OPS_lrlval; +static CHAR OPS_ch; + + +export void OPS_Get (SHORTINT *sym); +static void OPS_Identifier (SHORTINT *sym); +export void OPS_Init (void); +static void OPS_Number (void); +static void OPS_Str (SHORTINT *sym); +static void OPS_err (INTEGER n); + + +static void OPS_err (INTEGER n) +{ + OPM_err(n); +} + +static void OPS_Str (SHORTINT *sym) +{ + INTEGER i; + CHAR och; + i = 0; + och = OPS_ch; + for (;;) { + OPM_Get(&OPS_ch); + if (OPS_ch == och) { + break; + } + if (OPS_ch < ' ') { + OPS_err(3); + break; + } + if (i == 255) { + OPS_err(241); + break; + } + OPS_str[i] = OPS_ch; + i += 1; + } + OPM_Get(&OPS_ch); + OPS_str[i] = 0x00; + OPS_intval = i + 1; + if (OPS_intval == 2) { + *sym = 35; + OPS_numtyp = 1; + OPS_intval = (int)OPS_str[0]; + } else { + *sym = 37; + } +} + +static void OPS_Identifier (SHORTINT *sym) +{ + INTEGER i; + i = 0; + do { + OPS_name[i] = OPS_ch; + i += 1; + OPM_Get(&OPS_ch); + } while (!(((OPS_ch < '0' || ('9' < OPS_ch && __CAP(OPS_ch) < 'A')) || 'Z' < __CAP(OPS_ch)) || i == 256)); + if (i == 256) { + OPS_err(240); + i -= 1; + } + OPS_name[i] = 0x00; + *sym = 38; +} + +static struct Number__6 { + struct Number__6 *lnk; +} *Number__6_s; + +static INTEGER Ord__7 (CHAR ch, BOOLEAN hex); +static LONGREAL Ten__9 (INTEGER e); + +static LONGREAL Ten__9 (INTEGER e) +{ + LONGREAL _o_result; + LONGREAL x, p; + x = (LONGREAL)1; + p = (LONGREAL)10; + while (e > 0) { + if (__ODD(e)) { + x = x * p; + } + e = __ASHR(e, 1); + if (e > 0) { + p = p * p; + } + } + _o_result = x; + return _o_result; +} + +static INTEGER Ord__7 (CHAR ch, BOOLEAN hex) +{ + INTEGER _o_result; + if (ch <= '9') { + _o_result = (int)ch - 48; + return _o_result; + } else if (hex) { + _o_result = ((int)ch - 65) + 10; + return _o_result; + } else { + OPS_err(2); + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +static void OPS_Number (void) +{ + INTEGER i, m, n, d, e; + CHAR dig[24]; + LONGREAL f; + CHAR expCh; + BOOLEAN neg; + struct Number__6 _s; + _s.lnk = Number__6_s; + Number__6_s = &_s; + i = 0; + m = 0; + n = 0; + d = 0; + for (;;) { + if (('0' <= OPS_ch && OPS_ch <= '9') || (((d == 0 && 'A' <= OPS_ch)) && OPS_ch <= 'F')) { + if (m > 0 || OPS_ch != '0') { + if (n < 24) { + dig[n] = OPS_ch; + n += 1; + } + m += 1; + } + OPM_Get(&OPS_ch); + i += 1; + } else if (OPS_ch == '.') { + OPM_Get(&OPS_ch); + if (OPS_ch == '.') { + OPS_ch = 0x7f; + break; + } else if (d == 0) { + d = i; + } else { + OPS_err(2); + } + } else { + break; + } + } + if (d == 0) { + if (n == m) { + OPS_intval = 0; + i = 0; + if (OPS_ch == 'X') { + OPM_Get(&OPS_ch); + OPS_numtyp = 1; + if (n <= 2) { + while (i < n) { + OPS_intval = __ASHL(OPS_intval, 4) + (LONGINT)Ord__7(dig[i], 1); + i += 1; + } + } else { + OPS_err(203); + } + } else if (OPS_ch == 'H') { + OPM_Get(&OPS_ch); + OPS_numtyp = 2; + if (n <= 8) { + if ((n == 8 && dig[0] > '7')) { + OPS_intval = -1; + } + while (i < n) { + OPS_intval = __ASHL(OPS_intval, 4) + (LONGINT)Ord__7(dig[i], 1); + i += 1; + } + } else { + OPS_err(203); + } + } else { + OPS_numtyp = 2; + while (i < n) { + d = Ord__7(dig[i], 0); + i += 1; + if (OPS_intval <= __DIV(2147483647 - (LONGINT)d, 10)) { + OPS_intval = OPS_intval * 10 + (LONGINT)d; + } else { + OPS_err(203); + } + } + } + } else { + OPS_err(203); + } + } else { + f = (LONGREAL)0; + e = 0; + expCh = 'E'; + while (n > 0) { + n -= 1; + f = (Ord__7(dig[n], 0) + f) / (LONGREAL)(LONGREAL)10; + } + if (OPS_ch == 'E' || OPS_ch == 'D') { + expCh = OPS_ch; + OPM_Get(&OPS_ch); + neg = 0; + if (OPS_ch == '-') { + neg = 1; + OPM_Get(&OPS_ch); + } else if (OPS_ch == '+') { + OPM_Get(&OPS_ch); + } + if (('0' <= OPS_ch && OPS_ch <= '9')) { + do { + n = Ord__7(OPS_ch, 0); + OPM_Get(&OPS_ch); + if (e <= __DIV(32767 - n, 10)) { + e = e * 10 + n; + } else { + OPS_err(203); + } + } while (!(OPS_ch < '0' || '9' < OPS_ch)); + if (neg) { + e = -e; + } + } else { + OPS_err(2); + } + } + e -= (i - d) - m; + if (expCh == 'E') { + OPS_numtyp = 3; + if ((-37 < e && e <= 38)) { + if (e < 0) { + OPS_realval = (f / (LONGREAL)Ten__9(-e)); + } else { + OPS_realval = (f * Ten__9(e)); + } + } else { + OPS_err(203); + } + } else { + OPS_numtyp = 4; + if ((-307 < e && e <= 308)) { + if (e < 0) { + OPS_lrlval = f / (LONGREAL)Ten__9(-e); + } else { + OPS_lrlval = f * Ten__9(e); + } + } else { + OPS_err(203); + } + } + } + Number__6_s = _s.lnk; +} + +static struct Get__1 { + struct Get__1 *lnk; +} *Get__1_s; + +static void Comment__2 (void); + +static void Comment__2 (void) +{ + OPM_Get(&OPS_ch); + for (;;) { + for (;;) { + while (OPS_ch == '(') { + OPM_Get(&OPS_ch); + if (OPS_ch == '*') { + Comment__2(); + } + } + if (OPS_ch == '*') { + OPM_Get(&OPS_ch); + break; + } + if (OPS_ch == 0x00) { + break; + } + OPM_Get(&OPS_ch); + } + if (OPS_ch == ')') { + OPM_Get(&OPS_ch); + break; + } + if (OPS_ch == 0x00) { + OPS_err(5); + break; + } + } +} + +void OPS_Get (SHORTINT *sym) +{ + SHORTINT s; + struct Get__1 _s; + _s.lnk = Get__1_s; + Get__1_s = &_s; + OPM_errpos = OPM_curpos - 1; + while (OPS_ch <= ' ') { + if (OPS_ch == 0x00) { + *sym = 64; + return; + } else { + OPM_Get(&OPS_ch); + } + } + switch (OPS_ch) { + case '\"': case '\'': + OPS_Str(&s); + break; + case '#': + s = 10; + OPM_Get(&OPS_ch); + break; + case '&': + s = 5; + OPM_Get(&OPS_ch); + break; + case '(': + OPM_Get(&OPS_ch); + if (OPS_ch == '*') { + Comment__2(); + OPS_Get(&s); + } else { + s = 30; + } + break; + case ')': + s = 22; + OPM_Get(&OPS_ch); + break; + case '*': + s = 1; + OPM_Get(&OPS_ch); + break; + case '+': + s = 6; + OPM_Get(&OPS_ch); + break; + case ',': + s = 19; + OPM_Get(&OPS_ch); + break; + case '-': + s = 7; + OPM_Get(&OPS_ch); + break; + case '.': + OPM_Get(&OPS_ch); + if (OPS_ch == '.') { + OPM_Get(&OPS_ch); + s = 21; + } else { + s = 18; + } + break; + case '/': + s = 2; + OPM_Get(&OPS_ch); + break; + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + OPS_Number(); + s = 35; + break; + case ':': + OPM_Get(&OPS_ch); + if (OPS_ch == '=') { + OPM_Get(&OPS_ch); + s = 34; + } else { + s = 20; + } + break; + case ';': + s = 39; + OPM_Get(&OPS_ch); + break; + case '<': + OPM_Get(&OPS_ch); + if (OPS_ch == '=') { + OPM_Get(&OPS_ch); + s = 12; + } else { + s = 11; + } + break; + case '=': + s = 9; + OPM_Get(&OPS_ch); + break; + case '>': + OPM_Get(&OPS_ch); + if (OPS_ch == '=') { + OPM_Get(&OPS_ch); + s = 14; + } else { + s = 13; + } + break; + case 'A': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "ARRAY") == 0) { + s = 54; + } + break; + case 'B': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "BEGIN") == 0) { + s = 57; + } else if (__STRCMP(OPS_name, "BY") == 0) { + s = 29; + } + break; + case 'C': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "CASE") == 0) { + s = 46; + } else if (__STRCMP(OPS_name, "CONST") == 0) { + s = 58; + } + break; + case 'D': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "DO") == 0) { + s = 27; + } else if (__STRCMP(OPS_name, "DIV") == 0) { + s = 3; + } + break; + case 'E': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "END") == 0) { + s = 41; + } else if (__STRCMP(OPS_name, "ELSE") == 0) { + s = 42; + } else if (__STRCMP(OPS_name, "ELSIF") == 0) { + s = 43; + } else if (__STRCMP(OPS_name, "EXIT") == 0) { + s = 52; + } + break; + case 'F': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "FOR") == 0) { + s = 49; + } + break; + case 'I': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "IF") == 0) { + s = 45; + } else if (__STRCMP(OPS_name, "IN") == 0) { + s = 15; + } else if (__STRCMP(OPS_name, "IS") == 0) { + s = 16; + } else if (__STRCMP(OPS_name, "IMPORT") == 0) { + s = 62; + } + break; + case 'L': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "LOOP") == 0) { + s = 50; + } + break; + case 'M': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "MOD") == 0) { + s = 4; + } else if (__STRCMP(OPS_name, "MODULE") == 0) { + s = 63; + } + break; + case 'N': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "NIL") == 0) { + s = 36; + } + break; + case 'O': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "OR") == 0) { + s = 8; + } else if (__STRCMP(OPS_name, "OF") == 0) { + s = 25; + } + break; + case 'P': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "PROCEDURE") == 0) { + s = 61; + } else if (__STRCMP(OPS_name, "POINTER") == 0) { + s = 56; + } + break; + case 'R': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "RECORD") == 0) { + s = 55; + } else if (__STRCMP(OPS_name, "REPEAT") == 0) { + s = 48; + } else if (__STRCMP(OPS_name, "RETURN") == 0) { + s = 53; + } + break; + case 'T': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "THEN") == 0) { + s = 26; + } else if (__STRCMP(OPS_name, "TO") == 0) { + s = 28; + } else if (__STRCMP(OPS_name, "TYPE") == 0) { + s = 59; + } + break; + case 'U': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "UNTIL") == 0) { + s = 44; + } + break; + case 'V': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "VAR") == 0) { + s = 60; + } + break; + case 'W': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "WHILE") == 0) { + s = 47; + } else if (__STRCMP(OPS_name, "WITH") == 0) { + s = 51; + } + break; + case 'G': case 'H': case 'J': case 'K': case 'Q': + case 'S': case 'X': case 'Y': case 'Z': + OPS_Identifier(&s); + break; + case '[': + s = 31; + OPM_Get(&OPS_ch); + break; + case ']': + s = 23; + OPM_Get(&OPS_ch); + break; + case '^': + s = 17; + OPM_Get(&OPS_ch); + break; + case 'a': case 'b': case 'c': case 'd': case 'e': + case 'f': case 'g': case 'h': case 'i': case 'j': + case 'k': case 'l': case 'm': case 'n': case 'o': + case 'p': case 'q': case 'r': case 's': case 't': + case 'u': case 'v': case 'w': case 'x': case 'y': + case 'z': + OPS_Identifier(&s); + break; + case '{': + s = 32; + OPM_Get(&OPS_ch); + break; + case '|': + s = 40; + OPM_Get(&OPS_ch); + break; + case '}': + s = 24; + OPM_Get(&OPS_ch); + break; + case '~': + s = 33; + OPM_Get(&OPS_ch); + break; + case 0x7f: + s = 21; + OPM_Get(&OPS_ch); + break; + default: + s = 0; + OPM_Get(&OPS_ch); + break; + } + *sym = s; + Get__1_s = _s.lnk; +} + +void OPS_Init (void) +{ + OPS_ch = ' '; +} + + +export void *OPS__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPM); + __REGMOD("OPS", 0); + __REGCMD("Init", OPS_Init); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/windows-48/OPS.h b/bootstrap/windows-48/OPS.h new file mode 100644 index 00000000..87a614f4 --- /dev/null +++ b/bootstrap/windows-48/OPS.h @@ -0,0 +1,28 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tspkaSfF */ + +#ifndef OPS__h +#define OPS__h + +#include "SYSTEM.h" + +typedef + CHAR OPS_Name[256]; + +typedef + CHAR OPS_String[256]; + + +import OPS_Name OPS_name; +import OPS_String OPS_str; +import INTEGER OPS_numtyp; +import LONGINT OPS_intval; +import REAL OPS_realval; +import LONGREAL OPS_lrlval; + + +import void OPS_Get (SHORTINT *sym); +import void OPS_Init (void); +import void *OPS__init(void); + + +#endif diff --git a/bootstrap/windows-48/OPT.c b/bootstrap/windows-48/OPT.c new file mode 100644 index 00000000..fc80ce02 --- /dev/null +++ b/bootstrap/windows-48/OPT.c @@ -0,0 +1,1858 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "OPM.h" +#include "OPS.h" + +typedef + struct OPT_ConstDesc *OPT_Const; + +typedef + OPS_String *OPT_ConstExt; + +typedef + struct OPT_ConstDesc { + OPT_ConstExt ext; + LONGINT intval, intval2; + SET setval; + LONGREAL realval; + } OPT_ConstDesc; + +typedef + struct OPT_ExpCtxt { + LONGINT reffp; + INTEGER ref; + SHORTINT nofm; + SHORTINT locmno[64]; + } OPT_ExpCtxt; + +typedef + struct OPT_StrDesc *OPT_Struct; + +typedef + struct OPT_ObjDesc *OPT_Object; + +typedef + struct OPT_ImpCtxt { + LONGINT nextTag, reffp; + INTEGER nofr, minr, nofm; + BOOLEAN self; + OPT_Struct ref[255]; + OPT_Object old[255]; + LONGINT pvfp[255]; + SHORTINT glbmno[64]; + } OPT_ImpCtxt; + +typedef + struct OPT_NodeDesc *OPT_Node; + +typedef + struct OPT_NodeDesc { + OPT_Node left, right, link; + SHORTINT class, subcl; + BOOLEAN readonly; + OPT_Struct typ; + OPT_Object obj; + OPT_Const conval; + } OPT_NodeDesc; + +typedef + struct OPT_ObjDesc { + OPT_Object left, right, link, scope; + OPS_Name name; + BOOLEAN leaf; + SHORTINT mode, mnolev, vis, history; + BOOLEAN used, fpdone; + LONGINT fprint; + OPT_Struct typ; + OPT_Const conval; + LONGINT adr, linkadr; + INTEGER x; + } OPT_ObjDesc; + +typedef + struct OPT_StrDesc { + SHORTINT form, comp, mno, extlev; + INTEGER ref, sysflag; + LONGINT n, size, align, txtpos; + BOOLEAN allocated, pbused, pvused, fpdone, idfpdone; + LONGINT idfp, pbfp, pvfp; + OPT_Struct BaseTyp; + OPT_Object link, strobj; + } OPT_StrDesc; + + +export void (*OPT_typSize)(OPT_Struct); +export OPT_Object OPT_topScope; +export OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp; +export SHORTINT OPT_nofGmod; +export OPT_Object OPT_GlbMod[64]; +export OPS_Name OPT_SelfName; +export BOOLEAN OPT_SYSimported; +static OPT_Object OPT_universe, OPT_syslink; +static OPT_ImpCtxt OPT_impCtxt; +static OPT_ExpCtxt OPT_expCtxt; +static LONGINT OPT_nofhdfld; +static BOOLEAN OPT_newsf, OPT_findpc, OPT_extsf, OPT_sfpresent, OPT_symExtended, OPT_symNew; + +export LONGINT *OPT_ConstDesc__typ; +export LONGINT *OPT_ObjDesc__typ; +export LONGINT *OPT_StrDesc__typ; +export LONGINT *OPT_NodeDesc__typ; +export LONGINT *OPT_ImpCtxt__typ; +export LONGINT *OPT_ExpCtxt__typ; + +export void OPT_Close (void); +export void OPT_CloseScope (void); +static void OPT_DebugStruct (OPT_Struct btyp); +static void OPT_EnterBoolConst (OPS_Name name, LONGINT value); +static void OPT_EnterProc (OPS_Name name, INTEGER num); +static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res); +export void OPT_Export (BOOLEAN *ext, BOOLEAN *new); +export void OPT_FPrintErr (OPT_Object obj, INTEGER errcode); +static void OPT_FPrintName (LONGINT *fp, CHAR *name, LONGINT name__len); +export void OPT_FPrintObj (OPT_Object obj); +static void OPT_FPrintSign (LONGINT *fp, OPT_Struct result, OPT_Object par); +export void OPT_FPrintStr (OPT_Struct typ); +export void OPT_Find (OPT_Object *res); +export void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res); +export void OPT_FindImport (OPT_Object mod, OPT_Object *res); +export void OPT_IdFPrint (OPT_Struct typ); +export void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done); +static void OPT_InConstant (LONGINT f, OPT_Const conval); +static OPT_Object OPT_InFld (void); +static void OPT_InMod (SHORTINT *mno); +static void OPT_InName (CHAR *name, LONGINT name__len); +static OPT_Object OPT_InObj (SHORTINT mno); +static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par); +static void OPT_InStruct (OPT_Struct *typ); +static OPT_Object OPT_InTProc (SHORTINT mno); +export void OPT_Init (OPS_Name name, SET opt); +static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form); +export void OPT_Insert (OPS_Name name, OPT_Object *obj); +export void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old); +export OPT_Const OPT_NewConst (void); +export OPT_ConstExt OPT_NewExt (void); +export OPT_Node OPT_NewNode (SHORTINT class); +export OPT_Object OPT_NewObj (void); +export OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp); +export void OPT_OpenScope (SHORTINT level, OPT_Object owner); +static void OPT_OutConstant (OPT_Object obj); +static void OPT_OutFlds (OPT_Object fld, LONGINT adr, BOOLEAN visible); +static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr); +static void OPT_OutMod (INTEGER mno); +static void OPT_OutName (CHAR *name, LONGINT name__len); +static void OPT_OutObj (OPT_Object obj); +static void OPT_OutSign (OPT_Struct result, OPT_Object par); +static void OPT_OutStr (OPT_Struct typ); +static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj); +static void OPT_err (INTEGER n); + + +static void OPT_err (INTEGER n) +{ + OPM_err(n); +} + +OPT_Const OPT_NewConst (void) +{ + OPT_Const _o_result; + OPT_Const const_ = NIL; + __NEW(const_, OPT_ConstDesc); + _o_result = const_; + return _o_result; +} + +OPT_Object OPT_NewObj (void) +{ + OPT_Object _o_result; + OPT_Object obj = NIL; + __NEW(obj, OPT_ObjDesc); + _o_result = obj; + return _o_result; +} + +OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp) +{ + OPT_Struct _o_result; + OPT_Struct typ = NIL; + __NEW(typ, OPT_StrDesc); + typ->form = form; + typ->comp = comp; + typ->ref = 255; + if (form != 0) { + typ->txtpos = OPM_errpos; + } + typ->size = -1; + typ->BaseTyp = OPT_undftyp; + _o_result = typ; + return _o_result; +} + +OPT_Node OPT_NewNode (SHORTINT class) +{ + OPT_Node _o_result; + OPT_Node node = NIL; + __NEW(node, OPT_NodeDesc); + node->class = class; + _o_result = node; + return _o_result; +} + +OPT_ConstExt OPT_NewExt (void) +{ + OPT_ConstExt _o_result; + OPT_ConstExt ext = NIL; + ext = __NEWARR(NIL, ((LONGINT)(1)), 1, 1, 0, (LONGINT)256); + _o_result = ext; + return _o_result; +} + +void OPT_OpenScope (SHORTINT level, OPT_Object owner) +{ + OPT_Object head = NIL; + head = OPT_NewObj(); + head->mode = 12; + head->mnolev = level; + head->link = owner; + if (owner != NIL) { + owner->scope = head; + } + head->left = OPT_topScope; + head->right = NIL; + head->scope = NIL; + OPT_topScope = head; +} + +void OPT_CloseScope (void) +{ + OPT_topScope = OPT_topScope->left; +} + +void OPT_Init (OPS_Name name, SET opt) +{ + OPT_topScope = OPT_universe; + OPT_OpenScope(0, NIL); + OPT_SYSimported = 0; + __COPY(name, OPT_SelfName, ((LONGINT)(256))); + __COPY(name, OPT_topScope->name, ((LONGINT)(256))); + OPT_GlbMod[0] = OPT_topScope; + OPT_nofGmod = 1; + OPT_newsf = __IN(4, opt); + OPT_findpc = __IN(8, opt); + OPT_extsf = OPT_newsf || __IN(9, opt); + OPT_sfpresent = 1; +} + +void OPT_Close (void) +{ + INTEGER i; + OPT_CloseScope(); + i = 0; + while (i < 64) { + OPT_GlbMod[__X(i, ((LONGINT)(64)))] = NIL; + i += 1; + } + i = 16; + while (i < 255) { + OPT_impCtxt.ref[__X(i, ((LONGINT)(255)))] = NIL; + OPT_impCtxt.old[__X(i, ((LONGINT)(255)))] = NIL; + i += 1; + } +} + +void OPT_FindImport (OPT_Object mod, OPT_Object *res) +{ + OPT_Object obj = NIL; + obj = mod->scope; + for (;;) { + if (obj == NIL) { + break; + } + if (__STRCMP(OPS_name, obj->name) < 0) { + obj = obj->left; + } else if (__STRCMP(OPS_name, obj->name) > 0) { + obj = obj->right; + } else { + if ((obj->mode == 5 && obj->vis == 0)) { + obj = NIL; + } else { + obj->used = 1; + } + break; + } + } + *res = obj; +} + +void OPT_Find (OPT_Object *res) +{ + OPT_Object obj = NIL, head = NIL; + head = OPT_topScope; + for (;;) { + obj = head->right; + for (;;) { + if (obj == NIL) { + break; + } + if (__STRCMP(OPS_name, obj->name) < 0) { + obj = obj->left; + } else if (__STRCMP(OPS_name, obj->name) > 0) { + obj = obj->right; + } else { + break; + } + } + if (obj != NIL) { + break; + } + head = head->left; + if (head == NIL) { + break; + } + } + *res = obj; +} + +void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res) +{ + OPT_Object obj = NIL; + while (typ != NIL) { + obj = typ->link; + while (obj != NIL) { + if (__STRCMP(name, obj->name) < 0) { + obj = obj->left; + } else if (__STRCMP(name, obj->name) > 0) { + obj = obj->right; + } else { + *res = obj; + return; + } + } + typ = typ->BaseTyp; + } + *res = NIL; +} + +void OPT_Insert (OPS_Name name, OPT_Object *obj) +{ + OPT_Object ob0 = NIL, ob1 = NIL; + BOOLEAN left; + SHORTINT mnolev; + ob0 = OPT_topScope; + ob1 = ob0->right; + left = 0; + for (;;) { + if (ob1 != NIL) { + if (__STRCMP(name, ob1->name) < 0) { + ob0 = ob1; + ob1 = ob0->left; + left = 1; + } else if (__STRCMP(name, ob1->name) > 0) { + ob0 = ob1; + ob1 = ob0->right; + left = 0; + } else { + OPT_err(1); + ob0 = ob1; + ob1 = ob0->right; + } + } else { + ob1 = OPT_NewObj(); + ob1->leaf = 1; + if (left) { + ob0->left = ob1; + } else { + ob0->right = ob1; + } + ob1->left = NIL; + ob1->right = NIL; + __COPY(name, ob1->name, ((LONGINT)(256))); + mnolev = OPT_topScope->mnolev; + ob1->mnolev = mnolev; + break; + } + } + *obj = ob1; +} + +static void OPT_FPrintName (LONGINT *fp, CHAR *name, LONGINT name__len) +{ + INTEGER i; + CHAR ch; + i = 0; + do { + ch = name[__X(i, name__len)]; + OPM_FPrint(&*fp, (int)ch); + i += 1; + } while (!(ch == 0x00)); +} + +static void OPT_DebugStruct (OPT_Struct btyp) +{ + OPM_LogWLn(); + if (btyp == NIL) { + OPM_LogWStr((CHAR*)"btyp is nil", (LONGINT)12); + OPM_LogWLn(); + } + OPM_LogWStr((CHAR*)"btyp^.strobji^.name = ", (LONGINT)23); + OPM_LogWStr(btyp->strobj->name, ((LONGINT)(256))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.form = ", (LONGINT)14); + OPM_LogWNum(btyp->form, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.comp = ", (LONGINT)14); + OPM_LogWNum(btyp->comp, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.mno = ", (LONGINT)13); + OPM_LogWNum(btyp->mno, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.extlev = ", (LONGINT)16); + OPM_LogWNum(btyp->extlev, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.size = ", (LONGINT)14); + OPM_LogWNum(btyp->size, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.align = ", (LONGINT)15); + OPM_LogWNum(btyp->align, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.txtpos = ", (LONGINT)16); + OPM_LogWNum(btyp->txtpos, ((LONGINT)(0))); + OPM_LogWLn(); +} + +static void OPT_FPrintSign (LONGINT *fp, OPT_Struct result, OPT_Object par) +{ + OPT_IdFPrint(result); + OPM_FPrint(&*fp, result->idfp); + while (par != NIL) { + OPM_FPrint(&*fp, par->mode); + OPT_IdFPrint(par->typ); + OPM_FPrint(&*fp, par->typ->idfp); + par = par->link; + } +} + +void OPT_IdFPrint (OPT_Struct typ) +{ + OPT_Struct btyp = NIL; + OPT_Object strobj = NIL; + LONGINT idfp; + INTEGER f, c; + if (!typ->idfpdone) { + typ->idfpdone = 1; + idfp = 0; + f = typ->form; + c = typ->comp; + OPM_FPrint(&idfp, f); + OPM_FPrint(&idfp, c); + btyp = typ->BaseTyp; + strobj = typ->strobj; + if ((strobj != NIL && strobj->name[0] != 0x00)) { + OPT_FPrintName(&idfp, (void*)OPT_GlbMod[__X(typ->mno, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + OPT_FPrintName(&idfp, (void*)strobj->name, ((LONGINT)(256))); + } + if ((f == 13 || (c == 4 && btyp != NIL)) || c == 3) { + OPT_IdFPrint(btyp); + OPM_FPrint(&idfp, btyp->idfp); + } else if (c == 2) { + OPT_IdFPrint(btyp); + OPM_FPrint(&idfp, btyp->idfp); + OPM_FPrint(&idfp, typ->n); + } else if (f == 14) { + OPT_FPrintSign(&idfp, btyp, typ->link); + } + typ->idfp = idfp; + } +} + +static struct FPrintStr__12 { + LONGINT *pbfp, *pvfp; + struct FPrintStr__12 *lnk; +} *FPrintStr__12_s; + +static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible); +static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr); +static void FPrintTProcs__17 (OPT_Object obj); + +static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr) +{ + LONGINT i, j, n; + OPT_Struct btyp = NIL; + if (typ->comp == 4) { + FPrintFlds__13(typ->link, adr, 0); + } else if (typ->comp == 2) { + btyp = typ->BaseTyp; + n = typ->n; + while (btyp->comp == 2) { + n = btyp->n * n; + btyp = btyp->BaseTyp; + } + if (btyp->form == 13 || btyp->comp == 4) { + j = OPT_nofhdfld; + FPrintHdFld__15(btyp, fld, adr); + if (j != OPT_nofhdfld) { + i = 1; + while ((i < n && OPT_nofhdfld <= 2048)) { + adr += btyp->size; + FPrintHdFld__15(btyp, fld, adr); + i += 1; + } + } + } + } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) { + OPM_FPrint(&*FPrintStr__12_s->pvfp, ((LONGINT)(13))); + OPM_FPrint(&*FPrintStr__12_s->pvfp, adr); + OPT_nofhdfld += 1; + } +} + +static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible) +{ + while ((fld != NIL && fld->mode == 4)) { + if ((fld->vis != 0 && visible)) { + OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->vis); + OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)fld->name, ((LONGINT)(256))); + OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->adr); + OPT_FPrintStr(fld->typ); + OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->typ->pbfp); + OPM_FPrint(&*FPrintStr__12_s->pvfp, fld->typ->pvfp); + } else { + FPrintHdFld__15(fld->typ, fld, fld->adr + adr); + } + fld = fld->link; + } +} + +static void FPrintTProcs__17 (OPT_Object obj) +{ + if (obj != NIL) { + FPrintTProcs__17(obj->left); + if (obj->mode == 13) { + if (obj->vis != 0) { + OPM_FPrint(&*FPrintStr__12_s->pbfp, ((LONGINT)(13))); + OPM_FPrint(&*FPrintStr__12_s->pbfp, __ASHR(obj->adr, 16)); + OPT_FPrintSign(&*FPrintStr__12_s->pbfp, obj->typ, obj->link); + OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)obj->name, ((LONGINT)(256))); + } + } + FPrintTProcs__17(obj->right); + } +} + +void OPT_FPrintStr (OPT_Struct typ) +{ + INTEGER f, c; + OPT_Struct btyp = NIL; + OPT_Object strobj = NIL, bstrobj = NIL; + LONGINT pbfp, pvfp; + struct FPrintStr__12 _s; + _s.pbfp = &pbfp; + _s.pvfp = &pvfp; + _s.lnk = FPrintStr__12_s; + FPrintStr__12_s = &_s; + if (!typ->fpdone) { + OPT_IdFPrint(typ); + pbfp = typ->idfp; + if (typ->sysflag != 0) { + OPM_FPrint(&pbfp, typ->sysflag); + } + pvfp = pbfp; + typ->pbfp = pbfp; + typ->pvfp = pvfp; + typ->fpdone = 1; + f = typ->form; + c = typ->comp; + btyp = typ->BaseTyp; + if (f == 13) { + strobj = typ->strobj; + bstrobj = btyp->strobj; + if (((strobj == NIL || strobj->name[0] == 0x00) || bstrobj == NIL) || bstrobj->name[0] == 0x00) { + OPT_FPrintStr(btyp); + OPM_FPrint(&pbfp, btyp->pbfp); + pvfp = pbfp; + } + } else if (f == 14) { + } else if (__IN(c, 0x0c)) { + OPT_FPrintStr(btyp); + OPM_FPrint(&pbfp, btyp->pvfp); + pvfp = pbfp; + } else { + if (btyp != NIL) { + OPT_FPrintStr(btyp); + OPM_FPrint(&pbfp, btyp->pbfp); + OPM_FPrint(&pvfp, btyp->pvfp); + } + OPM_FPrint(&pvfp, typ->size); + OPM_FPrint(&pvfp, typ->align); + OPM_FPrint(&pvfp, typ->n); + OPT_nofhdfld = 0; + FPrintFlds__13(typ->link, ((LONGINT)(0)), 1); + if (OPT_nofhdfld > 2048) { + OPM_Mark(225, typ->txtpos); + } + FPrintTProcs__17(typ->link); + OPM_FPrint(&pvfp, pbfp); + strobj = typ->strobj; + if (strobj == NIL || strobj->name[0] == 0x00) { + pbfp = pvfp; + } + } + typ->pbfp = pbfp; + typ->pvfp = pvfp; + } + FPrintStr__12_s = _s.lnk; +} + +void OPT_FPrintObj (OPT_Object obj) +{ + LONGINT fprint; + INTEGER f, m; + REAL rval; + OPT_ConstExt ext = NIL; + if (!obj->fpdone) { + fprint = 0; + obj->fpdone = 1; + OPM_FPrint(&fprint, obj->mode); + if (obj->mode == 3) { + f = obj->typ->form; + OPM_FPrint(&fprint, f); + switch (f) { + case 2: case 3: case 4: case 5: case 6: + OPM_FPrint(&fprint, obj->conval->intval); + break; + case 9: + OPM_FPrintSet(&fprint, obj->conval->setval); + break; + case 7: + rval = obj->conval->realval; + OPM_FPrintReal(&fprint, rval); + break; + case 8: + OPM_FPrintLReal(&fprint, obj->conval->realval); + break; + case 10: + OPT_FPrintName(&fprint, (void*)*obj->conval->ext, ((LONGINT)(256))); + break; + case 11: + break; + default: + OPT_err(127); + break; + } + } else if (obj->mode == 1) { + OPM_FPrint(&fprint, obj->vis); + OPT_FPrintStr(obj->typ); + OPM_FPrint(&fprint, obj->typ->pbfp); + } else if (__IN(obj->mode, 0x0480)) { + OPT_FPrintSign(&fprint, obj->typ, obj->link); + } else if (obj->mode == 9) { + OPT_FPrintSign(&fprint, obj->typ, obj->link); + ext = obj->conval->ext; + m = (int)(*ext)[0]; + f = 1; + OPM_FPrint(&fprint, m); + while (f <= m) { + OPM_FPrint(&fprint, (int)(*ext)[__X(f, ((LONGINT)(256)))]); + f += 1; + } + } else if (obj->mode == 5) { + OPT_FPrintStr(obj->typ); + OPM_FPrint(&fprint, obj->typ->pbfp); + } + obj->fprint = fprint; + } +} + +void OPT_FPrintErr (OPT_Object obj, INTEGER errcode) +{ + INTEGER i, j; + CHAR ch; + if (obj->mnolev != 0) { + __COPY(OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, OPM_objname, ((LONGINT)(64))); + i = 0; + while (OPM_objname[__X(i, ((LONGINT)(64)))] != 0x00) { + i += 1; + } + OPM_objname[__X(i, ((LONGINT)(64)))] = '.'; + j = 0; + i += 1; + do { + ch = obj->name[__X(j, ((LONGINT)(256)))]; + OPM_objname[__X(i, ((LONGINT)(64)))] = ch; + j += 1; + i += 1; + } while (!(ch == 0x00)); + } else { + __COPY(obj->name, OPM_objname, ((LONGINT)(64))); + } + if (errcode == 249) { + if (OPM_noerr) { + OPT_err(errcode); + } + } else if (errcode == 253) { + if ((((!OPT_symNew && !OPT_symExtended)) && !OPT_extsf)) { + OPT_err(errcode); + } + OPT_symExtended = 1; + } else { + if ((!OPT_symNew && !OPT_newsf)) { + OPT_err(errcode); + } + OPT_symNew = 1; + } +} + +void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old) +{ + OPT_Object ob0 = NIL, ob1 = NIL; + BOOLEAN left; + if (*root == NIL) { + *root = obj; + *old = NIL; + } else { + ob0 = *root; + ob1 = ob0->right; + left = 0; + if (__STRCMP(obj->name, ob0->name) < 0) { + ob1 = ob0->left; + left = 1; + } else if (__STRCMP(obj->name, ob0->name) > 0) { + ob1 = ob0->right; + left = 0; + } else { + *old = ob0; + return; + } + for (;;) { + if (ob1 != NIL) { + if (__STRCMP(obj->name, ob1->name) < 0) { + ob0 = ob1; + ob1 = ob1->left; + left = 1; + } else if (__STRCMP(obj->name, ob1->name) > 0) { + ob0 = ob1; + ob1 = ob1->right; + left = 0; + } else { + *old = ob1; + break; + } + } else { + ob1 = obj; + if (left) { + ob0->left = ob1; + } else { + ob0->right = ob1; + } + ob1->left = NIL; + ob1->right = NIL; + *old = NIL; + break; + } + } + } +} + +static void OPT_InName (CHAR *name, LONGINT name__len) +{ + INTEGER i; + CHAR ch; + i = 0; + do { + OPM_SymRCh(&ch); + name[__X(i, name__len)] = ch; + i += 1; + } while (!(ch == 0x00)); +} + +static void OPT_InMod (SHORTINT *mno) +{ + OPT_Object head = NIL; + OPS_Name name; + LONGINT mn; + SHORTINT i; + mn = OPM_SymRInt(); + if (mn == 0) { + *mno = OPT_impCtxt.glbmno[0]; + } else { + if (mn == 16) { + OPT_InName((void*)name, ((LONGINT)(256))); + if ((__STRCMP(name, OPT_SelfName) == 0 && !OPT_impCtxt.self)) { + OPT_err(154); + } + i = 0; + while ((i < OPT_nofGmod && __STRCMP(name, OPT_GlbMod[__X(i, ((LONGINT)(64)))]->name) != 0)) { + i += 1; + } + if (i < OPT_nofGmod) { + *mno = i; + } else { + head = OPT_NewObj(); + head->mode = 12; + __COPY(name, head->name, ((LONGINT)(256))); + *mno = OPT_nofGmod; + head->mnolev = -*mno; + if (OPT_nofGmod < 64) { + OPT_GlbMod[__X(*mno, ((LONGINT)(64)))] = head; + OPT_nofGmod += 1; + } else { + OPT_err(227); + } + } + OPT_impCtxt.glbmno[__X(OPT_impCtxt.nofm, ((LONGINT)(64)))] = *mno; + OPT_impCtxt.nofm += 1; + } else { + *mno = OPT_impCtxt.glbmno[__X(-mn, ((LONGINT)(64)))]; + } + } +} + +static void OPT_InConstant (LONGINT f, OPT_Const conval) +{ + CHAR ch; + INTEGER i; + OPT_ConstExt ext = NIL; + REAL rval; + switch (f) { + case 1: case 3: case 2: + OPM_SymRCh(&ch); + conval->intval = (int)ch; + break; + case 4: case 5: case 6: + conval->intval = OPM_SymRInt(); + break; + case 9: + OPM_SymRSet(&conval->setval); + break; + case 7: + OPM_SymRReal(&rval); + conval->realval = rval; + conval->intval = -1; + break; + case 8: + OPM_SymRLReal(&conval->realval); + conval->intval = -1; + break; + case 10: + ext = OPT_NewExt(); + conval->ext = ext; + i = 0; + do { + OPM_SymRCh(&ch); + (*ext)[__X(i, ((LONGINT)(256)))] = ch; + i += 1; + } while (!(ch == 0x00)); + conval->intval2 = i; + conval->intval = -1; + break; + case 11: + conval->intval = 0; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPT.InConstant(), f = ", (LONGINT)41); + OPM_LogWNum(f, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } +} + +static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par) +{ + OPT_Object last = NIL, new = NIL; + LONGINT tag; + OPT_InStruct(&*res); + tag = OPM_SymRInt(); + last = NIL; + while (tag != 18) { + new = OPT_NewObj(); + new->mnolev = -mno; + if (last == NIL) { + *par = new; + } else { + last->link = new; + } + if (tag == 23) { + new->mode = 1; + } else { + new->mode = 2; + } + OPT_InStruct(&new->typ); + new->adr = OPM_SymRInt(); + OPT_InName((void*)new->name, ((LONGINT)(256))); + last = new; + tag = OPM_SymRInt(); + } +} + +static OPT_Object OPT_InFld (void) +{ + OPT_Object _o_result; + LONGINT tag; + OPT_Object obj = NIL; + tag = OPT_impCtxt.nextTag; + obj = OPT_NewObj(); + if (tag <= 26) { + obj->mode = 4; + if (tag == 26) { + obj->vis = 2; + } else { + obj->vis = 1; + } + OPT_InStruct(&obj->typ); + OPT_InName((void*)obj->name, ((LONGINT)(256))); + obj->adr = OPM_SymRInt(); + } else { + obj->mode = 4; + if (tag == 27) { + __MOVE("@ptr", obj->name, 5); + } else { + __MOVE("@proc", obj->name, 6); + } + obj->typ = OPT_undftyp; + obj->vis = 0; + obj->adr = OPM_SymRInt(); + } + _o_result = obj; + return _o_result; +} + +static OPT_Object OPT_InTProc (SHORTINT mno) +{ + OPT_Object _o_result; + LONGINT tag; + OPT_Object obj = NIL; + tag = OPT_impCtxt.nextTag; + obj = OPT_NewObj(); + obj->mnolev = -mno; + if (tag == 29) { + obj->mode = 13; + obj->conval = OPT_NewConst(); + obj->conval->intval = -1; + OPT_InSign(mno, &obj->typ, &obj->link); + obj->vis = 1; + OPT_InName((void*)obj->name, ((LONGINT)(256))); + obj->adr = __ASHL(OPM_SymRInt(), 16); + } else { + obj->mode = 13; + __MOVE("@tproc", obj->name, 7); + obj->link = OPT_NewObj(); + obj->typ = OPT_undftyp; + obj->vis = 0; + obj->adr = __ASHL(OPM_SymRInt(), 16); + } + _o_result = obj; + return _o_result; +} + +static void OPT_InStruct (OPT_Struct *typ) +{ + SHORTINT mno; + INTEGER ref; + LONGINT tag; + OPS_Name name; + OPT_Struct t = NIL; + OPT_Object obj = NIL, last = NIL, fld = NIL, old = NIL, dummy = NIL; + tag = OPM_SymRInt(); + if (tag != 34) { + *typ = OPT_impCtxt.ref[__X(-tag, ((LONGINT)(255)))]; + } else { + ref = OPT_impCtxt.nofr; + OPT_impCtxt.nofr += 1; + if (ref < OPT_impCtxt.minr) { + OPT_impCtxt.minr = ref; + } + OPT_InMod(&mno); + OPT_InName((void*)name, ((LONGINT)(256))); + obj = OPT_NewObj(); + if (name[0] == 0x00) { + if (OPT_impCtxt.self) { + old = NIL; + } else { + __MOVE("@", obj->name, 2); + OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old); + obj->name[0] = 0x00; + } + *typ = OPT_NewStr(0, 1); + } else { + __COPY(name, obj->name, ((LONGINT)(256))); + OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old); + if (old != NIL) { + OPT_FPrintObj(old); + OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] = old->typ->pvfp; + if (OPT_impCtxt.self) { + *typ = OPT_NewStr(0, 1); + } else { + *typ = old->typ; + (*typ)->link = NIL; + (*typ)->sysflag = 0; + (*typ)->fpdone = 0; + (*typ)->idfpdone = 0; + } + } else { + *typ = OPT_NewStr(0, 1); + } + } + OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))] = *typ; + OPT_impCtxt.old[__X(ref, ((LONGINT)(255)))] = old; + (*typ)->ref = ref + 255; + (*typ)->mno = mno; + (*typ)->allocated = 1; + (*typ)->strobj = obj; + obj->mode = 5; + obj->typ = *typ; + obj->mnolev = -mno; + obj->vis = 0; + tag = OPM_SymRInt(); + if (tag == 35) { + (*typ)->sysflag = (int)OPM_SymRInt(); + tag = OPM_SymRInt(); + } + switch (tag) { + case 36: + (*typ)->form = 13; + (*typ)->size = OPM_PointerSize; + (*typ)->n = 0; + OPT_InStruct(&(*typ)->BaseTyp); + break; + case 37: + (*typ)->form = 15; + (*typ)->comp = 2; + OPT_InStruct(&(*typ)->BaseTyp); + (*typ)->n = OPM_SymRInt(); + (*OPT_typSize)(*typ); + break; + case 38: + (*typ)->form = 15; + (*typ)->comp = 3; + OPT_InStruct(&(*typ)->BaseTyp); + if ((*typ)->BaseTyp->comp == 3) { + (*typ)->n = (*typ)->BaseTyp->n + 1; + } else { + (*typ)->n = 0; + } + (*OPT_typSize)(*typ); + break; + case 39: + (*typ)->form = 15; + (*typ)->comp = 4; + OPT_InStruct(&(*typ)->BaseTyp); + if ((*typ)->BaseTyp == OPT_notyp) { + (*typ)->BaseTyp = NIL; + } + (*typ)->extlev = 0; + t = (*typ)->BaseTyp; + while (t != NIL) { + (*typ)->extlev += 1; + t = t->BaseTyp; + } + (*typ)->size = OPM_SymRInt(); + (*typ)->align = OPM_SymRInt(); + (*typ)->n = OPM_SymRInt(); + OPT_impCtxt.nextTag = OPM_SymRInt(); + last = NIL; + while ((OPT_impCtxt.nextTag >= 25 && OPT_impCtxt.nextTag <= 28)) { + fld = OPT_InFld(); + fld->mnolev = -mno; + if (last != NIL) { + last->link = fld; + } + last = fld; + OPT_InsertImport(fld, &(*typ)->link, &dummy); + OPT_impCtxt.nextTag = OPM_SymRInt(); + } + while (OPT_impCtxt.nextTag != 18) { + fld = OPT_InTProc(mno); + OPT_InsertImport(fld, &(*typ)->link, &dummy); + OPT_impCtxt.nextTag = OPM_SymRInt(); + } + break; + case 40: + (*typ)->form = 14; + (*typ)->size = OPM_ProcSize; + OPT_InSign(mno, &(*typ)->BaseTyp, &(*typ)->link); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.InStruct, tag = ", (LONGINT)39); + OPM_LogWNum(tag, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + if (ref == OPT_impCtxt.minr) { + while (ref < OPT_impCtxt.nofr) { + t = OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))]; + OPT_FPrintStr(t); + obj = t->strobj; + if (obj->name[0] != 0x00) { + OPT_FPrintObj(obj); + } + old = OPT_impCtxt.old[__X(ref, ((LONGINT)(255)))]; + if (old != NIL) { + t->strobj = old; + if (OPT_impCtxt.self) { + if (old->mnolev < 0) { + if (old->history != 5) { + if (old->fprint != obj->fprint) { + old->history = 2; + } else if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) { + old->history = 3; + } + } + } else if (old->fprint != obj->fprint) { + old->history = 2; + } else if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) { + old->history = 3; + } else if (old->vis == 0) { + old->history = 1; + } else { + old->history = 0; + } + } else { + if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) { + old->history = 5; + } + if (old->fprint != obj->fprint) { + OPT_FPrintErr(old, 249); + } + } + } else if (OPT_impCtxt.self) { + obj->history = 4; + } else { + obj->history = 1; + } + ref += 1; + } + OPT_impCtxt.minr = 255; + } + } +} + +static OPT_Object OPT_InObj (SHORTINT mno) +{ + OPT_Object _o_result; + INTEGER i, s; + CHAR ch; + OPT_Object obj = NIL, old = NIL; + OPT_Struct typ = NIL; + LONGINT tag; + OPT_ConstExt ext = NIL; + tag = OPT_impCtxt.nextTag; + if (tag == 19) { + OPT_InStruct(&typ); + obj = typ->strobj; + if (!OPT_impCtxt.self) { + obj->vis = 1; + } + } else { + obj = OPT_NewObj(); + obj->mnolev = -mno; + obj->vis = 1; + if (tag <= 13) { + obj->mode = 3; + obj->typ = OPT_impCtxt.ref[__X(tag, ((LONGINT)(255)))]; + obj->conval = OPT_NewConst(); + OPT_InConstant(tag, obj->conval); + } else if (tag >= 31) { + obj->conval = OPT_NewConst(); + obj->conval->intval = -1; + OPT_InSign(mno, &obj->typ, &obj->link); + switch (tag) { + case 31: + obj->mode = 7; + break; + case 32: + obj->mode = 10; + break; + case 33: + obj->mode = 9; + ext = OPT_NewExt(); + obj->conval->ext = ext; + s = (int)OPM_SymRInt(); + (*ext)[0] = (CHAR)s; + i = 1; + while (i <= s) { + OPM_SymRCh(&(*ext)[__X(i, ((LONGINT)(256)))]); + i += 1; + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.InObj, tag = ", (LONGINT)36); + OPM_LogWNum(tag, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } else if (tag == 20) { + obj->mode = 5; + OPT_InStruct(&obj->typ); + } else { + obj->mode = 1; + if (tag == 22) { + obj->vis = 2; + } + OPT_InStruct(&obj->typ); + } + OPT_InName((void*)obj->name, ((LONGINT)(256))); + } + OPT_FPrintObj(obj); + if ((obj->mode == 1 && (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00))) { + OPM_FPrint(&OPT_impCtxt.reffp, obj->typ->ref - 255); + } + if (tag != 19) { + OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old); + if (OPT_impCtxt.self) { + if (old != NIL) { + if (old->vis == 0) { + old->history = 4; + } else { + OPT_FPrintObj(old); + if (obj->fprint != old->fprint) { + old->history = 2; + } else if (obj->typ->pvfp != old->typ->pvfp) { + old->history = 3; + } else { + old->history = 1; + } + } + } else { + obj->history = 4; + } + } + } else { + if (OPT_impCtxt.self) { + if (obj->vis == 0) { + obj->history = 4; + } else if (obj->history == 0) { + obj->history = 1; + } + } + } + _o_result = obj; + return _o_result; +} + +void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done) +{ + OPT_Object obj = NIL; + SHORTINT mno; + OPS_Name aliasName__copy; + __DUPARR(aliasName, OPS_Name); + if (__STRCMP(name, "SYSTEM") == 0) { + OPT_SYSimported = 1; + OPT_Insert(aliasName, &obj); + obj->mode = 11; + obj->mnolev = 0; + obj->scope = OPT_syslink; + obj->typ = OPT_notyp; + } else { + OPT_impCtxt.nofr = 16; + OPT_impCtxt.minr = 255; + OPT_impCtxt.nofm = 0; + OPT_impCtxt.self = __STRCMP(aliasName, "@self") == 0; + OPT_impCtxt.reffp = 0; + OPM_OldSym((void*)name, ((LONGINT)(256)), &*done); + if (*done) { + OPT_InMod(&mno); + OPT_impCtxt.nextTag = OPM_SymRInt(); + while (!OPM_eofSF()) { + obj = OPT_InObj(mno); + OPT_impCtxt.nextTag = OPM_SymRInt(); + } + OPT_Insert(aliasName, &obj); + obj->mode = 11; + obj->scope = OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right; + OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->link = obj; + obj->mnolev = -mno; + obj->typ = OPT_notyp; + OPM_CloseOldSym(); + } else if (OPT_impCtxt.self) { + OPT_newsf = 1; + OPT_extsf = 1; + OPT_sfpresent = 0; + } else { + OPT_err(152); + } + } +} + +static void OPT_OutName (CHAR *name, LONGINT name__len) +{ + INTEGER i; + CHAR ch; + i = 0; + do { + ch = name[__X(i, name__len)]; + OPM_SymWCh(ch); + i += 1; + } while (!(ch == 0x00)); +} + +static void OPT_OutMod (INTEGER mno) +{ + if (OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))] < 0) { + OPM_SymWInt(((LONGINT)(16))); + OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))] = OPT_expCtxt.nofm; + OPT_expCtxt.nofm += 1; + OPT_OutName((void*)OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + } else { + OPM_SymWInt(-OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))]); + } +} + +static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr) +{ + LONGINT i, j, n; + OPT_Struct btyp = NIL; + if (typ->comp == 4) { + OPT_OutFlds(typ->link, adr, 0); + } else if (typ->comp == 2) { + btyp = typ->BaseTyp; + n = typ->n; + while (btyp->comp == 2) { + n = btyp->n * n; + btyp = btyp->BaseTyp; + } + if (btyp->form == 13 || btyp->comp == 4) { + j = OPT_nofhdfld; + OPT_OutHdFld(btyp, fld, adr); + if (j != OPT_nofhdfld) { + i = 1; + while ((i < n && OPT_nofhdfld <= 2048)) { + adr += btyp->size; + OPT_OutHdFld(btyp, fld, adr); + i += 1; + } + } + } + } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) { + OPM_SymWInt(((LONGINT)(27))); + OPM_SymWInt(adr); + OPT_nofhdfld += 1; + } +} + +static void OPT_OutFlds (OPT_Object fld, LONGINT adr, BOOLEAN visible) +{ + while ((fld != NIL && fld->mode == 4)) { + if ((fld->vis != 0 && visible)) { + if (fld->vis == 2) { + OPM_SymWInt(((LONGINT)(26))); + } else { + OPM_SymWInt(((LONGINT)(25))); + } + OPT_OutStr(fld->typ); + OPT_OutName((void*)fld->name, ((LONGINT)(256))); + OPM_SymWInt(fld->adr); + } else { + OPT_OutHdFld(fld->typ, fld, fld->adr + adr); + } + fld = fld->link; + } +} + +static void OPT_OutSign (OPT_Struct result, OPT_Object par) +{ + OPT_OutStr(result); + while (par != NIL) { + if (par->mode == 1) { + OPM_SymWInt(((LONGINT)(23))); + } else { + OPM_SymWInt(((LONGINT)(24))); + } + OPT_OutStr(par->typ); + OPM_SymWInt(par->adr); + OPT_OutName((void*)par->name, ((LONGINT)(256))); + par = par->link; + } + OPM_SymWInt(((LONGINT)(18))); +} + +static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj) +{ + if (obj != NIL) { + OPT_OutTProcs(typ, obj->left); + if (obj->mode == 13) { + if ((((typ->BaseTyp != NIL && __ASHR(obj->adr, 16) < typ->BaseTyp->n)) && obj->vis == 0)) { + OPM_Mark(109, typ->txtpos); + } + if (obj->vis != 0) { + if (obj->vis != 0) { + OPM_SymWInt(((LONGINT)(29))); + OPT_OutSign(obj->typ, obj->link); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + OPM_SymWInt(__ASHR(obj->adr, 16)); + } else { + OPM_SymWInt(((LONGINT)(30))); + OPM_SymWInt(__ASHR(obj->adr, 16)); + } + } + } + OPT_OutTProcs(typ, obj->right); + } +} + +static void OPT_OutStr (OPT_Struct typ) +{ + OPT_Object strobj = NIL; + if (typ->ref < OPT_expCtxt.ref) { + OPM_SymWInt(-typ->ref); + } else { + OPM_SymWInt(((LONGINT)(34))); + typ->ref = OPT_expCtxt.ref; + OPT_expCtxt.ref += 1; + if (OPT_expCtxt.ref >= 255) { + OPT_err(228); + } + OPT_OutMod(typ->mno); + strobj = typ->strobj; + if ((strobj != NIL && strobj->name[0] != 0x00)) { + OPT_OutName((void*)strobj->name, ((LONGINT)(256))); + switch (strobj->history) { + case 2: + OPT_FPrintErr(strobj, 252); + break; + case 3: + OPT_FPrintErr(strobj, 251); + break; + case 5: + OPT_FPrintErr(strobj, 249); + break; + default: + break; + } + } else { + OPM_SymWCh(0x00); + } + if (typ->sysflag != 0) { + OPM_SymWInt(((LONGINT)(35))); + OPM_SymWInt(typ->sysflag); + } + switch (typ->form) { + case 13: + OPM_SymWInt(((LONGINT)(36))); + OPT_OutStr(typ->BaseTyp); + break; + case 14: + OPM_SymWInt(((LONGINT)(40))); + OPT_OutSign(typ->BaseTyp, typ->link); + break; + case 15: + switch (typ->comp) { + case 2: + OPM_SymWInt(((LONGINT)(37))); + OPT_OutStr(typ->BaseTyp); + OPM_SymWInt(typ->n); + break; + case 3: + OPM_SymWInt(((LONGINT)(38))); + OPT_OutStr(typ->BaseTyp); + break; + case 4: + OPM_SymWInt(((LONGINT)(39))); + if (typ->BaseTyp == NIL) { + OPT_OutStr(OPT_notyp); + } else { + OPT_OutStr(typ->BaseTyp); + } + OPM_SymWInt(typ->size); + OPM_SymWInt(typ->align); + OPM_SymWInt(typ->n); + OPT_nofhdfld = 0; + OPT_OutFlds(typ->link, ((LONGINT)(0)), 1); + if (OPT_nofhdfld > 2048) { + OPM_Mark(223, typ->txtpos); + } + OPT_OutTProcs(typ, typ->link); + OPM_SymWInt(((LONGINT)(18))); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.OutStr, typ^.comp = ", (LONGINT)43); + OPM_LogWNum(typ->comp, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.OutStr, typ^.form = ", (LONGINT)43); + OPM_LogWNum(typ->form, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } +} + +static void OPT_OutConstant (OPT_Object obj) +{ + INTEGER f; + REAL rval; + f = obj->typ->form; + OPM_SymWInt(f); + switch (f) { + case 2: case 3: + OPM_SymWCh((CHAR)obj->conval->intval); + break; + case 4: case 5: case 6: + OPM_SymWInt(obj->conval->intval); + break; + case 9: + OPM_SymWSet(obj->conval->setval); + break; + case 7: + rval = obj->conval->realval; + OPM_SymWReal(rval); + break; + case 8: + OPM_SymWLReal(obj->conval->realval); + break; + case 10: + OPT_OutName((void*)*obj->conval->ext, ((LONGINT)(256))); + break; + case 11: + break; + default: + OPT_err(127); + break; + } +} + +static void OPT_OutObj (OPT_Object obj) +{ + INTEGER i, j; + OPT_ConstExt ext = NIL; + if (obj != NIL) { + OPT_OutObj(obj->left); + if (__IN(obj->mode, 0x06ea)) { + if (obj->history == 4) { + OPT_FPrintErr(obj, 250); + } else if (obj->vis != 0) { + switch (obj->history) { + case 0: + OPT_FPrintErr(obj, 253); + break; + case 1: + break; + case 2: + OPT_FPrintErr(obj, 252); + break; + case 3: + OPT_FPrintErr(obj, 251); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.OutObj, obj^.history = ", (LONGINT)46); + OPM_LogWNum(obj->history, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + switch (obj->mode) { + case 3: + OPT_OutConstant(obj); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + break; + case 5: + if (obj->typ->strobj == obj) { + OPM_SymWInt(((LONGINT)(19))); + OPT_OutStr(obj->typ); + } else { + OPM_SymWInt(((LONGINT)(20))); + OPT_OutStr(obj->typ); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + } + break; + case 1: + if (obj->vis == 2) { + OPM_SymWInt(((LONGINT)(22))); + } else { + OPM_SymWInt(((LONGINT)(21))); + } + OPT_OutStr(obj->typ); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + if (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00) { + OPM_FPrint(&OPT_expCtxt.reffp, obj->typ->ref); + } + break; + case 7: + OPM_SymWInt(((LONGINT)(31))); + OPT_OutSign(obj->typ, obj->link); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + break; + case 10: + OPM_SymWInt(((LONGINT)(32))); + OPT_OutSign(obj->typ, obj->link); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + break; + case 9: + OPM_SymWInt(((LONGINT)(33))); + OPT_OutSign(obj->typ, obj->link); + ext = obj->conval->ext; + j = (int)(*ext)[0]; + i = 1; + OPM_SymWInt(j); + while (i <= j) { + OPM_SymWCh((*ext)[__X(i, ((LONGINT)(256)))]); + i += 1; + } + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.OutObj, obj.mode = ", (LONGINT)42); + OPM_LogWNum(obj->mode, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } + } + OPT_OutObj(obj->right); + } +} + +void OPT_Export (BOOLEAN *ext, BOOLEAN *new) +{ + INTEGER i; + SHORTINT nofmod; + BOOLEAN done; + OPT_symExtended = 0; + OPT_symNew = 0; + nofmod = OPT_nofGmod; + OPT_Import((CHAR*)"@self", OPT_SelfName, &done); + OPT_nofGmod = nofmod; + if (OPM_noerr) { + OPM_NewSym((void*)OPT_SelfName, ((LONGINT)(256))); + if (OPM_noerr) { + OPM_SymWInt(((LONGINT)(16))); + OPT_OutName((void*)OPT_SelfName, ((LONGINT)(256))); + OPT_expCtxt.reffp = 0; + OPT_expCtxt.ref = 16; + OPT_expCtxt.nofm = 1; + OPT_expCtxt.locmno[0] = 0; + i = 1; + while (i < 64) { + OPT_expCtxt.locmno[__X(i, ((LONGINT)(64)))] = -1; + i += 1; + } + OPT_OutObj(OPT_topScope->right); + *ext = (OPT_sfpresent && OPT_symExtended); + *new = !OPT_sfpresent || OPT_symNew; + if (OPM_forceNewSym) { + *new = 1; + } + if ((((OPM_noerr && OPT_sfpresent)) && OPT_impCtxt.reffp != OPT_expCtxt.reffp)) { + *new = 1; + if (!OPT_extsf) { + OPT_err(155); + } + } + OPT_newsf = 0; + OPT_symNew = 0; + if (!OPM_noerr || OPT_findpc) { + OPM_DeleteNewSym(); + } + } + } +} + +static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form) +{ + *typ = OPT_NewStr(form, 1); + (*typ)->ref = form; + (*typ)->size = OPM_ByteSize; + (*typ)->allocated = 1; + (*typ)->strobj = OPT_NewObj(); + (*typ)->pbfp = form; + (*typ)->pvfp = form; + (*typ)->fpdone = 1; + (*typ)->idfp = form; + (*typ)->idfpdone = 1; +} + +static void OPT_EnterBoolConst (OPS_Name name, LONGINT value) +{ + OPT_Object obj = NIL; + OPS_Name name__copy; + __DUPARR(name, OPS_Name); + OPT_Insert(name, &obj); + obj->conval = OPT_NewConst(); + obj->mode = 3; + obj->typ = OPT_booltyp; + obj->conval->intval = value; +} + +static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res) +{ + OPT_Object obj = NIL; + OPT_Struct typ = NIL; + OPS_Name name__copy; + __DUPARR(name, OPS_Name); + OPT_Insert(name, &obj); + typ = OPT_NewStr(form, 1); + obj->mode = 5; + obj->typ = typ; + obj->vis = 1; + typ->strobj = obj; + typ->size = size; + typ->ref = form; + typ->allocated = 1; + typ->pbfp = form; + typ->pvfp = form; + typ->fpdone = 1; + typ->idfp = form; + typ->idfpdone = 1; + *res = typ; +} + +static void OPT_EnterProc (OPS_Name name, INTEGER num) +{ + OPT_Object obj = NIL; + OPS_Name name__copy; + __DUPARR(name, OPS_Name); + OPT_Insert(name, &obj); + obj->mode = 8; + obj->typ = OPT_notyp; + obj->adr = num; +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(OPT_topScope); + P(OPT_undftyp); + P(OPT_bytetyp); + P(OPT_booltyp); + P(OPT_chartyp); + P(OPT_sinttyp); + P(OPT_inttyp); + P(OPT_linttyp); + P(OPT_realtyp); + P(OPT_lrltyp); + P(OPT_settyp); + P(OPT_stringtyp); + P(OPT_niltyp); + P(OPT_notyp); + P(OPT_sysptrtyp); + __ENUMP(OPT_GlbMod, 64, P); + P(OPT_universe); + P(OPT_syslink); + __ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 3140, 1, P); +} + +__TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 24), {0, -8}}; +__TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 304), {0, 4, 8, 12, 284, 288, -28}}; +__TDESC(OPT_StrDesc, 1, 3) = {__TDFLDS("StrDesc", 56), {44, 48, 52, -16}}; +__TDESC(OPT_NodeDesc, 1, 6) = {__TDFLDS("NodeDesc", 28), {0, 4, 8, 16, 20, 24, -28}}; +__TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 3140), {16, 20, 24, 28, 32, 36, 40, 44, 48, 52, 56, 60, 64, 68, 72, 76, + 80, 84, 88, 92, 96, 100, 104, 108, 112, 116, 120, 124, 128, 132, 136, 140, + 144, 148, 152, 156, 160, 164, 168, 172, 176, 180, 184, 188, 192, 196, 200, 204, + 208, 212, 216, 220, 224, 228, 232, 236, 240, 244, 248, 252, 256, 260, 264, 268, + 272, 276, 280, 284, 288, 292, 296, 300, 304, 308, 312, 316, 320, 324, 328, 332, + 336, 340, 344, 348, 352, 356, 360, 364, 368, 372, 376, 380, 384, 388, 392, 396, + 400, 404, 408, 412, 416, 420, 424, 428, 432, 436, 440, 444, 448, 452, 456, 460, + 464, 468, 472, 476, 480, 484, 488, 492, 496, 500, 504, 508, 512, 516, 520, 524, + 528, 532, 536, 540, 544, 548, 552, 556, 560, 564, 568, 572, 576, 580, 584, 588, + 592, 596, 600, 604, 608, 612, 616, 620, 624, 628, 632, 636, 640, 644, 648, 652, + 656, 660, 664, 668, 672, 676, 680, 684, 688, 692, 696, 700, 704, 708, 712, 716, + 720, 724, 728, 732, 736, 740, 744, 748, 752, 756, 760, 764, 768, 772, 776, 780, + 784, 788, 792, 796, 800, 804, 808, 812, 816, 820, 824, 828, 832, 836, 840, 844, + 848, 852, 856, 860, 864, 868, 872, 876, 880, 884, 888, 892, 896, 900, 904, 908, + 912, 916, 920, 924, 928, 932, 936, 940, 944, 948, 952, 956, 960, 964, 968, 972, + 976, 980, 984, 988, 992, 996, 1000, 1004, 1008, 1012, 1016, 1020, 1024, 1028, 1032, 1036, + 1040, 1044, 1048, 1052, 1056, 1060, 1064, 1068, 1072, 1076, 1080, 1084, 1088, 1092, 1096, 1100, + 1104, 1108, 1112, 1116, 1120, 1124, 1128, 1132, 1136, 1140, 1144, 1148, 1152, 1156, 1160, 1164, + 1168, 1172, 1176, 1180, 1184, 1188, 1192, 1196, 1200, 1204, 1208, 1212, 1216, 1220, 1224, 1228, + 1232, 1236, 1240, 1244, 1248, 1252, 1256, 1260, 1264, 1268, 1272, 1276, 1280, 1284, 1288, 1292, + 1296, 1300, 1304, 1308, 1312, 1316, 1320, 1324, 1328, 1332, 1336, 1340, 1344, 1348, 1352, 1356, + 1360, 1364, 1368, 1372, 1376, 1380, 1384, 1388, 1392, 1396, 1400, 1404, 1408, 1412, 1416, 1420, + 1424, 1428, 1432, 1436, 1440, 1444, 1448, 1452, 1456, 1460, 1464, 1468, 1472, 1476, 1480, 1484, + 1488, 1492, 1496, 1500, 1504, 1508, 1512, 1516, 1520, 1524, 1528, 1532, 1536, 1540, 1544, 1548, + 1552, 1556, 1560, 1564, 1568, 1572, 1576, 1580, 1584, 1588, 1592, 1596, 1600, 1604, 1608, 1612, + 1616, 1620, 1624, 1628, 1632, 1636, 1640, 1644, 1648, 1652, 1656, 1660, 1664, 1668, 1672, 1676, + 1680, 1684, 1688, 1692, 1696, 1700, 1704, 1708, 1712, 1716, 1720, 1724, 1728, 1732, 1736, 1740, + 1744, 1748, 1752, 1756, 1760, 1764, 1768, 1772, 1776, 1780, 1784, 1788, 1792, 1796, 1800, 1804, + 1808, 1812, 1816, 1820, 1824, 1828, 1832, 1836, 1840, 1844, 1848, 1852, 1856, 1860, 1864, 1868, + 1872, 1876, 1880, 1884, 1888, 1892, 1896, 1900, 1904, 1908, 1912, 1916, 1920, 1924, 1928, 1932, + 1936, 1940, 1944, 1948, 1952, 1956, 1960, 1964, 1968, 1972, 1976, 1980, 1984, 1988, 1992, 1996, + 2000, 2004, 2008, 2012, 2016, 2020, 2024, 2028, 2032, 2036, 2040, 2044, 2048, 2052, -2044}}; +__TDESC(OPT_ExpCtxt, 1, 0) = {__TDFLDS("ExpCtxt", 72), {-4}}; + +export void *OPT__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPS); + __REGMOD("OPT", EnumPtrs); + __REGCMD("Close", OPT_Close); + __REGCMD("CloseScope", OPT_CloseScope); + __INITYP(OPT_ConstDesc, OPT_ConstDesc, 0); + __INITYP(OPT_ObjDesc, OPT_ObjDesc, 0); + __INITYP(OPT_StrDesc, OPT_StrDesc, 0); + __INITYP(OPT_NodeDesc, OPT_NodeDesc, 0); + __INITYP(OPT_ImpCtxt, OPT_ImpCtxt, 0); + __INITYP(OPT_ExpCtxt, OPT_ExpCtxt, 0); +/* BEGIN */ + OPT_topScope = NIL; + OPT_OpenScope(0, NIL); + OPM_errpos = 0; + OPT_InitStruct(&OPT_undftyp, 0); + OPT_InitStruct(&OPT_notyp, 12); + OPT_InitStruct(&OPT_stringtyp, 10); + OPT_InitStruct(&OPT_niltyp, 11); + OPT_undftyp->BaseTyp = OPT_undftyp; + OPT_EnterTyp((CHAR*)"BYTE", 1, OPM_ByteSize, &OPT_bytetyp); + OPT_EnterTyp((CHAR*)"PTR", 13, OPM_PointerSize, &OPT_sysptrtyp); + OPT_EnterProc((CHAR*)"ADR", 20); + OPT_EnterProc((CHAR*)"CC", 21); + OPT_EnterProc((CHAR*)"LSH", 22); + OPT_EnterProc((CHAR*)"ROT", 23); + OPT_EnterProc((CHAR*)"GET", 24); + OPT_EnterProc((CHAR*)"PUT", 25); + OPT_EnterProc((CHAR*)"GETREG", 26); + OPT_EnterProc((CHAR*)"PUTREG", 27); + OPT_EnterProc((CHAR*)"BIT", 28); + OPT_EnterProc((CHAR*)"VAL", 29); + OPT_EnterProc((CHAR*)"NEW", 30); + OPT_EnterProc((CHAR*)"MOVE", 31); + OPT_syslink = OPT_topScope->right; + OPT_universe = OPT_topScope; + OPT_topScope->right = NIL; + OPT_EnterTyp((CHAR*)"CHAR", 3, OPM_CharSize, &OPT_chartyp); + OPT_EnterTyp((CHAR*)"SET", 9, OPM_SetSize, &OPT_settyp); + OPT_EnterTyp((CHAR*)"REAL", 7, OPM_RealSize, &OPT_realtyp); + OPT_EnterTyp((CHAR*)"INTEGER", 5, OPM_IntSize, &OPT_inttyp); + OPT_EnterTyp((CHAR*)"LONGINT", 6, OPM_LIntSize, &OPT_linttyp); + OPT_EnterTyp((CHAR*)"LONGREAL", 8, OPM_LRealSize, &OPT_lrltyp); + OPT_EnterTyp((CHAR*)"SHORTINT", 4, OPM_SIntSize, &OPT_sinttyp); + OPT_EnterTyp((CHAR*)"BOOLEAN", 2, OPM_BoolSize, &OPT_booltyp); + OPT_EnterBoolConst((CHAR*)"FALSE", ((LONGINT)(0))); + OPT_EnterBoolConst((CHAR*)"TRUE", ((LONGINT)(1))); + OPT_EnterProc((CHAR*)"HALT", 0); + OPT_EnterProc((CHAR*)"NEW", 1); + OPT_EnterProc((CHAR*)"ABS", 2); + OPT_EnterProc((CHAR*)"CAP", 3); + OPT_EnterProc((CHAR*)"ORD", 4); + OPT_EnterProc((CHAR*)"ENTIER", 5); + OPT_EnterProc((CHAR*)"ODD", 6); + OPT_EnterProc((CHAR*)"MIN", 7); + OPT_EnterProc((CHAR*)"MAX", 8); + OPT_EnterProc((CHAR*)"CHR", 9); + OPT_EnterProc((CHAR*)"SHORT", 10); + OPT_EnterProc((CHAR*)"LONG", 11); + OPT_EnterProc((CHAR*)"SIZE", 12); + OPT_EnterProc((CHAR*)"INC", 13); + OPT_EnterProc((CHAR*)"DEC", 14); + OPT_EnterProc((CHAR*)"INCL", 15); + OPT_EnterProc((CHAR*)"EXCL", 16); + OPT_EnterProc((CHAR*)"LEN", 17); + OPT_EnterProc((CHAR*)"COPY", 18); + OPT_EnterProc((CHAR*)"ASH", 19); + OPT_EnterProc((CHAR*)"ASSERT", 32); + OPT_impCtxt.ref[0] = OPT_undftyp; + OPT_impCtxt.ref[1] = OPT_bytetyp; + OPT_impCtxt.ref[2] = OPT_booltyp; + OPT_impCtxt.ref[3] = OPT_chartyp; + OPT_impCtxt.ref[4] = OPT_sinttyp; + OPT_impCtxt.ref[5] = OPT_inttyp; + OPT_impCtxt.ref[6] = OPT_linttyp; + OPT_impCtxt.ref[7] = OPT_realtyp; + OPT_impCtxt.ref[8] = OPT_lrltyp; + OPT_impCtxt.ref[9] = OPT_settyp; + OPT_impCtxt.ref[10] = OPT_stringtyp; + OPT_impCtxt.ref[11] = OPT_niltyp; + OPT_impCtxt.ref[12] = OPT_notyp; + OPT_impCtxt.ref[13] = OPT_sysptrtyp; + __ENDMOD; +} diff --git a/bootstrap/windows-48/OPT.h b/bootstrap/windows-48/OPT.h new file mode 100644 index 00000000..1a22d0df --- /dev/null +++ b/bootstrap/windows-48/OPT.h @@ -0,0 +1,105 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPT__h +#define OPT__h + +#include "SYSTEM.h" +#include "OPS.h" + +typedef + struct OPT_ConstDesc *OPT_Const; + +typedef + OPS_String *OPT_ConstExt; + +typedef + struct OPT_ConstDesc { + OPT_ConstExt ext; + LONGINT intval, intval2; + SET setval; + LONGREAL realval; + } OPT_ConstDesc; + +typedef + struct OPT_NodeDesc *OPT_Node; + +typedef + struct OPT_StrDesc *OPT_Struct; + +typedef + struct OPT_ObjDesc *OPT_Object; + +typedef + struct OPT_NodeDesc { + OPT_Node left, right, link; + SHORTINT class, subcl; + BOOLEAN readonly; + OPT_Struct typ; + OPT_Object obj; + OPT_Const conval; + } OPT_NodeDesc; + +typedef + struct OPT_ObjDesc { + OPT_Object left, right, link, scope; + OPS_Name name; + BOOLEAN leaf; + SHORTINT mode, mnolev, vis, history; + BOOLEAN used, fpdone; + LONGINT fprint; + OPT_Struct typ; + OPT_Const conval; + LONGINT adr, linkadr; + INTEGER x; + } OPT_ObjDesc; + +typedef + struct OPT_StrDesc { + SHORTINT form, comp, mno, extlev; + INTEGER ref, sysflag; + LONGINT n, size, align, txtpos; + BOOLEAN allocated, pbused, pvused; + char _prvt0[8]; + LONGINT pbfp, pvfp; + OPT_Struct BaseTyp; + OPT_Object link, strobj; + } OPT_StrDesc; + + +import void (*OPT_typSize)(OPT_Struct); +import OPT_Object OPT_topScope; +import OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp; +import SHORTINT OPT_nofGmod; +import OPT_Object OPT_GlbMod[64]; +import OPS_Name OPT_SelfName; +import BOOLEAN OPT_SYSimported; + +import LONGINT *OPT_ConstDesc__typ; +import LONGINT *OPT_ObjDesc__typ; +import LONGINT *OPT_StrDesc__typ; +import LONGINT *OPT_NodeDesc__typ; + +import void OPT_Close (void); +import void OPT_CloseScope (void); +import void OPT_Export (BOOLEAN *ext, BOOLEAN *new); +import void OPT_FPrintErr (OPT_Object obj, INTEGER errcode); +import void OPT_FPrintObj (OPT_Object obj); +import void OPT_FPrintStr (OPT_Struct typ); +import void OPT_Find (OPT_Object *res); +import void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res); +import void OPT_FindImport (OPT_Object mod, OPT_Object *res); +import void OPT_IdFPrint (OPT_Struct typ); +import void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done); +import void OPT_Init (OPS_Name name, SET opt); +import void OPT_Insert (OPS_Name name, OPT_Object *obj); +import void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old); +import OPT_Const OPT_NewConst (void); +import OPT_ConstExt OPT_NewExt (void); +import OPT_Node OPT_NewNode (SHORTINT class); +import OPT_Object OPT_NewObj (void); +import OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp); +import void OPT_OpenScope (SHORTINT level, OPT_Object owner); +import void *OPT__init(void); + + +#endif diff --git a/bootstrap/windows-48/OPV.c b/bootstrap/windows-48/OPV.c new file mode 100644 index 00000000..572285dc --- /dev/null +++ b/bootstrap/windows-48/OPV.c @@ -0,0 +1,1688 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "OPC.h" +#include "OPM.h" +#include "OPS.h" +#include "OPT.h" + +typedef + struct OPV_ExitInfo { + INTEGER level, label; + } OPV_ExitInfo; + + +static BOOLEAN OPV_assert, OPV_inxchk, OPV_mainprog, OPV_ansi; +static INTEGER OPV_stamp; +static LONGINT OPV_recno; +static OPV_ExitInfo OPV_exit; +static INTEGER OPV_nofExitLabels; +static BOOLEAN OPV_naturalAlignment; + +export LONGINT *OPV_ExitInfo__typ; + +static void OPV_ActualPar (OPT_Node n, OPT_Object fp); +export void OPV_AdrAndSize (OPT_Object topScope); +static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc); +static void OPV_Convert (OPT_Node n, INTEGER form, INTEGER prec); +static void OPV_DefineTDescs (OPT_Node n); +static void OPV_Entier (OPT_Node n, INTEGER prec); +static void OPV_GetTProcNum (OPT_Object obj); +static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc); +static BOOLEAN OPV_ImplicitReturn (OPT_Node n); +static void OPV_Index (OPT_Node n, OPT_Node d, INTEGER prec, INTEGER dim); +export void OPV_Init (void); +static void OPV_InitTDescs (OPT_Node n); +static void OPV_Len (OPT_Node n, LONGINT dim); +export void OPV_Module (OPT_Node prog); +static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max); +static void OPV_NewArr (OPT_Node d, OPT_Node x); +static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp); +static BOOLEAN OPV_SideEffects (OPT_Node n); +static void OPV_Stamp (OPS_Name s); +static OPT_Object OPV_SuperProc (OPT_Node n); +static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported); +static void OPV_TraverseRecord (OPT_Struct typ); +export void OPV_TypSize (OPT_Struct typ); +static void OPV_TypeOf (OPT_Node n); +static void OPV_design (OPT_Node n, INTEGER prec); +static void OPV_expr (OPT_Node n, INTEGER prec); +static void OPV_stat (OPT_Node n, OPT_Object outerProc); + + +static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max) +{ + LONGINT _o_result; + LONGINT i; + if (size >= max) { + _o_result = max; + return _o_result; + } else { + i = 1; + while (i < size) { + i += i; + } + _o_result = i; + return _o_result; + } + __RETCHK; +} + +void OPV_TypSize (OPT_Struct typ) +{ + INTEGER f, c; + LONGINT offset, size, base, fbase, off0; + OPT_Object fld = NIL; + OPT_Struct btyp = NIL; + if (typ == OPT_undftyp) { + OPM_err(58); + } else if (typ->size == -1) { + f = typ->form; + c = typ->comp; + if (c == 4) { + btyp = typ->BaseTyp; + if (btyp == NIL) { + offset = 0; + base = OPM_RecAlign; + } else { + OPV_TypSize(btyp); + offset = btyp->size - (LONGINT)__ASHR(btyp->sysflag, 8); + base = btyp->align; + } + fld = typ->link; + while ((fld != NIL && fld->mode == 4)) { + btyp = fld->typ; + OPV_TypSize(btyp); + size = btyp->size; + fbase = OPC_Base(btyp); + OPC_Align(&offset, fbase); + fld->adr = offset; + offset += size; + if (fbase > base) { + base = fbase; + } + fld = fld->link; + } + off0 = offset; + if (offset == 0) { + offset = 1; + } + if (OPM_RecSize == 0) { + base = OPV_NaturalAlignment(offset, OPM_RecAlign); + } + OPC_Align(&offset, base); + if ((typ->strobj == NIL && __MASK(typ->align, -65536) == 0)) { + OPV_recno += 1; + base += __ASHL(OPV_recno, 16); + } + typ->size = offset; + typ->align = base; + typ->sysflag = __MASK(typ->sysflag, -256) + (int)__ASHL(offset - off0, 8); + } else if (c == 2) { + OPV_TypSize(typ->BaseTyp); + typ->size = typ->n * typ->BaseTyp->size; + } else if (f == 13) { + typ->size = OPM_PointerSize; + if (typ->BaseTyp == OPT_undftyp) { + OPM_Mark(128, typ->n); + } else { + OPV_TypSize(typ->BaseTyp); + } + } else if (f == 14) { + typ->size = OPM_ProcSize; + } else if (c == 3) { + btyp = typ->BaseTyp; + OPV_TypSize(btyp); + if (btyp->comp == 3) { + typ->size = btyp->size + 4; + } else { + typ->size = 8; + } + } + } +} + +void OPV_Init (void) +{ + OPV_stamp = 0; + OPV_recno = 0; + OPV_nofExitLabels = 0; + OPV_assert = __IN(7, OPM_opt); + OPV_inxchk = __IN(0, OPM_opt); + OPV_mainprog = __IN(10, OPM_opt); + OPV_ansi = __IN(6, OPM_opt); +} + +static void OPV_GetTProcNum (OPT_Object obj) +{ + LONGINT oldPos; + OPT_Struct typ = NIL; + OPT_Object redef = NIL; + oldPos = OPM_errpos; + OPM_errpos = obj->scope->adr; + typ = obj->link->typ; + if (typ->form == 13) { + typ = typ->BaseTyp; + } + OPT_FindField(obj->name, typ->BaseTyp, &redef); + if (redef != NIL) { + obj->adr = __ASHL(__ASHR(redef->adr, 16), 16); + if (!__IN(2, obj->conval->setval)) { + OPM_err(119); + } + } else { + obj->adr += __ASHL(typ->n, 16); + typ->n += 1; + } + OPM_errpos = oldPos; +} + +static void OPV_TraverseRecord (OPT_Struct typ) +{ + if (!typ->allocated) { + if (typ->BaseTyp != NIL) { + OPV_TraverseRecord(typ->BaseTyp); + typ->n = typ->BaseTyp->n; + } + typ->allocated = 1; + OPV_Traverse(typ->link, typ->strobj, 0); + } +} + +static void OPV_Stamp (OPS_Name s) +{ + INTEGER i, j, k; + CHAR n[10]; + OPV_stamp += 1; + i = 0; + j = OPV_stamp; + while (s[__X(i, ((LONGINT)(256)))] != 0x00) { + i += 1; + } + if (i > 25) { + i = 25; + } + s[__X(i, ((LONGINT)(256)))] = '_'; + s[__X(i + 1, ((LONGINT)(256)))] = '_'; + i += 2; + k = 0; + do { + n[__X(k, ((LONGINT)(10)))] = (CHAR)((int)__MOD(j, 10) + 48); + j = __DIV(j, 10); + k += 1; + } while (!(j == 0)); + do { + k -= 1; + s[__X(i, ((LONGINT)(256)))] = n[__X(k, ((LONGINT)(10)))]; + i += 1; + } while (!(k == 0)); + s[__X(i, ((LONGINT)(256)))] = 0x00; +} + +static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported) +{ + INTEGER mode; + OPT_Object scope = NIL; + OPT_Struct typ = NIL; + if (obj != NIL) { + OPV_Traverse(obj->left, outerScope, exported); + if (obj->name[0] == '@') { + obj->name[0] = '_'; + OPV_Stamp(obj->name); + } + obj->linkadr = 0; + mode = obj->mode; + if ((mode == 5 && (obj->vis != 0) == exported)) { + typ = obj->typ; + OPV_TypSize(obj->typ); + if (typ->form == 13) { + typ = typ->BaseTyp; + } + if (typ->comp == 4) { + OPV_TraverseRecord(typ); + } + } else if (mode == 13) { + OPV_GetTProcNum(obj); + } else if (mode == 1) { + OPV_TypSize(obj->typ); + } + if (!exported) { + if ((__IN(mode, 0x60) && obj->mnolev > 0)) { + OPV_Stamp(obj->name); + } + if (__IN(mode, 0x26)) { + obj->scope = outerScope; + } else if (__IN(mode, 0x26c0)) { + if (obj->conval->setval == 0x0) { + OPM_err(129); + } + scope = obj->scope; + scope->leaf = 1; + __COPY(obj->name, scope->name, ((LONGINT)(256))); + OPV_Stamp(scope->name); + if (mode == 9) { + obj->adr = 1; + } + if (scope->mnolev > 1) { + outerScope->leaf = 0; + } + OPV_Traverse(obj->scope->right, obj->scope, 0); + } + } + OPV_Traverse(obj->right, outerScope, exported); + } +} + +void OPV_AdrAndSize (OPT_Object topScope) +{ + OPM_errpos = topScope->adr; + topScope->leaf = 1; + OPV_Traverse(topScope->right, topScope, 1); + OPV_Traverse(topScope->right, topScope, 0); + OPT_chartyp->strobj->linkadr = 2; + OPT_settyp->strobj->linkadr = 2; + OPT_realtyp->strobj->linkadr = 2; + OPT_inttyp->strobj->linkadr = 2; + OPT_linttyp->strobj->linkadr = 2; + OPT_lrltyp->strobj->linkadr = 2; + OPT_sinttyp->strobj->linkadr = 2; + OPT_booltyp->strobj->linkadr = 2; + OPT_bytetyp->strobj->linkadr = 2; + OPT_sysptrtyp->strobj->linkadr = 2; +} + +static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp) +{ + INTEGER _o_result; + switch (class) { + case 7: case 0: case 2: case 4: case 9: + case 13: + _o_result = 10; + return _o_result; + break; + case 5: + if (__IN(3, OPM_opt)) { + _o_result = 10; + return _o_result; + } else { + _o_result = 9; + return _o_result; + } + break; + case 1: + if (__IN(comp, 0x0c)) { + _o_result = 10; + return _o_result; + } else { + _o_result = 9; + return _o_result; + } + break; + case 3: + _o_result = 9; + return _o_result; + break; + case 11: + switch (subclass) { + case 33: case 7: case 24: case 29: case 20: + _o_result = 9; + return _o_result; + break; + case 16: case 21: case 22: case 23: case 25: + _o_result = 10; + return _o_result; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence Nmop, subclass = ", (LONGINT)51); + OPM_LogWNum(subclass, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + break; + case 12: + switch (subclass) { + case 1: + if (form == 9) { + _o_result = 4; + return _o_result; + } else { + _o_result = 8; + return _o_result; + } + break; + case 2: + if (form == 9) { + _o_result = 3; + return _o_result; + } else { + _o_result = 8; + return _o_result; + } + break; + case 3: case 4: + _o_result = 10; + return _o_result; + break; + case 6: + if (form == 9) { + _o_result = 2; + return _o_result; + } else { + _o_result = 7; + return _o_result; + } + break; + case 7: + if (form == 9) { + _o_result = 4; + return _o_result; + } else { + _o_result = 7; + return _o_result; + } + break; + case 11: case 12: case 13: case 14: + _o_result = 6; + return _o_result; + break; + case 9: case 10: + _o_result = 5; + return _o_result; + break; + case 5: + _o_result = 1; + return _o_result; + break; + case 8: + _o_result = 0; + return _o_result; + break; + case 19: case 15: case 17: case 18: case 26: + case 27: case 28: + _o_result = 10; + return _o_result; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence Ndop, subclass = ", (LONGINT)51); + OPM_LogWNum(subclass, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + break; + case 10: + _o_result = 10; + return _o_result; + break; + case 8: case 6: + _o_result = 12; + return _o_result; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence, class = ", (LONGINT)43); + OPM_LogWNum(class, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + __RETCHK; +} + +static void OPV_Len (OPT_Node n, LONGINT dim) +{ + while ((n->class == 4 && n->typ->comp == 3)) { + dim += 1; + n = n->left; + } + if ((n->class == 3 && n->typ->comp == 3)) { + OPV_design(n->left, 10); + OPM_WriteString((CHAR*)"->len[", (LONGINT)7); + OPM_WriteInt(dim); + OPM_Write(']'); + } else { + OPC_Len(n->obj, n->typ, dim); + } +} + +static BOOLEAN OPV_SideEffects (OPT_Node n) +{ + BOOLEAN _o_result; + if (n != NIL) { + _o_result = (n->class == 13 || OPV_SideEffects(n->left)) || OPV_SideEffects(n->right); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +static void OPV_Entier (OPT_Node n, INTEGER prec) +{ + if (__IN(n->typ->form, 0x0180)) { + OPM_WriteString((CHAR*)"__ENTIER(", (LONGINT)10); + OPV_expr(n, -1); + OPM_Write(')'); + } else { + OPV_expr(n, prec); + } +} + +static void OPV_Convert (OPT_Node n, INTEGER form, INTEGER prec) +{ + INTEGER from; + from = n->typ->form; + if (form == 9) { + OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9); + OPV_Entier(n, -1); + OPM_Write(')'); + } else if (form == 6) { + if (from < 6) { + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + } + OPV_Entier(n, 9); + } else if (form == 5) { + if (from < 5) { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + OPV_expr(n, 9); + } else { + if (__IN(2, OPM_opt)) { + OPM_WriteString((CHAR*)"__SHORT", (LONGINT)8); + if (OPV_SideEffects(n)) { + OPM_Write('F'); + } + OPM_Write('('); + OPV_Entier(n, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(OPM_MaxInt + 1); + OPM_Write(')'); + } else { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + OPV_Entier(n, 9); + } + } + } else if (form == 4) { + if (__IN(2, OPM_opt)) { + OPM_WriteString((CHAR*)"__SHORT", (LONGINT)8); + if (OPV_SideEffects(n)) { + OPM_Write('F'); + } + OPM_Write('('); + OPV_Entier(n, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(OPM_MaxSInt + 1); + OPM_Write(')'); + } else { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + OPV_Entier(n, 9); + } + } else if (form == 3) { + if (__IN(2, OPM_opt)) { + OPM_WriteString((CHAR*)"__CHR", (LONGINT)6); + if (OPV_SideEffects(n)) { + OPM_Write('F'); + } + OPM_Write('('); + OPV_Entier(n, -1); + OPM_Write(')'); + } else { + OPM_WriteString((CHAR*)"(CHAR)", (LONGINT)7); + OPV_Entier(n, 9); + } + } else { + OPV_expr(n, prec); + } +} + +static void OPV_TypeOf (OPT_Node n) +{ + if (n->typ->form == 13) { + OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10); + OPV_expr(n, -1); + OPM_Write(')'); + } else if (__IN(n->class, 0x15)) { + OPC_Andent(n->typ); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } else if (n->class == 3) { + OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10); + OPV_expr(n->left, -1); + OPM_Write(')'); + } else if (n->class == 5) { + OPV_TypeOf(n->left); + } else if ((n->class == 11 && n->subcl == 29)) { + OPC_TypeOf(n->left->obj); + } else { + OPC_TypeOf(n->obj); + } +} + +static void OPV_Index (OPT_Node n, OPT_Node d, INTEGER prec, INTEGER dim) +{ + if (!OPV_inxchk || (n->right->class == 7 && (n->right->conval->intval == 0 || n->left->typ->comp != 3))) { + OPV_expr(n->right, prec); + } else { + if (OPV_SideEffects(n->right)) { + OPM_WriteString((CHAR*)"__XF(", (LONGINT)6); + } else { + OPM_WriteString((CHAR*)"__X(", (LONGINT)5); + } + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_Len(d, dim); + OPM_Write(')'); + } +} + +static void OPV_design (OPT_Node n, INTEGER prec) +{ + OPT_Object obj = NIL; + OPT_Struct typ = NIL; + INTEGER class, designPrec, comp; + OPT_Node d = NIL, x = NIL; + INTEGER dims, i, _for__26; + comp = n->typ->comp; + obj = n->obj; + class = n->class; + designPrec = OPV_Precedence(class, n->subcl, n->typ->form, comp); + if ((((((class == 0 && obj->mnolev > 0)) && (int)obj->mnolev != OPM_level)) && prec == 10)) { + designPrec = 9; + } + if (prec > designPrec) { + OPM_Write('('); + } + if (prec == 11) { + OPM_Write('*'); + } + switch (class) { + case 9: + OPC_Ident(n->obj); + break; + case 0: + OPC_CompleteIdent(n->obj); + break; + case 1: + if (!__IN(comp, 0x0c)) { + OPM_Write('*'); + } + OPC_CompleteIdent(n->obj); + break; + case 2: + if (n->left->class == 3) { + OPV_design(n->left->left, designPrec); + OPM_WriteString((CHAR*)"->", (LONGINT)3); + } else { + OPV_design(n->left, designPrec); + OPM_Write('.'); + } + OPC_Ident(n->obj); + break; + case 3: + if (n->typ->comp == 3) { + OPV_design(n->left, 10); + OPM_WriteString((CHAR*)"->data", (LONGINT)7); + } else { + OPM_Write('*'); + OPV_design(n->left, designPrec); + } + break; + case 4: + d = n->left; + if (d->typ->comp == 3) { + dims = 0; + while (d->class == 4) { + d = d->left; + dims += 1; + } + if (n->typ->comp == 3) { + OPM_Write('&'); + } + OPV_design(d, designPrec); + OPM_Write('['); + if (n->typ->comp == 3) { + OPM_Write('('); + } + i = dims; + x = n; + while (x != d) { + if (x->left != d) { + OPV_Index(x, d, 7, i); + OPM_WriteString((CHAR*)" + ", (LONGINT)4); + OPV_Len(d, i); + OPM_WriteString((CHAR*)" * (", (LONGINT)5); + i -= 1; + } else { + OPV_Index(x, d, -1, i); + } + x = x->left; + } + _for__26 = dims; + i = 1; + while (i <= _for__26) { + OPM_Write(')'); + i += 1; + } + if (n->typ->comp == 3) { + OPM_Write(')'); + while ((LONGINT)i < __ASHR(d->typ->size - 4, 2)) { + OPM_WriteString((CHAR*)" * ", (LONGINT)4); + OPV_Len(d, i); + i += 1; + } + } + OPM_Write(']'); + } else { + OPV_design(n->left, designPrec); + OPM_Write('['); + OPV_Index(n, n->left, -1, 0); + OPM_Write(']'); + } + break; + case 5: + typ = n->typ; + obj = n->left->obj; + if (__IN(3, OPM_opt)) { + if (typ->comp == 4) { + OPM_WriteString((CHAR*)"__GUARDR(", (LONGINT)10); + if ((int)obj->mnolev != OPM_level) { + OPM_WriteStringVar((void*)obj->scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"__curr->", (LONGINT)9); + OPC_Ident(obj); + } else { + OPC_Ident(obj); + } + } else { + if (typ->BaseTyp->strobj == NIL) { + OPM_WriteString((CHAR*)"__GUARDA(", (LONGINT)10); + } else { + OPM_WriteString((CHAR*)"__GUARDP(", (LONGINT)10); + } + OPV_expr(n->left, -1); + typ = typ->BaseTyp; + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(typ); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(typ->extlev); + OPM_Write(')'); + } else { + if (typ->comp == 4) { + OPM_WriteString((CHAR*)"*(", (LONGINT)3); + OPC_Ident(typ->strobj); + OPM_WriteString((CHAR*)"*)", (LONGINT)3); + OPC_CompleteIdent(obj); + } else { + OPM_Write('('); + OPC_Ident(typ->strobj); + OPM_Write(')'); + OPV_expr(n->left, designPrec); + } + } + break; + case 6: + if (__IN(3, OPM_opt)) { + if (n->left->class == 1) { + OPM_WriteString((CHAR*)"__GUARDEQR(", (LONGINT)12); + OPC_CompleteIdent(n->left->obj); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_TypeOf(n->left); + } else { + OPM_WriteString((CHAR*)"__GUARDEQP(", (LONGINT)12); + OPV_expr(n->left->left, -1); + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(n->left->typ->strobj); + OPM_Write(')'); + } else { + OPV_expr(n->left, -1); + } + break; + case 11: + if (n->subcl == 29) { + OPV_design(n->left, prec); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.design, class = ", (LONGINT)39); + OPM_LogWNum(class, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + if (prec > designPrec) { + OPM_Write(')'); + } +} + +static void OPV_ActualPar (OPT_Node n, OPT_Object fp) +{ + OPT_Struct typ = NIL, aptyp = NIL; + INTEGER comp, form, mode, prec, dim; + OPM_Write('('); + while (n != NIL) { + typ = fp->typ; + comp = typ->comp; + form = typ->form; + mode = fp->mode; + prec = -1; + if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) { + OPM_Write('('); + OPC_Ident(n->typ->strobj); + OPM_WriteString((CHAR*)"*)", (LONGINT)3); + prec = 10; + } + if (!__IN(n->typ->comp, 0x0c)) { + if (mode == 2) { + if ((OPV_ansi && typ != n->typ)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } + OPM_Write('&'); + prec = 9; + } else if (OPV_ansi) { + if ((__IN(comp, 0x0c) && n->class == 7)) { + OPM_WriteString((CHAR*)"(CHAR*)", (LONGINT)8); + } else if ((((form == 13 && typ != n->typ)) && n->typ != OPT_niltyp)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } + } else { + if ((__IN(form, 0x0180) && __IN(n->typ->form, 0x70))) { + OPM_WriteString((CHAR*)"(double)", (LONGINT)9); + prec = 9; + } else if ((form == 6 && n->typ->form < 6)) { + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + prec = 9; + } + } + } else if (OPV_ansi) { + if ((((mode == 2 && typ != n->typ)) && prec == -1)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } + } + if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) { + OPV_expr(n->left, prec); + } else if ((((((form == 6 && n->class == 7)) && n->conval->intval <= OPM_MaxInt)) && n->conval->intval >= OPM_MinInt)) { + OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12); + OPV_expr(n, prec); + OPM_WriteString((CHAR*)"))", (LONGINT)3); + } else { + OPV_expr(n, prec); + } + if ((comp == 4 && mode == 2)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_TypeOf(n); + } else if (comp == 3) { + if (n->class == 7) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + OPM_WriteInt(n->conval->intval2); + } else { + aptyp = n->typ; + dim = 0; + while ((typ->comp == 3 && typ->BaseTyp->form != 1)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_Len(n, dim); + typ = typ->BaseTyp; + aptyp = aptyp->BaseTyp; + dim += 1; + } + if ((typ->comp == 3 && typ->BaseTyp->form == 1)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + while (aptyp->comp == 3) { + OPV_Len(n, dim); + OPM_WriteString((CHAR*)" * ", (LONGINT)4); + dim += 1; + aptyp = aptyp->BaseTyp; + } + OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12); + OPM_WriteInt(aptyp->size); + OPM_WriteString((CHAR*)"))", (LONGINT)3); + } + } + } + n = n->link; + fp = fp->link; + if (n != NIL) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + } + } + OPM_Write(')'); +} + +static OPT_Object OPV_SuperProc (OPT_Node n) +{ + OPT_Object _o_result; + OPT_Object obj = NIL; + OPT_Struct typ = NIL; + typ = n->right->typ; + if (typ->form == 13) { + typ = typ->BaseTyp; + } + OPT_FindField(n->left->obj->name, typ->BaseTyp, &obj); + _o_result = obj; + return _o_result; +} + +static void OPV_expr (OPT_Node n, INTEGER prec) +{ + INTEGER class, subclass, form, exprPrec; + OPT_Struct typ = NIL; + OPT_Node l = NIL, r = NIL; + OPT_Object proc = NIL; + class = n->class; + subclass = n->subcl; + form = n->typ->form; + l = n->left; + r = n->right; + exprPrec = OPV_Precedence(class, subclass, form, n->typ->comp); + if ((exprPrec <= prec && __IN(class, 0x3ce0))) { + OPM_Write('('); + } + switch (class) { + case 7: + OPC_Constant(n->conval, form); + break; + case 10: + OPM_WriteString((CHAR*)"__SETRNG(", (LONGINT)10); + OPV_expr(l, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(r, -1); + OPM_Write(')'); + break; + case 11: + switch (subclass) { + case 33: + OPM_Write('!'); + OPV_expr(l, exprPrec); + break; + case 7: + if (form == 9) { + OPM_Write('~'); + } else { + OPM_Write('-'); + } + OPV_expr(l, exprPrec); + break; + case 16: + typ = n->obj->typ; + if (l->typ->comp == 4) { + OPM_WriteString((CHAR*)"__IS(", (LONGINT)6); + OPC_TypeOf(l->obj); + } else { + OPM_WriteString((CHAR*)"__ISP(", (LONGINT)7); + OPV_expr(l, -1); + typ = typ->BaseTyp; + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(typ); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(typ->extlev); + OPM_Write(')'); + break; + case 20: + OPV_Convert(l, form, exprPrec); + break; + case 21: + if (OPV_SideEffects(l)) { + if (l->typ->form < 7) { + if (l->typ->form < 6) { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + } + OPM_WriteString((CHAR*)"__ABSF(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ABSFD(", (LONGINT)9); + } + } else { + OPM_WriteString((CHAR*)"__ABS(", (LONGINT)7); + } + OPV_expr(l, -1); + OPM_Write(')'); + break; + case 22: + OPM_WriteString((CHAR*)"__CAP(", (LONGINT)7); + OPV_expr(l, -1); + OPM_Write(')'); + break; + case 23: + OPM_WriteString((CHAR*)"__ODD(", (LONGINT)7); + OPV_expr(l, -1); + OPM_Write(')'); + break; + case 24: + OPM_WriteString((CHAR*)"(LONGINT)(uintptr_t)", (LONGINT)21); + if (l->class == 1) { + OPC_CompleteIdent(l->obj); + } else { + if ((l->typ->form != 10 && !__IN(l->typ->comp, 0x0c))) { + OPM_Write('&'); + } + OPV_expr(l, exprPrec); + } + break; + case 29: + if ((((__IN(n->typ->form, 0x6240) && __IN(l->typ->form, 0x6240))) && n->typ->size == l->typ->size) || !__IN(l->class, 0x17)) { + OPM_Write('('); + OPC_Ident(n->typ->strobj); + OPM_Write(')'); + if (__IN(n->typ->form, 0x6000) || __IN(l->typ->form, 0x6000)) { + OPM_WriteString((CHAR*)"(uintptr_t)", (LONGINT)12); + } + OPV_expr(l, exprPrec); + } else { + if (__IN(n->typ->form, 0x6000) || __IN(l->typ->form, 0x6000)) { + OPM_WriteString((CHAR*)"__VALP(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__VAL(", (LONGINT)7); + } + OPC_Ident(n->typ->strobj); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(l, -1); + OPM_Write(')'); + } + break; + default: + OPM_err(200); + break; + } + break; + case 12: + switch (subclass) { + case 19: + OPV_Len(l, r->conval->intval); + break; + case 15: case 17: case 18: case 26: case 27: + case 28: case 3: case 4: + switch (subclass) { + case 15: + OPM_WriteString((CHAR*)"__IN(", (LONGINT)6); + break; + case 17: + if (r->class == 7) { + if (r->conval->intval >= 0) { + OPM_WriteString((CHAR*)"__ASHL(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ASHR(", (LONGINT)8); + } + } else if (OPV_SideEffects(r)) { + OPM_WriteString((CHAR*)"__ASHF(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ASH(", (LONGINT)7); + } + break; + case 18: + OPM_WriteString((CHAR*)"__MASK(", (LONGINT)8); + break; + case 26: + OPM_WriteString((CHAR*)"__BIT(", (LONGINT)7); + break; + case 27: + if (r->class == 7) { + if (r->conval->intval >= 0) { + OPM_WriteString((CHAR*)"__LSHL(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__LSHR(", (LONGINT)8); + } + } else { + OPM_WriteString((CHAR*)"__LSH(", (LONGINT)7); + } + break; + case 28: + if (r->class == 7) { + if (r->conval->intval >= 0) { + OPM_WriteString((CHAR*)"__ROTL(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ROTR(", (LONGINT)8); + } + } else { + OPM_WriteString((CHAR*)"__ROT(", (LONGINT)7); + } + break; + case 3: + if (OPV_SideEffects(n)) { + if (form < 6) { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + } + OPM_WriteString((CHAR*)"__DIVF(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__DIV(", (LONGINT)7); + } + break; + case 4: + if (form < 6) { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + } + if (OPV_SideEffects(n)) { + OPM_WriteString((CHAR*)"__MODF(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__MOD(", (LONGINT)7); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", (LONGINT)40); + OPM_LogWNum(subclass, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + OPV_expr(l, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if ((((__IN(subclass, 0x18020000) && r->class == 7)) && r->conval->intval < 0)) { + OPM_WriteInt(-r->conval->intval); + } else { + OPV_expr(r, -1); + } + if (__IN(subclass, 0x18000000)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(l->typ->strobj); + } + OPM_Write(')'); + break; + case 9: case 10: case 11: case 12: case 13: + case 14: + if (__IN(l->typ->form, 0x8400)) { + OPM_WriteString((CHAR*)"__STRCMP(", (LONGINT)10); + OPV_expr(l, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(r, -1); + OPM_Write(')'); + OPC_Cmp(subclass); + OPM_Write('0'); + } else { + OPV_expr(l, exprPrec); + OPC_Cmp(subclass); + typ = l->typ; + if ((((((typ->form == 13 && r->typ->form != 11)) && r->typ != typ)) && r->typ != OPT_sysptrtyp)) { + OPM_WriteString((CHAR*)"(void *) ", (LONGINT)10); + } + OPV_expr(r, exprPrec); + } + break; + default: + if (subclass == 5 || (form == 9 && (subclass == 1 || subclass == 7))) { + OPM_Write('('); + } + OPV_expr(l, exprPrec); + switch (subclass) { + case 1: + if (form == 9) { + OPM_WriteString((CHAR*)" & ", (LONGINT)4); + } else { + OPM_WriteString((CHAR*)" * ", (LONGINT)4); + } + break; + case 2: + if (form == 9) { + OPM_WriteString((CHAR*)" ^ ", (LONGINT)4); + } else { + OPM_WriteString((CHAR*)" / ", (LONGINT)4); + if (r->obj == NIL || __IN(r->obj->typ->form, 0x70)) { + OPM_Write('('); + OPC_Ident(n->typ->strobj); + OPM_Write(')'); + } + } + break; + case 5: + OPM_WriteString((CHAR*)" && ", (LONGINT)5); + break; + case 6: + if (form == 9) { + OPM_WriteString((CHAR*)" | ", (LONGINT)4); + } else { + OPM_WriteString((CHAR*)" + ", (LONGINT)4); + } + break; + case 7: + if (form == 9) { + OPM_WriteString((CHAR*)" & ~", (LONGINT)5); + } else { + OPM_WriteString((CHAR*)" - ", (LONGINT)4); + } + break; + case 8: + OPM_WriteString((CHAR*)" || ", (LONGINT)5); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", (LONGINT)40); + OPM_LogWNum(subclass, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + OPV_expr(r, exprPrec); + if (subclass == 5 || (form == 9 && (subclass == 1 || subclass == 7))) { + OPM_Write(')'); + } + break; + } + break; + case 13: + if ((l->obj != NIL && l->obj->mode == 13)) { + if (l->subcl == 1) { + proc = OPV_SuperProc(n); + } else { + OPM_WriteString((CHAR*)"__", (LONGINT)3); + proc = OPC_BaseTProc(l->obj); + } + OPC_Ident(proc); + n->obj = proc->link; + } else if (l->class == 9) { + OPV_design(l, 10); + } else { + OPV_design(l, 11); + } + OPV_ActualPar(r, n->obj); + break; + default: + OPV_design(n, prec); + break; + } + if ((exprPrec <= prec && __IN(class, 0x3ca0))) { + OPM_Write(')'); + } +} + +static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc) +{ + OPT_Node if_ = NIL; + OPT_Object obj = NIL; + OPT_Struct typ = NIL; + LONGINT adr; + if_ = n->left; + while (if_ != NIL) { + OPM_WriteString((CHAR*)"if ", (LONGINT)4); + OPV_expr(if_->left, 12); + OPM_Write(' '); + OPC_BegBlk(); + if ((n->class == 27 && if_->left->left != NIL)) { + obj = if_->left->left->obj; + typ = obj->typ; + adr = obj->adr; + if (typ->comp == 4) { + OPC_BegStat(); + OPC_Ident(if_->left->obj); + OPM_WriteString((CHAR*)" *", (LONGINT)3); + OPM_WriteString(obj->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"__ = (void*)", (LONGINT)13); + obj->adr = 0; + OPC_CompleteIdent(obj); + OPC_EndStat(); + } + obj->adr = 1; + obj->typ = if_->left->obj->typ; + OPV_stat(if_->right, outerProc); + obj->typ = typ; + obj->adr = adr; + } else { + OPV_stat(if_->right, outerProc); + } + if_ = if_->link; + if ((if_ != NIL || n->right != NIL) || withtrap) { + OPC_EndBlk0(); + OPM_WriteString((CHAR*)" else ", (LONGINT)7); + } else { + OPC_EndBlk(); + } + } + if (withtrap) { + OPM_WriteString((CHAR*)"__WITHCHK", (LONGINT)10); + OPC_EndStat(); + } else if (n->right != NIL) { + OPC_BegBlk(); + OPV_stat(n->right, outerProc); + OPC_EndBlk(); + } +} + +static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc) +{ + OPT_Node switchCase = NIL, label = NIL; + LONGINT low, high; + INTEGER form, i; + OPM_WriteString((CHAR*)"switch ", (LONGINT)8); + OPV_expr(n->left, 12); + OPM_Write(' '); + OPC_BegBlk(); + form = n->left->typ->form; + switchCase = n->right->left; + while (switchCase != NIL) { + label = switchCase->left; + i = 0; + while (label != NIL) { + low = label->conval->intval; + high = label->conval->intval2; + while (low <= high) { + if (i == 0) { + OPC_BegStat(); + } + OPC_Case(low, form); + low += 1; + i += 1; + if (i == 5) { + OPM_WriteLn(); + i = 0; + } + } + label = label->link; + } + if (i > 0) { + OPM_WriteLn(); + } + OPC_Indent(1); + OPV_stat(switchCase->right, outerProc); + OPC_BegStat(); + OPM_WriteString((CHAR*)"break", (LONGINT)6); + OPC_EndStat(); + OPC_Indent(-1); + switchCase = switchCase->link; + } + OPC_BegStat(); + OPM_WriteString((CHAR*)"default: ", (LONGINT)10); + if (n->right->conval->setval != 0x0) { + OPC_Indent(1); + OPM_WriteLn(); + OPV_stat(n->right->right, outerProc); + OPC_BegStat(); + OPM_WriteString((CHAR*)"break", (LONGINT)6); + OPC_Indent(-1); + } else { + OPM_WriteString((CHAR*)"__CASECHK", (LONGINT)10); + } + OPC_EndStat(); + OPC_EndBlk(); +} + +static BOOLEAN OPV_ImplicitReturn (OPT_Node n) +{ + BOOLEAN _o_result; + while ((n != NIL && n->class != 26)) { + n = n->link; + } + _o_result = n == NIL; + return _o_result; +} + +static void OPV_NewArr (OPT_Node d, OPT_Node x) +{ + OPT_Struct typ = NIL, base = NIL; + INTEGER nofdim, nofdyn; + typ = d->typ->BaseTyp; + base = typ; + nofdim = 0; + nofdyn = 0; + while (base->comp == 3) { + nofdim += 1; + nofdyn += 1; + base = base->BaseTyp; + } + OPV_design(d, -1); + OPM_WriteString((CHAR*)" = __NEWARR(", (LONGINT)13); + while (base->comp == 2) { + nofdim += 1; + base = base->BaseTyp; + } + if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) { + OPC_Ident(base->strobj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } else if (base->form == 13) { + OPM_WriteString((CHAR*)"POINTER__typ", (LONGINT)13); + } else { + OPM_WriteString((CHAR*)"NIL", (LONGINT)4); + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12); + OPM_WriteInt(base->size); + OPM_WriteString((CHAR*)"))", (LONGINT)3); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(OPC_Base(base)); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(nofdim); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(nofdyn); + while (typ != base) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (typ->comp == 3) { + if (x->class == 7) { + OPM_WriteString((CHAR*)"(LONGINT)(", (LONGINT)11); + OPV_expr(x, -1); + OPM_WriteString((CHAR*)")", (LONGINT)2); + } else { + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + OPV_expr(x, 10); + } + x = x->link; + } else { + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + OPM_WriteInt(typ->n); + } + typ = typ->BaseTyp; + } + OPM_Write(')'); +} + +static void OPV_DefineTDescs (OPT_Node n) +{ + while ((n != NIL && n->class == 14)) { + OPC_TDescDecl(n->typ); + n = n->link; + } +} + +static void OPV_InitTDescs (OPT_Node n) +{ + while ((n != NIL && n->class == 14)) { + OPC_InitTDesc(n->typ); + n = n->link; + } +} + +static void OPV_stat (OPT_Node n, OPT_Object outerProc) +{ + OPT_Object proc = NIL; + OPV_ExitInfo saved; + OPT_Node l = NIL, r = NIL; + while ((n != NIL && OPM_noerr)) { + OPM_errpos = n->conval->intval; + if (n->class != 14) { + OPC_BegStat(); + } + switch (n->class) { + case 18: + if (n->obj == NIL) { + OPM_level += 1; + OPV_stat(n->left, outerProc); + OPM_level -= 1; + OPC_GenEnumPtrs(OPT_topScope->scope); + OPV_DefineTDescs(n->right); + OPC_EnterBody(); + OPV_InitTDescs(n->right); + OPM_WriteString((CHAR*)"/* BEGIN */", (LONGINT)12); + OPM_WriteLn(); + OPV_stat(n->right, outerProc); + OPC_ExitBody(); + } else { + proc = n->obj; + OPC_TypeDefs(proc->scope->right, 0); + if (!proc->scope->leaf) { + OPC_DefineInter(proc); + } + OPM_level += 1; + OPV_stat(n->left, proc); + OPM_level -= 1; + OPC_EnterProc(proc); + OPV_stat(n->right, proc); + OPC_ExitProc(proc, 1, OPV_ImplicitReturn(n->right)); + } + break; + case 14: + break; + case 19: + switch (n->subcl) { + case 0: + l = n->left; + r = n->right; + if (l->typ->comp == 2) { + OPM_WriteString((CHAR*)"__MOVE(", (LONGINT)8); + OPV_expr(r, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(l, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (r->typ == OPT_stringtyp) { + OPM_WriteInt(r->conval->intval2); + } else { + OPM_WriteInt(r->typ->size); + } + OPM_Write(')'); + } else { + if ((((((l->typ->form == 13 && l->obj != NIL)) && l->obj->adr == 1)) && l->obj->mode == 1)) { + l->obj->adr = 0; + OPV_design(l, -1); + l->obj->adr = 1; + if (r->typ->form != 11) { + OPM_WriteString((CHAR*)" = (void*)", (LONGINT)11); + } else { + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + } + } else { + OPV_design(l, -1); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + } + if (l->typ == r->typ) { + OPV_expr(r, -1); + } else if ((((l->typ->form == 13 && r->typ->form != 11)) && l->typ->strobj != NIL)) { + OPM_Write('('); + OPC_Ident(l->typ->strobj); + OPM_Write(')'); + OPV_expr(r, -1); + } else if (l->typ->comp == 4) { + OPM_WriteString((CHAR*)"*(", (LONGINT)3); + OPC_Andent(l->typ); + OPM_WriteString((CHAR*)"*)&", (LONGINT)4); + OPV_expr(r, 9); + } else { + OPV_expr(r, -1); + } + } + break; + case 1: + if (n->left->typ->BaseTyp->comp == 4) { + OPM_WriteString((CHAR*)"__NEW(", (LONGINT)7); + OPV_design(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(n->left->typ->BaseTyp); + OPM_WriteString((CHAR*)")", (LONGINT)2); + } else if (__IN(n->left->typ->BaseTyp->comp, 0x0c)) { + OPV_NewArr(n->left, n->right); + } + break; + case 13: case 14: + OPV_expr(n->left, -1); + OPC_Increment(n->subcl == 14); + OPV_expr(n->right, -1); + break; + case 15: case 16: + OPV_expr(n->left, -1); + OPC_SetInclude(n->subcl == 16); + OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9); + OPV_expr(n->right, -1); + OPM_Write(')'); + break; + case 18: + OPM_WriteString((CHAR*)"__COPY(", (LONGINT)8); + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_Len(n->left, ((LONGINT)(0))); + OPM_Write(')'); + break; + case 31: + OPM_WriteString((CHAR*)"__MOVE(", (LONGINT)8); + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->right->link, -1); + OPM_Write(')'); + break; + case 24: + OPM_WriteString((CHAR*)"__GET(", (LONGINT)7); + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(n->left->typ->strobj); + OPM_Write(')'); + break; + case 25: + OPM_WriteString((CHAR*)"__PUT(", (LONGINT)7); + OPV_expr(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(n->right->typ->strobj); + OPM_Write(')'); + break; + case 26: case 27: + OPM_err(200); + break; + case 30: + OPM_WriteString((CHAR*)"__SYSNEW(", (LONGINT)10); + OPV_design(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->right, -1); + OPM_Write(')'); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.subcl = ", (LONGINT)40); + OPM_LogWNum(n->subcl, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + break; + case 13: + if ((n->left->obj != NIL && n->left->obj->mode == 13)) { + if (n->left->subcl == 1) { + proc = OPV_SuperProc(n); + } else { + OPM_WriteString((CHAR*)"__", (LONGINT)3); + proc = OPC_BaseTProc(n->left->obj); + } + OPC_Ident(proc); + n->obj = proc->link; + } else if (n->left->class == 9) { + OPV_design(n->left, 10); + } else { + OPV_design(n->left, 11); + } + OPV_ActualPar(n->right, n->obj); + break; + case 20: + if (n->subcl != 32) { + OPV_IfStat(n, 0, outerProc); + } else if (OPV_assert) { + OPM_WriteString((CHAR*)"__ASSERT(", (LONGINT)10); + OPV_expr(n->left->left->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(n->left->right->right->conval->intval); + OPM_Write(')'); + OPC_EndStat(); + } + break; + case 21: + OPV_exit.level += 1; + OPV_CaseStat(n, outerProc); + OPV_exit.level -= 1; + break; + case 22: + OPV_exit.level += 1; + OPM_WriteString((CHAR*)"while ", (LONGINT)7); + OPV_expr(n->left, 12); + OPM_Write(' '); + OPC_BegBlk(); + OPV_stat(n->right, outerProc); + OPC_EndBlk(); + OPV_exit.level -= 1; + break; + case 23: + OPV_exit.level += 1; + OPM_WriteString((CHAR*)"do ", (LONGINT)4); + OPC_BegBlk(); + OPV_stat(n->left, outerProc); + OPC_EndBlk0(); + OPM_WriteString((CHAR*)" while (!", (LONGINT)10); + OPV_expr(n->right, 9); + OPM_Write(')'); + OPV_exit.level -= 1; + break; + case 24: + saved = OPV_exit; + OPV_exit.level = 0; + OPV_exit.label = -1; + OPM_WriteString((CHAR*)"for (;;) ", (LONGINT)10); + OPC_BegBlk(); + OPV_stat(n->left, outerProc); + OPC_EndBlk(); + if (OPV_exit.label != -1) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"exit__", (LONGINT)7); + OPM_WriteInt(OPV_exit.label); + OPM_Write(':'); + OPC_EndStat(); + } + OPV_exit = saved; + break; + case 25: + if (OPV_exit.level == 0) { + OPM_WriteString((CHAR*)"break", (LONGINT)6); + } else { + if (OPV_exit.label == -1) { + OPV_exit.label = OPV_nofExitLabels; + OPV_nofExitLabels += 1; + } + OPM_WriteString((CHAR*)"goto exit__", (LONGINT)12); + OPM_WriteInt(OPV_exit.label); + } + break; + case 26: + if (OPM_level == 0) { + if (OPV_mainprog) { + OPM_WriteString((CHAR*)"__FINI", (LONGINT)7); + } else { + OPM_WriteString((CHAR*)"__ENDMOD", (LONGINT)9); + } + } else { + if (n->left != NIL) { + OPM_WriteString((CHAR*)"_o_result = ", (LONGINT)13); + if ((n->left->typ->form == 13 && n->obj->typ != n->left->typ)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + OPV_expr(n->left, 10); + } else { + OPV_expr(n->left, -1); + } + OPM_WriteString((CHAR*)";", (LONGINT)2); + OPM_WriteLn(); + OPC_BegStat(); + OPC_ExitProc(outerProc, 0, 0); + OPM_WriteString((CHAR*)"return _o_result", (LONGINT)17); + } else { + OPM_WriteString((CHAR*)"return", (LONGINT)7); + } + } + break; + case 27: + OPV_IfStat(n, n->subcl == 0, outerProc); + break; + case 28: + OPC_Halt(n->right->conval->intval); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.class = ", (LONGINT)40); + OPM_LogWNum(n->class, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + if (!__IN(n->class, 0x09744000)) { + OPC_EndStat(); + } + n = n->link; + } +} + +void OPV_Module (OPT_Node prog) +{ + if (!OPV_mainprog) { + OPC_GenHdr(prog->right); + OPC_GenHdrIncludes(); + } + OPC_GenBdy(prog->right); + OPV_stat(prog, NIL); +} + +__TDESC(OPV_ExitInfo, 1, 0) = {__TDFLDS("ExitInfo", 4), {-4}}; + +export void *OPV__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPC); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPS); + __MODULE_IMPORT(OPT); + __REGMOD("OPV", 0); + __REGCMD("Init", OPV_Init); + __INITYP(OPV_ExitInfo, OPV_ExitInfo, 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/windows-48/OPV.h b/bootstrap/windows-48/OPV.h new file mode 100644 index 00000000..9907a1ef --- /dev/null +++ b/bootstrap/windows-48/OPV.h @@ -0,0 +1,19 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPV__h +#define OPV__h + +#include "SYSTEM.h" +#include "OPT.h" + + + + +import void OPV_AdrAndSize (OPT_Object topScope); +import void OPV_Init (void); +import void OPV_Module (OPT_Node prog); +import void OPV_TypSize (OPT_Struct typ); +import void *OPV__init(void); + + +#endif diff --git a/bootstrap/windows-48/Platform.c b/bootstrap/windows-48/Platform.c new file mode 100644 index 00000000..d097f9db --- /dev/null +++ b/bootstrap/windows-48/Platform.c @@ -0,0 +1,818 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" + +typedef + CHAR (*Platform_ArgPtr)[1024]; + +typedef + Platform_ArgPtr (*Platform_ArgVec)[1024]; + +typedef + LONGINT (*Platform_ArgVecPtr)[1]; + +typedef + CHAR (*Platform_EnvPtr)[1024]; + +typedef + struct Platform_FileIdentity { + LONGINT volume, indexhigh, indexlow, mtimehigh, mtimelow; + } Platform_FileIdentity; + +typedef + void (*Platform_HaltProcedure)(LONGINT); + +typedef + void (*Platform_SignalHandler)(INTEGER); + + +export BOOLEAN Platform_LittleEndian; +export LONGINT Platform_MainStackFrame, Platform_HaltCode; +export INTEGER Platform_PID; +export CHAR Platform_CWD[4096]; +export INTEGER Platform_ArgCount; +export LONGINT Platform_ArgVector; +static Platform_HaltProcedure Platform_HaltHandler; +static LONGINT Platform_TimeStart; +export INTEGER Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd; +export LONGINT Platform_StdIn, Platform_StdOut, Platform_StdErr; +static Platform_SignalHandler Platform_InterruptHandler; +export CHAR Platform_nl[3]; + +export LONGINT *Platform_FileIdentity__typ; + +export BOOLEAN Platform_Absent (INTEGER e); +export INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len); +export void Platform_AssertFail (LONGINT code); +export INTEGER Platform_Chdir (CHAR *n, LONGINT n__len); +export INTEGER Platform_Close (LONGINT h); +export BOOLEAN Platform_ConnectionFailed (INTEGER e); +export void Platform_Delay (LONGINT ms); +export BOOLEAN Platform_DifferentFilesystems (INTEGER e); +static void Platform_DisplayHaltCode (LONGINT code); +export INTEGER Platform_Error (void); +export void Platform_Exit (INTEGER code); +export void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len); +export void Platform_GetClock (LONGINT *t, LONGINT *d); +export void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len); +export void Platform_GetIntArg (INTEGER n, LONGINT *val); +export void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec); +export void Platform_Halt (LONGINT code); +export INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ); +export INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ); +export BOOLEAN Platform_Inaccessible (INTEGER e); +export void Platform_Init (INTEGER argc, LONGINT argvadr); +export void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d); +export INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h); +export BOOLEAN Platform_NoSuchDirectory (INTEGER e); +export LONGINT Platform_OSAllocate (LONGINT size); +export void Platform_OSFree (LONGINT address); +export INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h); +export INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h); +export INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n); +export INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n); +export INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len); +export BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2); +export BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2); +export INTEGER Platform_Seek (LONGINT h, LONGINT o, INTEGER r); +export void Platform_SetBadInstructionHandler (Platform_SignalHandler handler); +export void Platform_SetHalt (Platform_HaltProcedure p); +export void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source); +export INTEGER Platform_Size (LONGINT h, LONGINT *l); +export INTEGER Platform_Sync (LONGINT h); +export INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len); +static void Platform_TestLittleEndian (void); +export LONGINT Platform_Time (void); +export BOOLEAN Platform_TimedOut (INTEGER e); +export BOOLEAN Platform_TooManyFiles (INTEGER e); +export INTEGER Platform_Truncate (LONGINT h, LONGINT limit); +export INTEGER Platform_Unlink (CHAR *n, LONGINT n__len); +export INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l); +static void Platform_YMDHMStoClock (INTEGER ye, INTEGER mo, INTEGER da, INTEGER ho, INTEGER mi, INTEGER se, LONGINT *t, LONGINT *d); +static void Platform_errch (CHAR c); +static void Platform_errint (LONGINT l); +static void Platform_errln (void); +static void Platform_errposint (LONGINT l); +export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len); + +#include "WindowsWrapper.h" +#define Platform_ECONNABORTED() WSAECONNABORTED +#define Platform_ECONNREFUSED() WSAECONNREFUSED +#define Platform_EHOSTUNREACH() WSAEHOSTUNREACH +#define Platform_ENETUNREACH() WSAENETUNREACH +#define Platform_ERRORACCESSDENIED() ERROR_ACCESS_DENIED +#define Platform_ERRORFILENOTFOUND() ERROR_FILE_NOT_FOUND +#define Platform_ERRORNOTREADY() ERROR_NOT_READY +#define Platform_ERRORNOTSAMEDEVICE() ERROR_NOT_SAME_DEVICE +#define Platform_ERRORPATHNOTFOUND() ERROR_PATH_NOT_FOUND +#define Platform_ERRORSHARINGVIOLATION() ERROR_SHARING_VIOLATION +#define Platform_ERRORTOOMANYOPENFILES() ERROR_TOO_MANY_OPEN_FILES +#define Platform_ERRORWRITEPROTECT() ERROR_WRITE_PROTECT +#define Platform_ETIMEDOUT() WSAETIMEDOUT +extern void Heap_InitHeap(); +#define Platform_GetTickCount() (LONGINT)(uint32_t)GetTickCount() +#define Platform_HeapInitHeap() Heap_InitHeap() +#define Platform_SetInterruptHandler(h) SystemSetInterruptHandler((uintptr_t)h) +#define Platform_SetQuitHandler(h) SystemSetQuitHandler((uintptr_t)h) +#define Platform_allocate(size) (LONGINT)(uintptr_t)((void*)HeapAlloc(GetProcessHeap(), 0, (size_t)size)) +#define Platform_bhfiIndexHigh() (LONGINT)bhfi.nFileIndexHigh +#define Platform_bhfiIndexLow() (LONGINT)bhfi.nFileIndexLow +#define Platform_bhfiMtimeHigh() (LONGINT)bhfi.ftLastWriteTime.dwHighDateTime +#define Platform_bhfiMtimeLow() (LONGINT)bhfi.ftLastWriteTime.dwLowDateTime +#define Platform_bhfiVsn() (LONGINT)bhfi.dwVolumeSerialNumber +#define Platform_byHandleFileInformation() BY_HANDLE_FILE_INFORMATION bhfi +#define Platform_cleanupProcess() CloseHandle(pi.hProcess); CloseHandle(pi.hThread); +#define Platform_closeHandle(h) (INTEGER)CloseHandle((HANDLE)(uintptr_t)h) +#define Platform_createProcess(str, str__len) (INTEGER)CreateProcess(0, (char*)str, 0,0,0,0,0,0,&si,&pi) +#define Platform_deleteFile(n, n__len) (INTEGER)DeleteFile((char*)n) +#define Platform_err() (INTEGER)GetLastError() +#define Platform_errc(c) WriteFile((HANDLE)(uintptr_t)Platform_StdOut, &c, 1, 0,0) +#define Platform_errstring(s, s__len) WriteFile((HANDLE)(uintptr_t)Platform_StdOut, s, s__len-1, 0,0) +#define Platform_exit(code) ExitProcess((UINT)code) +#define Platform_fileTimeToSysTime() SYSTEMTIME st; FileTimeToSystemTime(&ft, &st) +#define Platform_flushFileBuffers(h) (INTEGER)FlushFileBuffers((HANDLE)(uintptr_t)h) +#define Platform_free(address) HeapFree(GetProcessHeap(), 0, (void*)(uintptr_t)address) +#define Platform_getCurrentDirectory(n, n__len) GetCurrentDirectory(n__len, (char*)n) +#define Platform_getExitCodeProcess(exitcode) GetExitCodeProcess(pi.hProcess, (DWORD*)exitcode); +#define Platform_getFileInformationByHandle(h) (INTEGER)GetFileInformationByHandle((HANDLE)(uintptr_t)h, &bhfi) +#define Platform_getFilePos(h, r, rc) LARGE_INTEGER liz = {0}; *rc = (INTEGER)SetFilePointerEx((HANDLE)(uintptr_t)h, liz, &li, FILE_CURRENT); *r = (LONGINT)li.QuadPart +#define Platform_getFileSize(h) (INTEGER)GetFileSizeEx((HANDLE)(uintptr_t)h, &li) +#define Platform_getLocalTime() SYSTEMTIME st; GetLocalTime(&st) +#define Platform_getenv(name, name__len, buf, buf__len) (INTEGER)GetEnvironmentVariable((char*)name, (char*)buf, buf__len) +#define Platform_getpid() (INTEGER)GetCurrentProcessId() +#define Platform_getstderrhandle() (uintptr_t)GetStdHandle(STD_ERROR_HANDLE) +#define Platform_getstdinhandle() (uintptr_t)GetStdHandle(STD_INPUT_HANDLE) +#define Platform_getstdouthandle() (uintptr_t)GetStdHandle(STD_OUTPUT_HANDLE) +#define Platform_identityToFileTime(i) FILETIME ft; ft.dwHighDateTime = i.mtimehigh; ft.dwLowDateTime = i.mtimelow +#define Platform_invalidHandleValue() ((LONGINT)(uintptr_t)INVALID_HANDLE_VALUE) +#define Platform_largeInteger() LARGE_INTEGER li +#define Platform_liLongint() (LONGINT)li.QuadPart +#define Platform_moveFile(o, o__len, n, n__len) (INTEGER)MoveFileEx((char*)o, (char*)n, MOVEFILE_REPLACE_EXISTING) +#define Platform_opennew(n, n__len) (LONGINT)(uintptr_t)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0) +#define Platform_openro(n, n__len) (LONGINT)(uintptr_t)CreateFile((char*)n, GENERIC_READ , FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0) +#define Platform_openrw(n, n__len) (LONGINT)(uintptr_t)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0) +#define Platform_processInfo() PROCESS_INFORMATION pi = {0}; +#define Platform_readfile(fd, p, l, n) (INTEGER)ReadFile ((HANDLE)(uintptr_t)fd, (void*)(uintptr_t)(p), (DWORD)l, (DWORD*)n, 0) +#define Platform_seekcur() FILE_CURRENT +#define Platform_seekend() FILE_END +#define Platform_seekset() FILE_BEGIN +#define Platform_setCurrentDirectory(n, n__len) (INTEGER)SetCurrentDirectory((char*)n) +#define Platform_setEndOfFile(h) (INTEGER)SetEndOfFile((HANDLE)(uintptr_t)h) +#define Platform_setFilePointerEx(h, o, r, rc) li.QuadPart=o; *rc = (INTEGER)SetFilePointerEx((HANDLE)(uintptr_t)h, li, 0, (DWORD)r) +#define Platform_sleep(ms) Sleep((DWORD)ms) +#define Platform_startupInfo() STARTUPINFO si = {0}; si.cb = sizeof(si); +#define Platform_sthour() (INTEGER)st.wHour +#define Platform_stmday() (INTEGER)st.wDay +#define Platform_stmin() (INTEGER)st.wMinute +#define Platform_stmon() (INTEGER)st.wMonth +#define Platform_stmsec() (INTEGER)st.wMilliseconds +#define Platform_stsec() (INTEGER)st.wSecond +#define Platform_styear() (INTEGER)st.wYear +#define Platform_waitForProcess() (INTEGER)WaitForSingleObject(pi.hProcess, INFINITE) +#define Platform_writefile(fd, p, l) (INTEGER)WriteFile((HANDLE)(uintptr_t)fd, (void*)(uintptr_t)(p), (DWORD)l, 0,0) + +BOOLEAN Platform_TooManyFiles (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_ERRORTOOMANYOPENFILES(); + return _o_result; +} + +BOOLEAN Platform_NoSuchDirectory (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_ERRORPATHNOTFOUND(); + return _o_result; +} + +BOOLEAN Platform_DifferentFilesystems (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_ERRORNOTSAMEDEVICE(); + return _o_result; +} + +BOOLEAN Platform_Inaccessible (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = ((e == Platform_ERRORACCESSDENIED() || e == Platform_ERRORWRITEPROTECT()) || e == Platform_ERRORNOTREADY()) || e == Platform_ERRORSHARINGVIOLATION(); + return _o_result; +} + +BOOLEAN Platform_Absent (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_ERRORFILENOTFOUND() || e == Platform_ERRORPATHNOTFOUND(); + return _o_result; +} + +BOOLEAN Platform_TimedOut (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_ETIMEDOUT(); + return _o_result; +} + +BOOLEAN Platform_ConnectionFailed (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = ((e == Platform_ECONNREFUSED() || e == Platform_ECONNABORTED()) || e == Platform_ENETUNREACH()) || e == Platform_EHOSTUNREACH(); + return _o_result; +} + +LONGINT Platform_OSAllocate (LONGINT size) +{ + LONGINT _o_result; + _o_result = Platform_allocate(size); + return _o_result; +} + +void Platform_OSFree (LONGINT address) +{ + Platform_free(address); +} + +void Platform_Init (INTEGER argc, LONGINT argvadr) +{ + Platform_ArgVecPtr av = NIL; + Platform_MainStackFrame = argvadr; + Platform_ArgCount = argc; + av = (Platform_ArgVecPtr)(uintptr_t)argvadr; + Platform_ArgVector = (*av)[0]; + Platform_HaltCode = -128; + Platform_HeapInitHeap(); +} + +BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len) +{ + BOOLEAN _o_result; + CHAR buf[4096]; + INTEGER res; + __DUP(var, var__len, CHAR); + res = Platform_getenv(var, var__len, (void*)buf, ((LONGINT)(4096))); + if ((res > 0 && res < 4096)) { + __COPY(buf, val, val__len); + _o_result = 1; + __DEL(var); + return _o_result; + } else { + _o_result = 0; + __DEL(var); + return _o_result; + } + __RETCHK; +} + +void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len) +{ + __DUP(var, var__len, CHAR); + if (!Platform_getEnv(var, var__len, (void*)val, val__len)) { + val[0] = 0x00; + } + __DEL(var); +} + +void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len) +{ + Platform_ArgVec av = NIL; + if (n < Platform_ArgCount) { + av = (Platform_ArgVec)(uintptr_t)Platform_ArgVector; + __COPY(*(*av)[__X(n, ((LONGINT)(1024)))], val, val__len); + } +} + +void Platform_GetIntArg (INTEGER n, LONGINT *val) +{ + CHAR s[64]; + LONGINT k, d, i; + s[0] = 0x00; + Platform_GetArg(n, (void*)s, ((LONGINT)(64))); + i = 0; + if (s[0] == '-') { + i = 1; + } + k = 0; + d = (int)s[__X(i, ((LONGINT)(64)))] - 48; + while ((d >= 0 && d <= 9)) { + k = k * 10 + d; + i += 1; + d = (int)s[__X(i, ((LONGINT)(64)))] - 48; + } + if (s[0] == '-') { + k = -k; + i -= 1; + } + if (i > 0) { + *val = k; + } +} + +INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len) +{ + INTEGER _o_result; + INTEGER i; + CHAR arg[256]; + __DUP(s, s__len, CHAR); + i = 0; + Platform_GetArg(i, (void*)arg, ((LONGINT)(256))); + while ((i < Platform_ArgCount && __STRCMP(s, arg) != 0)) { + i += 1; + Platform_GetArg(i, (void*)arg, ((LONGINT)(256))); + } + _o_result = i; + __DEL(s); + return _o_result; +} + +void Platform_SetBadInstructionHandler (Platform_SignalHandler handler) +{ +} + +static void Platform_YMDHMStoClock (INTEGER ye, INTEGER mo, INTEGER da, INTEGER ho, INTEGER mi, INTEGER se, LONGINT *t, LONGINT *d) +{ + *d = (__ASHL((LONGINT)(int)__MOD(ye, 100), 9) + __ASHL((LONGINT)(mo + 1), 5)) + (LONGINT)da; + *t = (__ASHL((LONGINT)ho, 12) + __ASHL((LONGINT)mi, 6)) + (LONGINT)se; +} + +void Platform_GetClock (LONGINT *t, LONGINT *d) +{ + Platform_getLocalTime(); + Platform_YMDHMStoClock(Platform_styear(), Platform_stmon(), Platform_stmday(), Platform_sthour(), Platform_stmin(), Platform_stsec(), &*t, &*d); +} + +void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec) +{ + Platform_getLocalTime(); + *sec = Platform_stsec(); + *usec = (LONGINT)Platform_stmsec() * 1000; +} + +LONGINT Platform_Time (void) +{ + LONGINT _o_result; + LONGINT ms; + ms = Platform_GetTickCount(); + _o_result = __MOD(ms - Platform_TimeStart, 2147483647); + return _o_result; +} + +void Platform_Delay (LONGINT ms) +{ + while (ms > 30000) { + Platform_sleep(((LONGINT)(30000))); + ms = ms - 30000; + } + if (ms > 0) { + Platform_sleep(ms); + } +} + +INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len) +{ + INTEGER _o_result; + INTEGER result; + __DUP(cmd, cmd__len, CHAR); + result = 127; + Platform_startupInfo(); + Platform_processInfo(); + if (Platform_createProcess(cmd, cmd__len) != 0) { + if (Platform_waitForProcess() == 0) { + Platform_getExitCodeProcess(&result); + } + Platform_cleanupProcess(); + } + _o_result = __ASHL(result, 8); + __DEL(cmd); + return _o_result; +} + +INTEGER Platform_Error (void) +{ + INTEGER _o_result; + _o_result = Platform_err(); + return _o_result; +} + +INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h) +{ + INTEGER _o_result; + LONGINT fd; + fd = Platform_openro(n, n__len); + if (fd == Platform_invalidHandleValue()) { + _o_result = Platform_err(); + return _o_result; + } else { + *h = fd; + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h) +{ + INTEGER _o_result; + LONGINT fd; + fd = Platform_openrw(n, n__len); + if (fd == Platform_invalidHandleValue()) { + _o_result = Platform_err(); + return _o_result; + } else { + *h = fd; + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h) +{ + INTEGER _o_result; + LONGINT fd; + fd = Platform_opennew(n, n__len); + if (fd == Platform_invalidHandleValue()) { + _o_result = Platform_err(); + return _o_result; + } else { + *h = fd; + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Close (LONGINT h) +{ + INTEGER _o_result; + if (Platform_closeHandle(h) == 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ) +{ + INTEGER _o_result; + Platform_byHandleFileInformation(); + if (Platform_getFileInformationByHandle(h) == 0) { + _o_result = Platform_err(); + return _o_result; + } + (*identity).volume = Platform_bhfiVsn(); + (*identity).indexhigh = Platform_bhfiIndexHigh(); + (*identity).indexlow = Platform_bhfiIndexLow(); + (*identity).mtimehigh = Platform_bhfiMtimeHigh(); + (*identity).mtimelow = Platform_bhfiMtimeLow(); + _o_result = 0; + return _o_result; +} + +INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ) +{ + INTEGER _o_result; + LONGINT h; + INTEGER e, i; + __DUP(n, n__len, CHAR); + e = Platform_OldRO((void*)n, n__len, &h); + if (e != 0) { + _o_result = e; + __DEL(n); + return _o_result; + } + e = Platform_Identify(h, &*identity, identity__typ); + i = Platform_Close(h); + _o_result = e; + __DEL(n); + return _o_result; +} + +BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2) +{ + BOOLEAN _o_result; + _o_result = (((i1.indexhigh == i2.indexhigh && i1.indexlow == i2.indexlow)) && i1.volume == i2.volume); + return _o_result; +} + +BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2) +{ + BOOLEAN _o_result; + _o_result = (i1.mtimehigh == i2.mtimehigh && i1.mtimelow == i2.mtimelow); + return _o_result; +} + +void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source) +{ + (*target).mtimehigh = source.mtimehigh; + (*target).mtimelow = source.mtimelow; +} + +void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d) +{ + Platform_identityToFileTime(i); + Platform_fileTimeToSysTime(); + Platform_YMDHMStoClock(Platform_styear(), Platform_stmon(), Platform_stmday(), Platform_sthour(), Platform_stmin(), Platform_stsec(), &*t, &*d); +} + +INTEGER Platform_Size (LONGINT h, LONGINT *l) +{ + INTEGER _o_result; + Platform_largeInteger(); + if (Platform_getFileSize(h) == 0) { + _o_result = Platform_err(); + return _o_result; + } + *l = Platform_liLongint(); + _o_result = 0; + return _o_result; +} + +INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n) +{ + INTEGER _o_result; + INTEGER result; + *n = 0; + result = Platform_readfile(h, p, l, &*n); + if (result == 0) { + *n = 0; + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n) +{ + INTEGER _o_result; + INTEGER result; + *n = 0; + result = Platform_readfile(h, (LONGINT)(uintptr_t)b, b__len, &*n); + if (result == 0) { + *n = 0; + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l) +{ + INTEGER _o_result; + if (Platform_writefile(h, p, l) == 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Sync (LONGINT h) +{ + INTEGER _o_result; + if (Platform_flushFileBuffers(h) == 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Seek (LONGINT h, LONGINT o, INTEGER r) +{ + INTEGER _o_result; + INTEGER rc; + Platform_largeInteger(); + Platform_setFilePointerEx(h, o, r, &rc); + if (rc == 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Truncate (LONGINT h, LONGINT limit) +{ + INTEGER _o_result; + INTEGER rc; + LONGINT oldpos; + Platform_largeInteger(); + Platform_getFilePos(h, &oldpos, &rc); + if (rc == 0) { + _o_result = Platform_err(); + return _o_result; + } + Platform_setFilePointerEx(h, limit, Platform_seekset(), &rc); + if (rc == 0) { + _o_result = Platform_err(); + return _o_result; + } + if (Platform_setEndOfFile(h) == 0) { + _o_result = Platform_err(); + return _o_result; + } + Platform_setFilePointerEx(h, oldpos, Platform_seekset(), &rc); + if (rc == 0) { + _o_result = Platform_err(); + return _o_result; + } + _o_result = 0; + return _o_result; +} + +INTEGER Platform_Unlink (CHAR *n, LONGINT n__len) +{ + INTEGER _o_result; + if (Platform_deleteFile(n, n__len) == 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Chdir (CHAR *n, LONGINT n__len) +{ + INTEGER _o_result; + INTEGER r; + r = Platform_setCurrentDirectory(n, n__len); + if (r == 0) { + _o_result = Platform_err(); + return _o_result; + } + Platform_getCurrentDirectory((void*)Platform_CWD, ((LONGINT)(4096))); + _o_result = 0; + return _o_result; +} + +INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len) +{ + INTEGER _o_result; + if (Platform_moveFile(o, o__len, n, n__len) == 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +void Platform_Exit (INTEGER code) +{ + Platform_exit(code); +} + +static void Platform_errch (CHAR c) +{ + Platform_errc(c); +} + +static void Platform_errln (void) +{ + Platform_errch(0x0d); + Platform_errch(0x0a); +} + +static void Platform_errposint (LONGINT l) +{ + if (l > 10) { + Platform_errposint(__DIV(l, 10)); + } + Platform_errch((CHAR)(48 + __MOD(l, 10))); +} + +static void Platform_errint (LONGINT l) +{ + if (l < 0) { + Platform_errch('-'); + l = -l; + } + Platform_errposint(l); +} + +static void Platform_DisplayHaltCode (LONGINT code) +{ + switch (code) { + case -1: + Platform_errstring((CHAR*)"Rider ReadBuf/WriteBuf transfer size longer than buffer.", (LONGINT)57); + break; + case -2: + Platform_errstring((CHAR*)"Index out of range.", (LONGINT)20); + break; + case -3: + Platform_errstring((CHAR*)"Reached end of function without reaching RETURN.", (LONGINT)49); + break; + case -4: + Platform_errstring((CHAR*)"CASE statement: no matching label and no ELSE.", (LONGINT)47); + break; + case -5: + Platform_errstring((CHAR*)"Type guard failed.", (LONGINT)19); + break; + case -6: + Platform_errstring((CHAR*)"Type equality failed.", (LONGINT)22); + break; + case -7: + Platform_errstring((CHAR*)"WITH statement type guard failed.", (LONGINT)34); + break; + case -8: + Platform_errstring((CHAR*)"SHORT: Value too large for shorter type.", (LONGINT)41); + break; + case -9: + Platform_errstring((CHAR*)"Heap interrupted while locked, but lockdepth = 0 at unlock.", (LONGINT)60); + break; + case -15: + Platform_errstring((CHAR*)"Type descriptor size mismatch.", (LONGINT)31); + break; + case -20: + Platform_errstring((CHAR*)"Too many, or negative number of, elements in dynamic array.", (LONGINT)60); + break; + default: + break; + } +} + +void Platform_Halt (LONGINT code) +{ + INTEGER e; + Platform_HaltCode = code; + if (Platform_HaltHandler != NIL) { + (*Platform_HaltHandler)(code); + } + Platform_errstring((CHAR*)"Terminated by Halt(", (LONGINT)20); + Platform_errint(code); + Platform_errstring((CHAR*)"). ", (LONGINT)4); + if (code < 0) { + Platform_DisplayHaltCode(code); + } + Platform_errln(); + Platform_exit(__VAL(INTEGER, code)); +} + +void Platform_AssertFail (LONGINT code) +{ + INTEGER e; + Platform_errstring((CHAR*)"Assertion failure.", (LONGINT)19); + if (code != 0) { + Platform_errstring((CHAR*)" ASSERT code ", (LONGINT)14); + Platform_errint(code); + Platform_errstring((CHAR*)".", (LONGINT)2); + } + Platform_errln(); + Platform_exit(__VAL(INTEGER, code)); +} + +void Platform_SetHalt (Platform_HaltProcedure p) +{ + Platform_HaltHandler = p; +} + +static void Platform_TestLittleEndian (void) +{ + INTEGER i; + i = 1; + __GET((LONGINT)(uintptr_t)&i, Platform_LittleEndian, BOOLEAN); +} + +__TDESC(Platform_FileIdentity, 1, 0) = {__TDFLDS("FileIdentity", 20), {-4}}; + +export void *Platform__init(void) +{ + __DEFMOD; + __REGMOD("Platform", 0); + __INITYP(Platform_FileIdentity, Platform_FileIdentity, 0); +/* BEGIN */ + Platform_TestLittleEndian(); + Platform_HaltCode = -128; + Platform_HaltHandler = NIL; + Platform_TimeStart = Platform_Time(); + Platform_CWD[0] = 0x00; + Platform_getCurrentDirectory((void*)Platform_CWD, ((LONGINT)(4096))); + Platform_PID = Platform_getpid(); + Platform_SeekSet = Platform_seekset(); + Platform_SeekCur = Platform_seekcur(); + Platform_SeekEnd = Platform_seekend(); + Platform_StdIn = Platform_getstdinhandle(); + Platform_StdOut = Platform_getstdouthandle(); + Platform_StdErr = Platform_getstderrhandle(); + Platform_nl[0] = 0x0d; + Platform_nl[1] = 0x0a; + Platform_nl[2] = 0x00; + __ENDMOD; +} diff --git a/bootstrap/windows-48/Platform.h b/bootstrap/windows-48/Platform.h new file mode 100644 index 00000000..e912678e --- /dev/null +++ b/bootstrap/windows-48/Platform.h @@ -0,0 +1,84 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Platform__h +#define Platform__h + +#include "SYSTEM.h" + +typedef + struct Platform_FileIdentity { + LONGINT _prvt0; + char _prvt1[16]; + } Platform_FileIdentity; + +typedef + void (*Platform_HaltProcedure)(LONGINT); + +typedef + void (*Platform_SignalHandler)(INTEGER); + + +import BOOLEAN Platform_LittleEndian; +import LONGINT Platform_MainStackFrame, Platform_HaltCode; +import INTEGER Platform_PID; +import CHAR Platform_CWD[4096]; +import INTEGER Platform_ArgCount; +import LONGINT Platform_ArgVector; +import INTEGER Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd; +import LONGINT Platform_StdIn, Platform_StdOut, Platform_StdErr; +import CHAR Platform_nl[3]; + +import LONGINT *Platform_FileIdentity__typ; + +import BOOLEAN Platform_Absent (INTEGER e); +import INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len); +import void Platform_AssertFail (LONGINT code); +import INTEGER Platform_Chdir (CHAR *n, LONGINT n__len); +import INTEGER Platform_Close (LONGINT h); +import BOOLEAN Platform_ConnectionFailed (INTEGER e); +import void Platform_Delay (LONGINT ms); +import BOOLEAN Platform_DifferentFilesystems (INTEGER e); +import INTEGER Platform_Error (void); +import void Platform_Exit (INTEGER code); +import void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len); +import void Platform_GetClock (LONGINT *t, LONGINT *d); +import void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len); +import void Platform_GetIntArg (INTEGER n, LONGINT *val); +import void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec); +import void Platform_Halt (LONGINT code); +import INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ); +import INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ); +import BOOLEAN Platform_Inaccessible (INTEGER e); +import void Platform_Init (INTEGER argc, LONGINT argvadr); +import void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d); +import INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h); +import BOOLEAN Platform_NoSuchDirectory (INTEGER e); +import LONGINT Platform_OSAllocate (LONGINT size); +import void Platform_OSFree (LONGINT address); +import INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h); +import INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h); +import INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n); +import INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n); +import INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len); +import BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2); +import BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2); +import INTEGER Platform_Seek (LONGINT h, LONGINT o, INTEGER r); +import void Platform_SetBadInstructionHandler (Platform_SignalHandler handler); +import void Platform_SetHalt (Platform_HaltProcedure p); +import void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source); +import INTEGER Platform_Size (LONGINT h, LONGINT *l); +import INTEGER Platform_Sync (LONGINT h); +import INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len); +import LONGINT Platform_Time (void); +import BOOLEAN Platform_TimedOut (INTEGER e); +import BOOLEAN Platform_TooManyFiles (INTEGER e); +import INTEGER Platform_Truncate (LONGINT h, LONGINT limit); +import INTEGER Platform_Unlink (CHAR *n, LONGINT n__len); +import INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l); +import BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len); +import void *Platform__init(void); + +#define Platform_SetInterruptHandler(h) SystemSetInterruptHandler((uintptr_t)h) +#define Platform_SetQuitHandler(h) SystemSetQuitHandler((uintptr_t)h) + +#endif diff --git a/bootstrap/windows-48/Reals.c b/bootstrap/windows-48/Reals.c new file mode 100644 index 00000000..65dad750 --- /dev/null +++ b/bootstrap/windows-48/Reals.c @@ -0,0 +1,155 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" + + + + +export void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len); +export void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len); +export void Reals_ConvertHL (LONGREAL y, CHAR *d, LONGINT d__len); +export void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len); +export INTEGER Reals_Expo (REAL x); +export INTEGER Reals_ExpoL (LONGREAL x); +export REAL Reals_Ten (INTEGER e); +export LONGREAL Reals_TenL (INTEGER e); +static CHAR Reals_ToHex (INTEGER i); + + +REAL Reals_Ten (INTEGER e) +{ + REAL _o_result; + LONGREAL r, power; + r = (LONGREAL)1; + power = (LONGREAL)10; + while (e > 0) { + if (__ODD(e)) { + r = r * power; + } + power = power * power; + e = __ASHR(e, 1); + } + _o_result = r; + return _o_result; +} + +LONGREAL Reals_TenL (INTEGER e) +{ + LONGREAL _o_result; + LONGREAL r, power; + r = (LONGREAL)1; + power = (LONGREAL)10; + for (;;) { + if (__ODD(e)) { + r = r * power; + } + e = __ASHR(e, 1); + if (e <= 0) { + _o_result = r; + return _o_result; + } + power = power * power; + } + __RETCHK; +} + +INTEGER Reals_Expo (REAL x) +{ + INTEGER _o_result; + _o_result = (int)__MASK(__ASHR((LONGINT)(__VAL(INTEGER, x)), 23), -256); + return _o_result; +} + +INTEGER Reals_ExpoL (LONGREAL x) +{ + INTEGER _o_result; + INTEGER i; + LONGINT l; + __GET((LONGINT)(uintptr_t)&x + 4, l, LONGINT); + _o_result = (int)__MASK(__ASHR(l, 20), -2048); + return _o_result; +} + +void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len) +{ + LONGINT i, j, k; + if (x < (LONGREAL)0) { + x = -x; + } + k = 0; + if (n > 9) { + i = __ENTIER(x / (LONGREAL)(LONGREAL)1000000000); + j = __ENTIER(x - i * (LONGREAL)1000000000); + if (j < 0) { + j = 0; + } + while (k < 9) { + d[__X(k, d__len)] = (CHAR)(__MOD(j, 10) + 48); + j = __DIV(j, 10); + k += 1; + } + } else { + i = __ENTIER(x); + } + while (k < (LONGINT)n) { + d[__X(k, d__len)] = (CHAR)(__MOD(i, 10) + 48); + i = __DIV(i, 10); + k += 1; + } +} + +void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len) +{ + Reals_ConvertL(x, n, (void*)d, d__len); +} + +static CHAR Reals_ToHex (INTEGER i) +{ + CHAR _o_result; + if (i < 10) { + _o_result = (CHAR)(i + 48); + return _o_result; + } else { + _o_result = (CHAR)(i + 55); + return _o_result; + } + __RETCHK; +} + +typedef + CHAR (*pc4__3)[4]; + +void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len) +{ + pc4__3 p = NIL; + INTEGER i; + p = (pc4__3)(uintptr_t)((LONGINT)(uintptr_t)&y); + i = 0; + while (i < 4) { + d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((int)(*p)[__X(i, ((LONGINT)(4)))], 4)); + d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((int)(*p)[__X(i, ((LONGINT)(4)))], -16)); + } +} + +typedef + CHAR (*pc8__5)[8]; + +void Reals_ConvertHL (LONGREAL y, CHAR *d, LONGINT d__len) +{ + pc8__5 p = NIL; + INTEGER i; + p = (pc8__5)(uintptr_t)((LONGINT)(uintptr_t)&y); + i = 0; + while (i < 8) { + d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((int)(*p)[__X(i, ((LONGINT)(8)))], 4)); + d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((int)(*p)[__X(i, ((LONGINT)(8)))], -16)); + } +} + + +export void *Reals__init(void) +{ + __DEFMOD; + __REGMOD("Reals", 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/windows-48/Reals.h b/bootstrap/windows-48/Reals.h new file mode 100644 index 00000000..166e977b --- /dev/null +++ b/bootstrap/windows-48/Reals.h @@ -0,0 +1,22 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Reals__h +#define Reals__h + +#include "SYSTEM.h" + + + + +import void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len); +import void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len); +import void Reals_ConvertHL (LONGREAL y, CHAR *d, LONGINT d__len); +import void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len); +import INTEGER Reals_Expo (REAL x); +import INTEGER Reals_ExpoL (LONGREAL x); +import REAL Reals_Ten (INTEGER e); +import LONGREAL Reals_TenL (INTEGER e); +import void *Reals__init(void); + + +#endif diff --git a/bootstrap/windows-48/SYSTEM.c b/bootstrap/windows-48/SYSTEM.c new file mode 100644 index 00000000..0fcc5ee2 --- /dev/null +++ b/bootstrap/windows-48/SYSTEM.c @@ -0,0 +1,207 @@ +/* +* The body prefix file of the voc(jet backend) runtime system, Version 1.0 +* +* Copyright (c) Software Templ, 1994, 1995 +* +* Module SYSTEM is subject to change any time without prior notification. +* Software Templ disclaims all warranties with regard to module SYSTEM, +* in particular shall Software Templ not be liable for any damage resulting +* from inappropriate use or modification of module SYSTEM. +* +* Version 1.1 jt, 24.11.95 fixes for correct pointer arithmetic on Cray computers +* jt 31.1.2007 ANSI prototypes for malloc and exit in order to avoid cc warnings +* +*/ + +#include "SYSTEM.h" +#include "stdarg.h" +#include + + +LONGINT SYSTEM_XCHK(LONGINT i, LONGINT ub) {return __X(i, ub);} +LONGINT SYSTEM_RCHK(LONGINT i, LONGINT ub) {return __R(i, ub);} +LONGINT SYSTEM_ASH (LONGINT i, LONGINT n) {return __ASH(i, n);} +LONGINT SYSTEM_ABS (LONGINT i) {return __ABS(i);} +double SYSTEM_ABSD(double i) {return __ABS(i);} + +void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0) +{ + t -= __TPROC0OFF; + t0 -= __TPROC0OFF; + while (*t0 != __EOM) {*t = *t0; t--; t0--;} +} + + +void SYSTEM_ENUMP(void *adr, LONGINT n, void (*P)()) +{ + while (n > 0) { + P((LONGINT)(uintptr_t)(*((void**)(adr)))); + adr = ((void**)adr) + 1; + n--; + } +} + +void SYSTEM_ENUMR(void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)()) +{ + LONGINT *t, off; + typ++; + while (n > 0) { + t = typ; + off = *t; + while (off >= 0) {P(*(LONGINT*)((char*)adr+off)); t++; off = *t;} + adr = ((char*)adr) + size; + n--; + } +} + +LONGINT SYSTEM_DIV(unsigned LONGINT x, unsigned LONGINT y) +{ if ((LONGINT) x >= 0) return (x / y); + else return -((y - 1 - x) / y); +} + +LONGINT SYSTEM_MOD(unsigned LONGINT x, unsigned LONGINT y) +{ unsigned LONGINT m; + if ((LONGINT) x >= 0) return (x % y); + else { m = (-x) % y; + if (m != 0) return (y - m); else return 0; + } +} + +LONGINT SYSTEM_ENTIER(double x) +{ + LONGINT y; + if (x >= 0) + return (LONGINT)x; + else { + y = (LONGINT)x; + if (y <= x) return y; else return y - 1; + } +} + +extern void Heap_Lock(); +extern void Heap_Unlock(); + +SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim, int nofdyn, ...) +{ + LONGINT nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off; + va_list ap; + va_start(ap, nofdyn); + nofelems = 1; + while (nofdim > 0) { + nofelems = nofelems * va_arg(ap, LONGINT); nofdim--; + if (nofelems <= 0) __HALT(-20); + } + va_end(ap); + dataoff = nofdyn * sizeof(LONGINT); + if (elemalgn > sizeof(LONGINT)) { + n = dataoff % elemalgn; + if (n != 0) dataoff += elemalgn - n; + } + size = dataoff + nofelems * elemsz; + Heap_Lock(); + if (typ == NIL) { + /* element typ does not contain pointers */ + x = Heap_NEWBLK(size); + } + else if (typ == (LONGINT*)POINTER__typ) { + /* element type is a pointer */ + x = Heap_NEWBLK(size + nofelems * sizeof(LONGINT)); + p = (LONGINT*)(uintptr_t)x[-1]; + p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ + p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */ + while (n <= nofelems) {*p = n*sizeof(LONGINT); p++; n++;} + *p = - (nofelems + 1) * sizeof(LONGINT); /* sentinel */ + x[-1] -= nofelems * sizeof(LONGINT); + } + else { + /* element type is a record that contains pointers */ + ptab = typ + 1; nofptrs = 0; + while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */ + nptr = nofelems * nofptrs; /* total number of pointers */ + x = Heap_NEWBLK(size + nptr * sizeof(LONGINT)); + p = (LONGINT*)(uintptr_t)x[- 1]; + p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ + p -= nptr - 1; n = 0; off = dataoff; + while (n < nofelems) {i = 0; + while (i < nofptrs) {*p = off + ptab[i]; p++; i++;} + off += elemsz; n++; + } + *p = - (nptr + 1) * sizeof(LONGINT); /* sentinel */ + x[-1] -= nptr * sizeof(LONGINT); + } + if (nofdyn != 0) { + /* setup len vector for index checks */ + va_start(ap, nofdyn); + p = x; + while (nofdyn > 0) {*p = va_arg(ap, LONGINT); p++, nofdyn--;} + va_end(ap); + } + Heap_Unlock(); + return x; +} + + + + +typedef void (*SystemSignalHandler)(INTEGER); // = Platform_SignalHandler + +#ifndef _WIN32 + + SystemSignalHandler handler[3] = {0}; + + // Provide signal handling for Unix based systems + void signalHandler(int s) { + if (s >= 2 && s <= 4) handler[s-2](s); + // (Ignore other signals) + } + + void SystemSetHandler(int s, uintptr_t h) { + if (s >= 2 && s <= 4) { + int needtosetsystemhandler = handler[s-2] == 0; + handler[s-2] = (SystemSignalHandler)h; + if (needtosetsystemhandler) {signal(s, signalHandler);} + } + } + +#else + + // Provides Windows callback handlers for signal-like scenarios + #include "WindowsWrapper.h" + + SystemSignalHandler SystemInterruptHandler = 0; + SystemSignalHandler SystemQuitHandler = 0; + BOOL ConsoleCtrlHandlerSet = FALSE; + + BOOL WINAPI SystemConsoleCtrlHandler(DWORD ctrlType) { + if ((ctrlType == CTRL_C_EVENT) || (ctrlType == CTRL_BREAK_EVENT)) { + if (SystemInterruptHandler) { + SystemInterruptHandler(2); // SIGINT + return TRUE; + } + } else { // Close, logoff or shutdown + if (SystemQuitHandler) { + SystemQuitHandler(3); // SIGQUIT + return TRUE; + } + } + return FALSE; + } + + void EnsureConsoleCtrlHandler() { + if (!ConsoleCtrlHandlerSet) { + SetConsoleCtrlHandler(SystemConsoleCtrlHandler, TRUE); + ConsoleCtrlHandlerSet = TRUE; + } + } + + void SystemSetInterruptHandler(uintptr_t h) { + EnsureConsoleCtrlHandler(); + SystemInterruptHandler = (SystemSignalHandler)h; + } + + void SystemSetQuitHandler(uintptr_t h) { + EnsureConsoleCtrlHandler(); + SystemQuitHandler = (SystemSignalHandler)h; + } + +#endif diff --git a/bootstrap/windows-48/SYSTEM.h b/bootstrap/windows-48/SYSTEM.h new file mode 100644 index 00000000..f9e2f930 --- /dev/null +++ b/bootstrap/windows-48/SYSTEM.h @@ -0,0 +1,275 @@ +#ifndef SYSTEM__h +#define SYSTEM__h + +#ifndef _WIN32 + + // Building for a Unix/Linux based system + #include // For memcpy ... + #include // For uintptr_t ... + +#else + + // Building for Windows platform with either mingw under cygwin, or the MS C compiler + #ifdef _WIN64 + typedef unsigned long long size_t; + typedef unsigned long long uintptr_t; + #else + typedef unsigned int size_t; + typedef unsigned int uintptr_t; + #endif /* _WIN64 */ + + typedef unsigned int uint32_t; + void * __cdecl memcpy(void * dest, const void * source, size_t size); + +#endif + + +// The compiler uses 'import' and 'export' which translate to 'extern' and +// nothing respectively. + +#define import extern +#define export + + + +// Known constants + +#define NIL ((void*)0) +#define __MAXEXT 16 +#define POINTER__typ ((LONGINT*)(1)) // not NIL and not a valid type + + +// Oberon types + +#define BOOLEAN char +#define SYSTEM_BYTE unsigned char +#define CHAR unsigned char +#define SHORTINT signed char +#define REAL float +#define LONGREAL double +#define SYSTEM_PTR void* + +// For 32 bit builds, the size of LONGINT depends on a make option: + +#if (__SIZEOF_POINTER__ == 8) || defined(LARGE) || defined(_WIN64) + #define INTEGER int // INTEGER is 32 bit. + #define LONGINT long long // LONGINT is 64 bit. (long long is always 64 bits, while long can be 32 bits e.g. under MSC/MingW) +#else + #define INTEGER short int // INTEGER is 16 bit. + #define LONGINT long // LONGINT is 32 bit. +#endif + +#define SET unsigned LONGINT + + +// OS Memory allocation interfaces are in PlatformXXX.Mod + +extern LONGINT Platform_OSAllocate (LONGINT size); +extern void Platform_OSFree (LONGINT addr); + + +// Run time system routines in SYSTEM.c + +extern LONGINT SYSTEM_XCHK (LONGINT i, LONGINT ub); +extern LONGINT SYSTEM_RCHK (LONGINT i, LONGINT ub); +extern LONGINT SYSTEM_ASH (LONGINT i, LONGINT n); +extern LONGINT SYSTEM_ABS (LONGINT i); +extern double SYSTEM_ABSD (double i); +extern void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0); +extern void SYSTEM_ENUMP (void *adr, LONGINT n, void (*P)()); +extern void SYSTEM_ENUMR (void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)()); +extern LONGINT SYSTEM_DIV (unsigned LONGINT x, unsigned LONGINT y); +extern LONGINT SYSTEM_MOD (unsigned LONGINT x, unsigned LONGINT y); +extern LONGINT SYSTEM_ENTIER (double x); + + +// Signal handling in SYSTEM.c + +#ifndef _WIN32 + extern void SystemSetHandler(int s, uintptr_t h); +#else + extern void SystemSetInterruptHandler(uintptr_t h); + extern void SystemSetQuitHandler (uintptr_t h); +#endif + + + +// String comparison + +static int __str_cmp(CHAR *x, CHAR *y){ + LONGINT i = 0; + CHAR ch1, ch2; + do {ch1 = x[i]; ch2 = y[i]; i++; + if (!ch1) return -(int)ch2; + } while (ch1==ch2); + return (int)ch1 - (int)ch2; +} +#define __STRCMP(a,b) __str_cmp((CHAR*)(a), (CHAR*)(b)) + + + +// Inline string, record and array copy + +#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d; LONGINT _i=0,_t=n-1; \ + while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;} +#define __DUP(x, l, t) x=(void*)memcpy((void*)(uintptr_t)Platform_OSAllocate(l*sizeof(t)),x,l*sizeof(t)) +#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t)) +#define __DEL(x) Platform_OSFree((LONGINT)(uintptr_t)x) + + + + +/* SYSTEM ops */ + +#define __VAL(t, x) ((t)(x)) +#define __VALP(t, x) ((t)(uintptr_t)(x)) + +#define __GET(a, x, t) x= *(t*)(uintptr_t)(a) +#define __PUT(a, x, t) *(t*)(uintptr_t)(a)=x +#define __LSHL(x, n, t) ((t)((unsigned t)(x)<<(n))) +#define __LSHR(x, n, t) ((t)((unsigned t)(x)>>(n))) +#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) +#define __ROTL(x, n, t) ((t)((unsigned t)(x)<<(n)|(unsigned t)(x)>>(8*sizeof(t)-(n)))) +#define __ROTR(x, n, t) ((t)((unsigned t)(x)>>(n)|(unsigned t)(x)<<(8*sizeof(t)-(n)))) +#define __LSHR(x, n, t) ((t)((unsigned t)(x)>>(n))) +#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) +#define __ROTL(x, n, t) ((t)((unsigned t)(x)<<(n)|(unsigned t)(x)>>(8*sizeof(t)-(n)))) +#define __ROTR(x, n, t) ((t)((unsigned t)(x)>>(n)|(unsigned t)(x)<<(8*sizeof(t)-(n)))) +#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t)) +#define __BIT(x, n) (*(unsigned LONGINT*)(x)>>(n)&1) +#define __MOVE(s, d, n) memcpy((char*)(uintptr_t)(d),(char*)(uintptr_t)(s),n) +#define __ASHL(x, n) ((LONGINT)(x)<<(n)) +#define __ASHR(x, n) ((LONGINT)(x)>>(n)) +#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n))) +#define __ASHF(x, n) SYSTEM_ASH((LONGINT)(x), (LONGINT)(n)) +#define __SHORT(x, y) ((int)((unsigned LONGINT)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0))) +#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y))) +#define __CHR(x) ((CHAR)__R(x, 256)) +#define __CHRF(x) ((CHAR)__RF(x, 256)) +#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y))) +#define __DIVF(x, y) SYSTEM_DIV((LONGINT)(x),(LONGINT)(y)) +#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y)) +#define __MODF(x, y) SYSTEM_MOD((LONGINT)(x),(LONGINT)(y)) +#define __ENTIER(x) SYSTEM_ENTIER(x) +#define __ABS(x) (((x)<0)?-(x):(x)) +#define __ABSF(x) SYSTEM_ABS((LONGINT)(x)) +#define __ABSFD(x) SYSTEM_ABSD((double)(x)) +#define __CAP(ch) ((CHAR)((ch)&0x5f)) +#define __ODD(x) ((x)&1) +#define __IN(x, s) (((s)>>(x))&1) +#define __SETOF(x) ((SET)1<<(x)) +#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h))) +#define __MASK(x, m) ((x)&~(m)) + + + +// Runtime checks + +#define __X(i, ub) (((unsigned LONGINT)(i)<(unsigned LONGINT)(ub))?i:(__HALT(-2),0)) +#define __XF(i, ub) SYSTEM_XCHK((LONGINT)(i), (LONGINT)(ub)) +#define __R(i, ub) (((unsigned LONGINT)(i)<(unsigned LONGINT)(ub))?i:(__HALT(-8),0)) +#define __RF(i, ub) SYSTEM_RCHK((LONGINT)(i),(LONGINT)(ub)) +#define __RETCHK __retchk: __HALT(-3); return 0; +#define __CASECHK __HALT(-4) +#define __WITHCHK __HALT(-7) + +#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p))) +#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r)))) +#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p))) +#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p) +#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p) + + + +// Module entry/registration/exit + +extern void Heap_REGCMD(); +extern SYSTEM_PTR Heap_REGMOD(); +extern void Heap_REGTYP(); +extern void Heap_INCREF(); + +#define __DEFMOD static void *m; if (m!=0) {return m;} +#define __REGCMD(name, cmd) Heap_REGCMD(m, (CHAR*)name, cmd) +#define __REGMOD(name, enum) if (m==0) {m = Heap_REGMOD((CHAR*)name,enum);} +#define __ENDMOD return m +#define __MODULE_IMPORT(name) Heap_INCREF(name##__init()) + + + +// Main module initialisation, registration and finalisation + +extern void Platform_Init(INTEGER argc, LONGINT argv); +extern void *Platform_MainModule; +extern void Heap_FINALL(); + +#define __INIT(argc, argv) static void *m; Platform_Init((INTEGER)argc, (LONGINT)(uintptr_t)&argv); +#define __REGMAIN(name, enum) m = Heap_REGMOD((CHAR*)name,enum) +#define __FINI Heap_FINALL(); return 0 + + +// Assertions and Halts + +extern void Platform_Halt(LONGINT x); +extern void Platform_AssertFail(LONGINT x); + +#define __HALT(x) Platform_Halt(x) +#define __ASSERT(cond, x) if (!(cond)) Platform_AssertFail((LONGINT)(x)) + + +// Memory allocation + +extern SYSTEM_PTR Heap_NEWBLK (LONGINT size); +extern SYSTEM_PTR Heap_NEWREC (LONGINT tag); +extern SYSTEM_PTR SYSTEM_NEWARR(LONGINT*, LONGINT, int, int, int, ...); + +#define __SYSNEW(p, len) p = Heap_NEWBLK((LONGINT)(len)) +#define __NEW(p, t) p = Heap_NEWREC((LONGINT)(uintptr_t)t##__typ) +#define __NEWARR SYSTEM_NEWARR + + + +/* Type handling */ + +#define __TDESC(t, m, n) \ + static struct t##__desc { \ + LONGINT tproc[m]; /* Proc for each ptr field */ \ + LONGINT tag; \ + LONGINT next; /* Module table type list points here */ \ + LONGINT level; \ + LONGINT module; \ + char name[24]; \ + LONGINT basep[__MAXEXT]; /* List of bases this extends */ \ + LONGINT reserved; \ + LONGINT blksz; /* xxx_typ points here */ \ + LONGINT ptr[n+1]; /* Offsets of ptrs up to -ve sentinel */ \ + } t##__desc + +#define __BASEOFF (__MAXEXT+1) // blksz as index to base. +#define __TPROC0OFF (__BASEOFF+24/sizeof(LONGINT)+5) // blksz as index to tproc IFF m=1. +#define __EOM 1 +#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size +#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (LONGINT)(n), P) +#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (LONGINT)(size), (LONGINT)(n), P) + +#define __INITYP(t, t0, level) \ + t##__typ = (LONGINT*)&t##__desc.blksz; \ + memcpy(t##__desc.basep, t0##__typ - __BASEOFF, level*sizeof(LONGINT)); \ + t##__desc.basep[level] = (LONGINT)(uintptr_t)t##__typ; \ + t##__desc.module = (LONGINT)(uintptr_t)m; \ + if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \ + t##__desc.blksz = (t##__desc.blksz+5*sizeof(LONGINT)-1)/(4*sizeof(LONGINT))*(4*sizeof(LONGINT)); \ + Heap_REGTYP(m, (LONGINT)(uintptr_t)&t##__desc.next); \ + SYSTEM_INHERIT(t##__typ, t0##__typ) + +#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(LONGINT)(uintptr_t)typ##__typ) +#define __TYPEOF(p) ((LONGINT*)(uintptr_t)(*(((LONGINT*)(p))-1))) +#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level) + +// Oberon-2 type bound procedures support +#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(LONGINT)(uintptr_t)proc +#define __SEND(typ, num, funtyp, parlist) ((funtyp)((uintptr_t)*(typ-(__TPROC0OFF+num))))parlist + + + + +#endif diff --git a/bootstrap/windows-48/Strings.c b/bootstrap/windows-48/Strings.c new file mode 100644 index 00000000..5038ca68 --- /dev/null +++ b/bootstrap/windows-48/Strings.c @@ -0,0 +1,243 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" + + + + +export void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len); +export void Strings_Cap (CHAR *s, LONGINT s__len); +export void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n); +export void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len); +export void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len); +export INTEGER Strings_Length (CHAR *s, LONGINT s__len); +export BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len); +export INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos); +export void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len); + + +INTEGER Strings_Length (CHAR *s, LONGINT s__len) +{ + INTEGER _o_result; + INTEGER i; + __DUP(s, s__len, CHAR); + i = 0; + while (((LONGINT)i < s__len && s[__X(i, s__len)] != 0x00)) { + i += 1; + } + _o_result = i; + __DEL(s); + return _o_result; +} + +void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len) +{ + INTEGER n1, n2, i; + __DUP(extra, extra__len, CHAR); + n1 = Strings_Length(dest, dest__len); + n2 = Strings_Length(extra, extra__len); + i = 0; + while ((i < n2 && (LONGINT)(i + n1) < dest__len)) { + dest[__X(i + n1, dest__len)] = extra[__X(i, extra__len)]; + i += 1; + } + if ((LONGINT)(i + n1) < dest__len) { + dest[__X(i + n1, dest__len)] = 0x00; + } + __DEL(extra); +} + +void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len) +{ + INTEGER n1, n2, i; + __DUP(source, source__len, CHAR); + n1 = Strings_Length(dest, dest__len); + n2 = Strings_Length(source, source__len); + if (pos < 0) { + pos = 0; + } + if (pos > n1) { + Strings_Append(dest, dest__len, (void*)source, source__len); + return; + } + if ((LONGINT)(pos + n2) < dest__len) { + i = n1; + while (i >= pos) { + if ((LONGINT)(i + n2) < dest__len) { + dest[__X(i + n2, dest__len)] = dest[__X(i, dest__len)]; + } + i -= 1; + } + } + i = 0; + while (i < n2) { + dest[__X(pos + i, dest__len)] = source[__X(i, source__len)]; + i += 1; + } + __DEL(source); +} + +void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n) +{ + INTEGER len, i; + len = Strings_Length(s, s__len); + if (pos < 0) { + pos = 0; + } else if (pos >= len) { + return; + } + if (pos + n < len) { + i = pos + n; + while (i < len) { + s[__X(i - n, s__len)] = s[__X(i, s__len)]; + i += 1; + } + if ((LONGINT)(i - n) < s__len) { + s[__X(i - n, s__len)] = 0x00; + } + } else { + s[__X(pos, s__len)] = 0x00; + } +} + +void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len) +{ + __DUP(source, source__len, CHAR); + Strings_Delete((void*)dest, dest__len, pos, pos + Strings_Length(source, source__len)); + Strings_Insert(source, source__len, pos, (void*)dest, dest__len); + __DEL(source); +} + +void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len) +{ + INTEGER len, destLen, i; + __DUP(source, source__len, CHAR); + len = Strings_Length(source, source__len); + destLen = (int)dest__len - 1; + if (pos < 0) { + pos = 0; + } + if (pos >= len) { + dest[0] = 0x00; + return; + } + i = 0; + while (((((LONGINT)(pos + i) <= source__len && source[__X(pos + i, source__len)] != 0x00)) && i < n)) { + if (i < destLen) { + dest[__X(i, dest__len)] = source[__X(pos + i, source__len)]; + } + i += 1; + } + dest[__X(i, dest__len)] = 0x00; + __DEL(source); +} + +INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos) +{ + INTEGER _o_result; + INTEGER n1, n2, i, j; + __DUP(pattern, pattern__len, CHAR); + __DUP(s, s__len, CHAR); + n1 = Strings_Length(s, s__len); + n2 = Strings_Length(pattern, pattern__len); + if (n2 == 0) { + _o_result = 0; + __DEL(pattern); + __DEL(s); + return _o_result; + } + i = pos; + while (i <= n1 - n2) { + if (s[__X(i, s__len)] == pattern[0]) { + j = 1; + while ((j < n2 && s[__X(i + j, s__len)] == pattern[__X(j, pattern__len)])) { + j += 1; + } + if (j == n2) { + _o_result = i; + __DEL(pattern); + __DEL(s); + return _o_result; + } + } + i += 1; + } + _o_result = -1; + __DEL(pattern); + __DEL(s); + return _o_result; +} + +void Strings_Cap (CHAR *s, LONGINT s__len) +{ + INTEGER i; + i = 0; + while (s[__X(i, s__len)] != 0x00) { + if (('a' <= s[__X(i, s__len)] && s[__X(i, s__len)] <= 'z')) { + s[__X(i, s__len)] = __CAP(s[__X(i, s__len)]); + } + i += 1; + } +} + +static struct Match__7 { + struct Match__7 *lnk; +} *Match__7_s; + +static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INTEGER n, INTEGER m); + +static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INTEGER n, INTEGER m) +{ + BOOLEAN _o_result; + while ((((n >= 0 && m >= 0)) && mask[__X(m, mask__len)] != '*')) { + if (name[__X(n, name__len)] != mask[__X(m, mask__len)]) { + _o_result = 0; + return _o_result; + } + n -= 1; + m -= 1; + } + if (m < 0) { + _o_result = n < 0; + return _o_result; + } + while ((m >= 0 && mask[__X(m, mask__len)] == '*')) { + m -= 1; + } + if (m < 0) { + _o_result = 1; + return _o_result; + } + while (n >= 0) { + if (M__8(name, name__len, mask, mask__len, n, m)) { + _o_result = 1; + return _o_result; + } + n -= 1; + } + _o_result = 0; + return _o_result; +} + +BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len) +{ + BOOLEAN _o_result; + struct Match__7 _s; + __DUP(string, string__len, CHAR); + __DUP(pattern, pattern__len, CHAR); + _s.lnk = Match__7_s; + Match__7_s = &_s; + _o_result = M__8((void*)string, string__len, (void*)pattern, pattern__len, Strings_Length(string, string__len) - 1, Strings_Length(pattern, pattern__len) - 1); + Match__7_s = _s.lnk; + __DEL(string); + __DEL(pattern); + return _o_result; +} + + +export void *Strings__init(void) +{ + __DEFMOD; + __REGMOD("Strings", 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/windows-48/Strings.h b/bootstrap/windows-48/Strings.h new file mode 100644 index 00000000..a8d8d207 --- /dev/null +++ b/bootstrap/windows-48/Strings.h @@ -0,0 +1,23 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Strings__h +#define Strings__h + +#include "SYSTEM.h" + + + + +import void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len); +import void Strings_Cap (CHAR *s, LONGINT s__len); +import void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n); +import void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len); +import void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len); +import INTEGER Strings_Length (CHAR *s, LONGINT s__len); +import BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len); +import INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos); +import void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len); +import void *Strings__init(void); + + +#endif diff --git a/bootstrap/windows-48/Texts.c b/bootstrap/windows-48/Texts.c new file mode 100644 index 00000000..8c2cc3b2 --- /dev/null +++ b/bootstrap/windows-48/Texts.c @@ -0,0 +1,1838 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "Files.h" +#include "Modules.h" +#include "Reals.h" + +typedef + struct Texts_RunDesc *Texts_Run; + +typedef + struct Texts_FontDesc *Texts_FontsFont; + +typedef + struct Texts_RunDesc { + Texts_Run prev, next; + LONGINT len; + Texts_FontsFont fnt; + SHORTINT col, voff; + BOOLEAN ascii; + } Texts_RunDesc; + +typedef + struct Texts_ElemDesc *Texts_Elem; + +typedef + struct Texts_ElemMsg { + char _prvt0[1]; + } Texts_ElemMsg; + +typedef + void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, LONGINT *); + +typedef + struct Texts_TextDesc *Texts_Text; + +typedef + struct Texts_ElemDesc { + Texts_Run prev, next; + LONGINT len; + Texts_FontsFont fnt; + SHORTINT col, voff; + BOOLEAN ascii; + LONGINT W, H; + Texts_Handler handle; + Texts_Text base; + } Texts_ElemDesc; + +struct Texts__1 { /* Texts_ElemDesc */ + Texts_Run prev, next; + LONGINT len; + Texts_FontsFont fnt; + SHORTINT col, voff; + BOOLEAN ascii; + LONGINT W, H; + Texts_Handler handle; + Texts_Text base; + Files_File file; + LONGINT org, span; + CHAR mod[32], proc[32]; +}; + +typedef + struct Texts__1 *Texts_Alien; + +typedef + struct Texts_BufDesc { + LONGINT len; + Texts_Run head; + } Texts_BufDesc; + +typedef + Texts_BufDesc *Texts_Buffer; + +typedef + struct Texts_CopyMsg { /* Texts_ElemMsg */ + Texts_Elem e; + } Texts_CopyMsg; + +typedef + struct Texts_FileMsg { /* Texts_ElemMsg */ + INTEGER id; + LONGINT pos; + Files_Rider r; + } Texts_FileMsg; + +typedef + struct Texts_FontDesc { + CHAR name[32]; + } Texts_FontDesc; + +typedef + struct Texts_IdentifyMsg { /* Texts_ElemMsg */ + CHAR mod[32], proc[32]; + } Texts_IdentifyMsg; + +typedef + void (*Texts_Notifier)(Texts_Text, INTEGER, LONGINT, LONGINT); + +typedef + struct Texts_PieceDesc *Texts_Piece; + +typedef + struct Texts_PieceDesc { + Texts_Run prev, next; + LONGINT len; + Texts_FontsFont fnt; + SHORTINT col, voff; + BOOLEAN ascii; + Files_File file; + LONGINT org; + } Texts_PieceDesc; + +typedef + struct Texts_Reader { + BOOLEAN eot; + Texts_FontsFont fnt; + SHORTINT col, voff; + Texts_Elem elem; + Files_Rider rider; + Texts_Run run; + LONGINT org, off; + } Texts_Reader; + +typedef + struct Texts_Scanner { /* Texts_Reader */ + BOOLEAN eot; + Texts_FontsFont fnt; + SHORTINT col, voff; + Texts_Elem elem; + Files_Rider rider; + Texts_Run run; + LONGINT org, off; + CHAR nextCh; + INTEGER line, class; + LONGINT i; + REAL x; + LONGREAL y; + CHAR c; + SHORTINT len; + CHAR s[64]; + } Texts_Scanner; + +typedef + struct Texts_TextDesc { + LONGINT len; + Texts_Notifier notify; + Texts_Run head, cache; + LONGINT corg; + } Texts_TextDesc; + +typedef + struct Texts_Writer { + Texts_Buffer buf; + Texts_FontsFont fnt; + SHORTINT col, voff; + Files_Rider rider; + Files_File file; + } Texts_Writer; + + +export Texts_Elem Texts_new; +static Texts_Buffer Texts_del; +static Texts_FontsFont Texts_FontsDefault; + +export LONGINT *Texts_FontDesc__typ; +export LONGINT *Texts_RunDesc__typ; +export LONGINT *Texts_PieceDesc__typ; +export LONGINT *Texts_ElemMsg__typ; +export LONGINT *Texts_ElemDesc__typ; +export LONGINT *Texts_FileMsg__typ; +export LONGINT *Texts_CopyMsg__typ; +export LONGINT *Texts_IdentifyMsg__typ; +export LONGINT *Texts_BufDesc__typ; +export LONGINT *Texts_TextDesc__typ; +export LONGINT *Texts_Reader__typ; +export LONGINT *Texts_Scanner__typ; +export LONGINT *Texts_Writer__typ; +export LONGINT *Texts__1__typ; + +export void Texts_Append (Texts_Text T, Texts_Buffer B); +export void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff); +static Texts_Elem Texts_CloneElem (Texts_Elem e); +static Texts_Piece Texts_ClonePiece (Texts_Piece p); +export void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len); +export void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB); +export void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE); +export void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end); +export Texts_Text Texts_ElemBase (Texts_Elem E); +export LONGINT Texts_ElemPos (Texts_Elem E); +static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org, LONGINT *off); +static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len); +static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__typ); +export void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B); +export void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v); +export void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len); +export void Texts_OpenBuf (Texts_Buffer B); +export void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos); +export void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos); +export void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ); +export LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ); +export void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch); +export void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ); +export void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ); +export void Texts_Recall (Texts_Buffer *B); +export void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B); +export void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ); +export void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col); +export void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt); +export void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff); +static void Texts_Splice (Texts_Run un, Texts_Run v, Texts_Run w, Texts_Text base); +static void Texts_Split (LONGINT off, Texts_Run *u, Texts_Run *un); +export void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +export void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch); +export void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d); +export void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e); +export void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x); +export void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n); +export void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ); +export void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n); +export void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x); +export void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n); +export void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k); +export void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x); +export void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len); + + +static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len) +{ + Texts_FontsFont _o_result; + Texts_FontsFont F = NIL; + __NEW(F, Texts_FontDesc); + __COPY(name, F->name, ((LONGINT)(32))); + _o_result = F; + return _o_result; +} + +static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org, LONGINT *off) +{ + Texts_Run v = NIL; + LONGINT m; + if (*pos >= T->len) { + *pos = T->len; + *u = T->head; + *org = T->len; + *off = 0; + T->cache = T->head; + T->corg = 0; + } else { + v = T->cache->next; + m = *pos - T->corg; + if (*pos >= T->corg) { + while (m >= v->len) { + m -= v->len; + v = v->next; + } + } else { + while (m < 0) { + v = v->prev; + m += v->len; + } + } + *u = v; + *org = *pos - m; + *off = m; + T->cache = v->prev; + T->corg = *org; + } +} + +static void Texts_Split (LONGINT off, Texts_Run *u, Texts_Run *un) +{ + Texts_Piece p = NIL, U = NIL; + if (off == 0) { + *un = *u; + *u = (*un)->prev; + } else if (off >= (*u)->len) { + *un = (*u)->next; + } else { + __NEW(p, Texts_PieceDesc); + *un = (Texts_Run)p; + U = __GUARDP(*u, Texts_PieceDesc, 1); + __GUARDEQP(p, Texts_PieceDesc) = *U; + p->org += off; + p->len -= off; + U->len -= p->len; + p->ascii = (*u)->ascii; + p->prev = (Texts_Run)U; + p->next = U->next; + p->next->prev = (Texts_Run)p; + U->next = (Texts_Run)p; + } +} + +static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v) +{ + Texts_Piece p = NIL, q = NIL; + if ((((((((((__ISP(u, Texts_PieceDesc, 1) && __ISP(*v, Texts_PieceDesc, 1))) && __STRCMP(u->fnt->name, (*v)->fnt->name) == 0)) && u->col == (*v)->col)) && u->voff == (*v)->voff)) && __GUARDP(u, Texts_PieceDesc, 1)->ascii == __GUARDP(*v, Texts_PieceDesc, 1)->ascii)) { + p = __GUARDP(u, Texts_PieceDesc, 1); + q = __GUARDP(*v, Texts_PieceDesc, 1); + if ((p->file == q->file && p->org + p->len == q->org)) { + if (T->cache == u) { + T->corg += q->len; + } else if (T->cache == *v) { + T->cache = T->head; + T->corg = 0; + } + p->len += q->len; + *v = (*v)->next; + } + } +} + +static void Texts_Splice (Texts_Run un, Texts_Run v, Texts_Run w, Texts_Text base) +{ + Texts_Run u = NIL; + if (v != w->next) { + u = un->prev; + u->next = v; + v->prev = u; + un->prev = w; + w->next = un; + do { + if (__ISP(v, Texts_ElemDesc, 1)) { + __GUARDP(v, Texts_ElemDesc, 1)->base = base; + } + v = v->next; + } while (!(v == un)); + } +} + +static Texts_Piece Texts_ClonePiece (Texts_Piece p) +{ + Texts_Piece _o_result; + Texts_Piece q = NIL; + __NEW(q, Texts_PieceDesc); + __GUARDEQP(q, Texts_PieceDesc) = *p; + _o_result = q; + return _o_result; +} + +static Texts_Elem Texts_CloneElem (Texts_Elem e) +{ + Texts_Elem _o_result; + Texts_CopyMsg msg; + msg.e = NIL; + (*e->handle)(e, (void*)&msg, Texts_CopyMsg__typ); + _o_result = msg.e; + return _o_result; +} + +void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE) +{ + DE->len = SE->len; + DE->fnt = SE->fnt; + DE->col = SE->col; + DE->voff = SE->voff; + DE->W = SE->W; + DE->H = SE->H; + DE->handle = SE->handle; +} + +Texts_Text Texts_ElemBase (Texts_Elem E) +{ + Texts_Text _o_result; + _o_result = E->base; + return _o_result; +} + +LONGINT Texts_ElemPos (Texts_Elem E) +{ + LONGINT _o_result; + Texts_Run u = NIL; + LONGINT pos; + u = E->base->head->next; + pos = 0; + while (u != (void *) E) { + pos = pos + u->len; + u = u->next; + } + _o_result = pos; + return _o_result; +} + +static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__typ) +{ + Texts_Alien e = NIL; + Files_Rider r; + LONGINT i; + CHAR ch; + if (__ISP(E, Texts__1, 2)) { + if (__IS(msg__typ, Texts_CopyMsg, 1)) { + if (__IS(msg__typ, Texts_CopyMsg, 1)) { + Texts_CopyMsg *msg__ = (void*)msg; + __NEW(e, Texts__1); + Texts_CopyElem((void*)((Texts_Alien)E), (void*)e); + e->file = ((Texts_Alien)E)->file; + e->org = ((Texts_Alien)E)->org; + e->span = ((Texts_Alien)E)->span; + __COPY(((Texts_Alien)E)->mod, e->mod, ((LONGINT)(32))); + __COPY(((Texts_Alien)E)->proc, e->proc, ((LONGINT)(32))); + (*msg__).e = (Texts_Elem)e; + } else __WITHCHK; + } else if (__IS(msg__typ, Texts_IdentifyMsg, 1)) { + if (__IS(msg__typ, Texts_IdentifyMsg, 1)) { + Texts_IdentifyMsg *msg__ = (void*)msg; + __COPY(((Texts_Alien)E)->mod, (*msg__).mod, ((LONGINT)(32))); + __COPY(((Texts_Alien)E)->proc, (*msg__).proc, ((LONGINT)(32))); + (*msg__).mod[31] = 0x01; + } else __WITHCHK; + } else if (__IS(msg__typ, Texts_FileMsg, 1)) { + if (__IS(msg__typ, Texts_FileMsg, 1)) { + Texts_FileMsg *msg__ = (void*)msg; + if ((*msg__).id == 1) { + Files_Set(&r, Files_Rider__typ, ((Texts_Alien)E)->file, ((Texts_Alien)E)->org); + i = ((Texts_Alien)E)->span; + while (i > 0) { + Files_Read(&r, Files_Rider__typ, (void*)&ch); + Files_Write(&(*msg__).r, Files_Rider__typ, ch); + i -= 1; + } + } + } else __WITHCHK; + } + } else __WITHCHK; +} + +void Texts_OpenBuf (Texts_Buffer B) +{ + Texts_Run u = NIL; + __NEW(u, Texts_RunDesc); + u->next = u; + u->prev = u; + B->head = u; + B->len = 0; +} + +void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB) +{ + Texts_Run u = NIL, v = NIL, vn = NIL; + u = SB->head->next; + v = DB->head->prev; + while (u != SB->head) { + if (__ISP(u, Texts_PieceDesc, 1)) { + vn = (Texts_Run)Texts_ClonePiece(__GUARDP(u, Texts_PieceDesc, 1)); + } else { + vn = (Texts_Run)Texts_CloneElem(__GUARDP(u, Texts_ElemDesc, 1)); + } + v->next = vn; + vn->prev = v; + v = vn; + u = u->next; + } + v->next = DB->head; + DB->head->prev = v; + DB->len += SB->len; +} + +void Texts_Recall (Texts_Buffer *B) +{ + *B = Texts_del; + Texts_del = NIL; +} + +void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B) +{ + Texts_Run u = NIL, v = NIL, w = NIL, wn = NIL; + LONGINT uo, ud, vo, vd; + Texts_Find(T, &beg, &u, &uo, &ud); + Texts_Find(T, &end, &v, &vo, &vd); + w = B->head->prev; + while (u != v) { + if (__ISP(u, Texts_PieceDesc, 1)) { + wn = (Texts_Run)Texts_ClonePiece(__GUARDP(u, Texts_PieceDesc, 1)); + wn->len -= ud; + __GUARDP(wn, Texts_PieceDesc, 1)->org += ud; + } else { + wn = (Texts_Run)Texts_CloneElem(__GUARDP(u, Texts_ElemDesc, 1)); + } + w->next = wn; + wn->prev = w; + w = wn; + u = u->next; + ud = 0; + } + if (vd > 0) { + wn = (Texts_Run)Texts_ClonePiece(__GUARDP(v, Texts_PieceDesc, 1)); + wn->len = vd - ud; + __GUARDP(wn, Texts_PieceDesc, 1)->org += ud; + w->next = wn; + wn->prev = w; + w = wn; + } + w->next = B->head; + B->head->prev = w; + B->len += end - beg; +} + +void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B) +{ + Texts_Run u = NIL, un = NIL, v = NIL; + Texts_Piece p = NIL, q = NIL; + LONGINT uo, ud, len; + Texts_Find(T, &pos, &u, &uo, &ud); + Texts_Split(ud, &u, &un); + len = B->len; + v = B->head->next; + Texts_Merge(T, u, &v); + Texts_Splice(un, v, B->head->prev, T); + T->len += len; + B->head->next = B->head; + B->head->prev = B->head; + B->len = 0; + if (T->notify != NIL) { + (*T->notify)(T, 1, pos, pos + len); + } +} + +void Texts_Append (Texts_Text T, Texts_Buffer B) +{ + Texts_Run v = NIL; + LONGINT pos, len; + pos = T->len; + len = B->len; + v = B->head->next; + Texts_Merge(T, T->head->prev, &v); + Texts_Splice(T->head, v, B->head->prev, T); + T->len += len; + B->head->next = B->head; + B->head->prev = B->head; + B->len = 0; + if (T->notify != NIL) { + (*T->notify)(T, 1, pos, pos + len); + } +} + +void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end) +{ + Texts_Run c = NIL, u = NIL, un = NIL, v = NIL, vn = NIL; + LONGINT co, uo, ud, vo, vd; + Texts_Find(T, &beg, &u, &uo, &ud); + Texts_Split(ud, &u, &un); + c = T->cache; + co = T->corg; + Texts_Find(T, &end, &v, &vo, &vd); + Texts_Split(vd, &v, &vn); + T->cache = c; + T->corg = co; + __NEW(Texts_del, Texts_BufDesc); + Texts_OpenBuf(Texts_del); + Texts_del->len = end - beg; + Texts_Splice(Texts_del->head, un, v, NIL); + Texts_Merge(T, u, &vn); + u->next = vn; + vn->prev = u; + T->len -= end - beg; + if (T->notify != NIL) { + (*T->notify)(T, 2, beg, end); + } +} + +void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff) +{ + Texts_Run c = NIL, u = NIL, un = NIL, v = NIL, vn = NIL; + LONGINT co, uo, ud, vo, vd; + Texts_Find(T, &beg, &u, &uo, &ud); + Texts_Split(ud, &u, &un); + c = T->cache; + co = T->corg; + Texts_Find(T, &end, &v, &vo, &vd); + Texts_Split(vd, &v, &vn); + T->cache = c; + T->corg = co; + while (un != vn) { + if ((__IN(0, sel) && fnt != NIL)) { + un->fnt = fnt; + } + if (__IN(1, sel)) { + un->col = col; + } + if (__IN(2, sel)) { + un->voff = voff; + } + Texts_Merge(T, u, &un); + if (u->next == un) { + u = un; + un = un->next; + } else { + u->next = un; + un->prev = u; + } + } + Texts_Merge(T, u, &un); + u->next = un; + un->prev = u; + if (T->notify != NIL) { + (*T->notify)(T, 0, beg, end); + } +} + +void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos) +{ + Texts_Run u = NIL; + if (pos >= T->len) { + pos = T->len; + } + Texts_Find(T, &pos, &u, &(*R).org, &(*R).off); + (*R).run = u; + (*R).eot = 0; + if (__ISP(u, Texts_PieceDesc, 1)) { + Files_Set(&(*R).rider, Files_Rider__typ, __GUARDP(u, Texts_PieceDesc, 1)->file, __GUARDP(u, Texts_PieceDesc, 1)->org + (*R).off); + } +} + +void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch) +{ + Texts_Run u = NIL; + LONGINT pos; + CHAR nextch; + u = (*R).run; + (*R).fnt = u->fnt; + (*R).col = u->col; + (*R).voff = u->voff; + (*R).off += 1; + if (__ISP(u, Texts_PieceDesc, 1)) { + Files_Read(&(*R).rider, Files_Rider__typ, (void*)&*ch); + (*R).elem = NIL; + if ((*ch == 0x0a && __GUARDP(u, Texts_PieceDesc, 1)->ascii)) { + *ch = 0x0d; + } else if ((*ch == 0x0d && __GUARDP(u, Texts_PieceDesc, 1)->ascii)) { + pos = Files_Pos(&(*R).rider, Files_Rider__typ); + Files_Read(&(*R).rider, Files_Rider__typ, (void*)&nextch); + if (nextch == 0x0a) { + (*R).off += 1; + } else { + Files_Set(&(*R).rider, Files_Rider__typ, __GUARDP(u, Texts_PieceDesc, 1)->file, pos); + } + } + } else if (__ISP(u, Texts_ElemDesc, 1)) { + *ch = 0x1c; + (*R).elem = __GUARDP(u, Texts_ElemDesc, 1); + } else { + *ch = 0x00; + (*R).elem = NIL; + (*R).eot = 1; + } + if ((*R).off == u->len) { + (*R).org += u->len; + u = u->next; + if (__ISP(u, Texts_PieceDesc, 1)) { + if (__ISP(u, Texts_PieceDesc, 1)) { + Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org); + } else __WITHCHK; + } + (*R).run = u; + (*R).off = 0; + } +} + +void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ) +{ + Texts_Run u = NIL, un = NIL; + u = (*R).run; + while (__ISP(u, Texts_PieceDesc, 1)) { + (*R).org += u->len; + u = u->next; + } + if (__ISP(u, Texts_ElemDesc, 1)) { + un = u->next; + (*R).run = un; + (*R).org += 1; + (*R).off = 0; + (*R).fnt = u->fnt; + (*R).col = u->col; + (*R).voff = u->voff; + (*R).elem = __GUARDP(u, Texts_ElemDesc, 1); + if (__ISP(un, Texts_PieceDesc, 1)) { + if (__ISP(un, Texts_PieceDesc, 1)) { + Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)un)->file, ((Texts_Piece)un)->org); + } else __WITHCHK; + } + } else { + (*R).eot = 1; + (*R).elem = NIL; + } +} + +void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ) +{ + Texts_Run u = NIL; + u = (*R).run->prev; + while (__ISP(u, Texts_PieceDesc, 1)) { + (*R).org -= u->len; + u = u->prev; + } + if (__ISP(u, Texts_ElemDesc, 1)) { + (*R).run = u; + (*R).org -= 1; + (*R).off = 0; + (*R).fnt = u->fnt; + (*R).col = u->col; + (*R).voff = u->voff; + (*R).elem = __GUARDP(u, Texts_ElemDesc, 1); + } else { + (*R).eot = 1; + (*R).elem = NIL; + } +} + +LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ) +{ + LONGINT _o_result; + _o_result = (*R).org + (*R).off; + return _o_result; +} + +void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos) +{ + Texts_OpenReader((void*)&*S, S__typ, T, pos); + (*S).line = 0; + (*S).nextCh = ' '; +} + +static struct Scan__31 { + Texts_Scanner *S; + LONGINT *S__typ; + CHAR *ch; + BOOLEAN *negE; + INTEGER *e; + struct Scan__31 *lnk; +} *Scan__31_s; + +static void ReadScaleFactor__32 (void); + +static void ReadScaleFactor__32 (void) +{ + Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch); + if (*Scan__31_s->ch == '-') { + *Scan__31_s->negE = 1; + Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch); + } else { + *Scan__31_s->negE = 0; + if (*Scan__31_s->ch == '+') { + Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch); + } + } + while (('0' <= *Scan__31_s->ch && *Scan__31_s->ch <= '9')) { + *Scan__31_s->e = (*Scan__31_s->e * 10 + (int)*Scan__31_s->ch) - 48; + Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch); + } +} + +void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ) +{ + CHAR ch, term; + BOOLEAN neg, negE, hex; + SHORTINT i, j, h; + INTEGER e; + LONGINT k; + REAL x, f; + LONGREAL y, g; + CHAR d[32]; + struct Scan__31 _s; + _s.S = S; _s.S__typ = S__typ; + _s.ch = &ch; + _s.negE = &negE; + _s.e = &e; + _s.lnk = Scan__31_s; + Scan__31_s = &_s; + ch = (*S).nextCh; + i = 0; + for (;;) { + if (ch == 0x0d) { + (*S).line += 1; + } else if ((ch != ' ' && ch != 0x09)) { + break; + } + Texts_Read((void*)&*S, S__typ, &ch); + } + if ((('A' <= __CAP(ch) && __CAP(ch) <= 'Z') || ch == '/') || ch == '.') { + do { + (*S).s[__X(i, ((LONGINT)(64)))] = ch; + i += 1; + Texts_Read((void*)&*S, S__typ, &ch); + } while (!((((__CAP(ch) > 'Z' && ch != '_') || ('A' > __CAP(ch) && ch > '9')) || ((('0' > ch && ch != '.')) && ch != '/')) || i == 63)); + (*S).s[__X(i, ((LONGINT)(64)))] = 0x00; + (*S).len = i; + (*S).class = 1; + } else if (ch == '\"') { + Texts_Read((void*)&*S, S__typ, &ch); + while ((((ch != '\"' && ch >= ' ')) && i != 63)) { + (*S).s[__X(i, ((LONGINT)(64)))] = ch; + i += 1; + Texts_Read((void*)&*S, S__typ, &ch); + } + (*S).s[__X(i, ((LONGINT)(64)))] = 0x00; + (*S).len = i + 1; + Texts_Read((void*)&*S, S__typ, &ch); + (*S).class = 2; + } else { + if (ch == '-') { + neg = 1; + Texts_Read((void*)&*S, S__typ, &ch); + } else { + neg = 0; + } + if (('0' <= ch && ch <= '9')) { + hex = 0; + j = 0; + for (;;) { + d[__X(i, ((LONGINT)(32)))] = ch; + i += 1; + Texts_Read((void*)&*S, S__typ, &ch); + if (ch < '0') { + break; + } + if ('9' < ch) { + if (('A' <= ch && ch <= 'F')) { + hex = 1; + ch = (CHAR)((int)ch - 7); + } else if (('a' <= ch && ch <= 'f')) { + hex = 1; + ch = (CHAR)((int)ch - 39); + } else { + break; + } + } + } + if (ch == 'H') { + Texts_Read((void*)&*S, S__typ, &ch); + (*S).class = 3; + if (i - j > 8) { + j = i - 8; + } + k = (int)d[__X(j, ((LONGINT)(32)))] - 48; + j += 1; + if ((i - j == 7 && k >= 8)) { + k -= 16; + } + while (j < i) { + k = __ASHL(k, 4) + (LONGINT)((int)d[__X(j, ((LONGINT)(32)))] - 48); + j += 1; + } + if (neg) { + (*S).i = -k; + } else { + (*S).i = k; + } + } else if (ch == '.') { + Texts_Read((void*)&*S, S__typ, &ch); + h = i; + while (('0' <= ch && ch <= '9')) { + d[__X(i, ((LONGINT)(32)))] = ch; + i += 1; + Texts_Read((void*)&*S, S__typ, &ch); + } + if (ch == 'D') { + e = 0; + y = (LONGREAL)0; + g = (LONGREAL)1; + do { + y = y * (LONGREAL)10 + ((int)d[__X(j, ((LONGINT)(32)))] - 48); + j += 1; + } while (!(j == h)); + while (j < i) { + g = g / (LONGREAL)(LONGREAL)10; + y = ((int)d[__X(j, ((LONGINT)(32)))] - 48) * g + y; + j += 1; + } + ReadScaleFactor__32(); + if (negE) { + if (e <= 308) { + y = y / (LONGREAL)Reals_TenL(e); + } else { + y = (LONGREAL)0; + } + } else if (e > 0) { + if (e <= 308) { + y = Reals_TenL(e) * y; + } else { + __HALT(40); + } + } + if (neg) { + y = -y; + } + (*S).class = 5; + (*S).y = y; + } else { + e = 0; + x = (REAL)0; + f = (REAL)1; + do { + x = x * (REAL)10 + ((int)d[__X(j, ((LONGINT)(32)))] - 48); + j += 1; + } while (!(j == h)); + while (j < i) { + f = f / (REAL)(REAL)10; + x = ((int)d[__X(j, ((LONGINT)(32)))] - 48) * f + x; + j += 1; + } + if (ch == 'E') { + ReadScaleFactor__32(); + } + if (negE) { + if (e <= 38) { + x = x / (REAL)Reals_Ten(e); + } else { + x = (REAL)0; + } + } else if (e > 0) { + if (e <= 38) { + x = Reals_Ten(e) * x; + } else { + __HALT(40); + } + } + if (neg) { + x = -x; + } + (*S).class = 4; + (*S).x = x; + } + if (hex) { + (*S).class = 0; + } + } else { + (*S).class = 3; + k = 0; + do { + k = k * 10 + (LONGINT)((int)d[__X(j, ((LONGINT)(32)))] - 48); + j += 1; + } while (!(j == i)); + if (neg) { + (*S).i = -k; + } else { + (*S).i = k; + } + if (hex) { + (*S).class = 0; + } else { + (*S).class = 3; + } + } + } else { + (*S).class = 6; + if (neg) { + (*S).c = '-'; + } else { + (*S).c = ch; + Texts_Read((void*)&*S, S__typ, &ch); + } + } + } + (*S).nextCh = ch; + Scan__31_s = _s.lnk; +} + +void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ) +{ + __NEW((*W).buf, Texts_BufDesc); + Texts_OpenBuf((*W).buf); + (*W).fnt = Texts_FontsDefault; + (*W).col = 15; + (*W).voff = 0; + (*W).file = Files_New((CHAR*)"", (LONGINT)1); + Files_Set(&(*W).rider, Files_Rider__typ, (*W).file, ((LONGINT)(0))); +} + +void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt) +{ + (*W).fnt = fnt; +} + +void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col) +{ + (*W).col = col; +} + +void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff) +{ + (*W).voff = voff; +} + +void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch) +{ + Texts_Run u = NIL, un = NIL; + Texts_Piece p = NIL; + Files_Write(&(*W).rider, Files_Rider__typ, ch); + (*W).buf->len += 1; + un = (*W).buf->head; + u = un->prev; + if ((((((((((__ISP(u, Texts_PieceDesc, 1) && __GUARDP(u, Texts_PieceDesc, 1)->file == (*W).file)) && __STRCMP(u->fnt->name, (*W).fnt->name) == 0)) && u->col == (*W).col)) && u->voff == (*W).voff)) && !__GUARDP(u, Texts_PieceDesc, 1)->ascii)) { + u->len += 1; + } else { + __NEW(p, Texts_PieceDesc); + u->next = (Texts_Run)p; + p->prev = u; + p->next = un; + un->prev = (Texts_Run)p; + p->len = 1; + p->fnt = (*W).fnt; + p->col = (*W).col; + p->voff = (*W).voff; + p->file = (*W).file; + p->org = Files_Length((*W).file) - 1; + p->ascii = 0; + } +} + +void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e) +{ + Texts_Run u = NIL, un = NIL; + if (e->base != NIL) { + __HALT(99); + } + (*W).buf->len += 1; + e->len = 1; + e->fnt = (*W).fnt; + e->col = (*W).col; + e->voff = (*W).voff; + un = (*W).buf->head; + u = un->prev; + u->next = (Texts_Run)e; + e->prev = u; + e->next = un; + un->prev = (Texts_Run)e; +} + +void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ) +{ + Texts_Write(&*W, W__typ, 0x0d); +} + +void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len) +{ + INTEGER i; + __DUP(s, s__len, CHAR); + i = 0; + while (s[__X(i, s__len)] >= ' ') { + Texts_Write(&*W, W__typ, s[__X(i, s__len)]); + i += 1; + } + __DEL(s); +} + +void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n) +{ + INTEGER i; + LONGINT x0; + CHAR a[22]; + i = 0; + if (x < 0) { + if (x == (-2147483647-1)) { + Texts_WriteString(&*W, W__typ, (CHAR*)" -2147483648", (LONGINT)13); + return; + } else { + n -= 1; + x0 = -x; + } + } else { + x0 = x; + } + do { + a[__X(i, ((LONGINT)(22)))] = (CHAR)(__MOD(x0, 10) + 48); + x0 = __DIV(x0, 10); + i += 1; + } while (!(x0 == 0)); + while (n > (LONGINT)i) { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } + if (x < 0) { + Texts_Write(&*W, W__typ, '-'); + } + do { + i -= 1; + Texts_Write(&*W, W__typ, a[__X(i, ((LONGINT)(22)))]); + } while (!(i == 0)); +} + +void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x) +{ + INTEGER i; + LONGINT y; + CHAR a[20]; + i = 0; + Texts_Write(&*W, W__typ, ' '); + do { + y = __MASK(x, -16); + if (y < 10) { + a[__X(i, ((LONGINT)(20)))] = (CHAR)(y + 48); + } else { + a[__X(i, ((LONGINT)(20)))] = (CHAR)(y + 55); + } + x = __ASHR(x, 4); + i += 1; + } while (!(i == 8)); + do { + i -= 1; + Texts_Write(&*W, W__typ, a[__X(i, ((LONGINT)(20)))]); + } while (!(i == 0)); +} + +void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n) +{ + INTEGER e; + REAL x0; + CHAR d[9]; + e = Reals_Expo(x); + if (e == 0) { + Texts_WriteString(&*W, W__typ, (CHAR*)" 0", (LONGINT)4); + do { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } while (!(n <= 3)); + } else if (e == 255) { + Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5); + while (n > 4) { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } + } else { + if (n <= 9) { + n = 3; + } else { + n -= 6; + } + do { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } while (!(n <= 8)); + if (x < (REAL)0) { + Texts_Write(&*W, W__typ, '-'); + x = -x; + } else { + Texts_Write(&*W, W__typ, ' '); + } + e = __ASHR((e - 127) * 77, 8); + if (e >= 0) { + x = x / (REAL)Reals_Ten(e); + } else { + x = Reals_Ten(-e) * x; + } + if (x >= (REAL)10) { + x = 1.0000000e-001 * x; + e += 1; + } + x0 = Reals_Ten(n - 1); + x = x0 * x + 5.0000000e-001; + if (x >= (REAL)10 * x0) { + x = x * 1.0000000e-001; + e += 1; + } + Reals_Convert(x, n, (void*)d, ((LONGINT)(9))); + n -= 1; + Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(9)))]); + Texts_Write(&*W, W__typ, '.'); + do { + n -= 1; + Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(9)))]); + } while (!(n == 0)); + Texts_Write(&*W, W__typ, 'E'); + if (e < 0) { + Texts_Write(&*W, W__typ, '-'); + e = -e; + } else { + Texts_Write(&*W, W__typ, '+'); + } + Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48)); + Texts_Write(&*W, W__typ, (CHAR)((int)__MOD(e, 10) + 48)); + } +} + +static struct WriteRealFix__53 { + Texts_Writer *W; + LONGINT *W__typ; + INTEGER *i; + CHAR (*d)[9]; + struct WriteRealFix__53 *lnk; +} *WriteRealFix__53_s; + +static void dig__54 (INTEGER n); +static void seq__56 (CHAR ch, INTEGER n); + +static void seq__56 (CHAR ch, INTEGER n) +{ + while (n > 0) { + Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, ch); + n -= 1; + } +} + +static void dig__54 (INTEGER n) +{ + while (n > 0) { + *WriteRealFix__53_s->i -= 1; + Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, (*WriteRealFix__53_s->d)[__X(*WriteRealFix__53_s->i, ((LONGINT)(9)))]); + n -= 1; + } +} + +void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k) +{ + INTEGER e, i; + CHAR sign; + REAL x0; + CHAR d[9]; + struct WriteRealFix__53 _s; + _s.W = W; _s.W__typ = W__typ; + _s.i = &i; + _s.d = (void*)d; + _s.lnk = WriteRealFix__53_s; + WriteRealFix__53_s = &_s; + e = Reals_Expo(x); + if (k < 0) { + k = 0; + } + if (e == 0) { + seq__56(' ', (n - k) - 2); + Texts_Write(&*W, W__typ, '0'); + seq__56(' ', k + 1); + } else if (e == 255) { + Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5); + seq__56(' ', n - 4); + } else { + e = __ASHR((e - 127) * 77, 8); + if (x < (REAL)0) { + sign = '-'; + x = -x; + } else { + sign = ' '; + } + if (e >= 0) { + x = x / (REAL)Reals_Ten(e); + } else { + x = Reals_Ten(-e) * x; + } + if (x >= (REAL)10) { + x = 1.0000000e-001 * x; + e += 1; + } + if (k + e >= 8) { + k = 8 - e; + } else if (k + e < 0) { + k = -e; + x = (REAL)0; + } + x0 = Reals_Ten(k + e); + x = x0 * x + 5.0000000e-001; + if (x >= (REAL)10 * x0) { + e += 1; + } + e += 1; + i = k + e; + Reals_Convert(x, i, (void*)d, ((LONGINT)(9))); + if (e > 0) { + seq__56(' ', ((n - e) - k) - 2); + Texts_Write(&*W, W__typ, sign); + dig__54(e); + Texts_Write(&*W, W__typ, '.'); + dig__54(k); + } else { + seq__56(' ', (n - k) - 3); + Texts_Write(&*W, W__typ, sign); + Texts_Write(&*W, W__typ, '0'); + Texts_Write(&*W, W__typ, '.'); + seq__56('0', -e); + dig__54(k + e); + } + } + WriteRealFix__53_s = _s.lnk; +} + +void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x) +{ + INTEGER i; + CHAR d[8]; + Reals_ConvertH(x, (void*)d, ((LONGINT)(8))); + i = 0; + do { + Texts_Write(&*W, W__typ, d[__X(i, ((LONGINT)(8)))]); + i += 1; + } while (!(i == 8)); +} + +void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n) +{ + INTEGER e; + LONGREAL x0; + CHAR d[16]; + e = Reals_ExpoL(x); + if (e == 0) { + Texts_WriteString(&*W, W__typ, (CHAR*)" 0", (LONGINT)4); + do { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } while (!(n <= 3)); + } else if (e == 2047) { + Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5); + while (n > 4) { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } + } else { + if (n <= 10) { + n = 3; + } else { + n -= 7; + } + do { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } while (!(n <= 16)); + if (x < (LONGREAL)0) { + Texts_Write(&*W, W__typ, '-'); + x = -x; + } else { + Texts_Write(&*W, W__typ, ' '); + } + e = (int)__ASHR((LONGINT)(e - 1023) * 77, 8); + if (e >= 0) { + x = x / (LONGREAL)Reals_TenL(e); + } else { + x = Reals_TenL(-e) * x; + } + if (x >= (LONGREAL)10) { + x = 1.00000000000000e-001 * x; + e += 1; + } + x0 = Reals_TenL(n - 1); + x = x0 * x + 5.00000000000000e-001; + if (x >= (LONGREAL)10 * x0) { + x = 1.00000000000000e-001 * x; + e += 1; + } + Reals_ConvertL(x, n, (void*)d, ((LONGINT)(16))); + n -= 1; + Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(16)))]); + Texts_Write(&*W, W__typ, '.'); + do { + n -= 1; + Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(16)))]); + } while (!(n == 0)); + Texts_Write(&*W, W__typ, 'D'); + if (e < 0) { + Texts_Write(&*W, W__typ, '-'); + e = -e; + } else { + Texts_Write(&*W, W__typ, '+'); + } + Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 100) + 48)); + e = (int)__MOD(e, 100); + Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48)); + Texts_Write(&*W, W__typ, (CHAR)((int)__MOD(e, 10) + 48)); + } +} + +void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x) +{ + INTEGER i; + CHAR d[16]; + Reals_ConvertHL(x, (void*)d, ((LONGINT)(16))); + i = 0; + do { + Texts_Write(&*W, W__typ, d[__X(i, ((LONGINT)(16)))]); + i += 1; + } while (!(i == 16)); +} + +static struct WriteDate__43 { + Texts_Writer *W; + LONGINT *W__typ; + struct WriteDate__43 *lnk; +} *WriteDate__43_s; + +static void WritePair__44 (CHAR ch, LONGINT x); + +static void WritePair__44 (CHAR ch, LONGINT x) +{ + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, ch); + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__DIV(x, 10) + 48)); + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__MOD(x, 10) + 48)); +} + +void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d) +{ + struct WriteDate__43 _s; + _s.W = W; _s.W__typ = W__typ; + _s.lnk = WriteDate__43_s; + WriteDate__43_s = &_s; + WritePair__44(' ', __MASK(d, -32)); + WritePair__44('.', __MASK(__ASHR(d, 5), -16)); + WritePair__44('.', __MASK(__ASHR(d, 9), -128)); + WritePair__44(' ', __MASK(__ASHR(t, 12), -32)); + WritePair__44(':', __MASK(__ASHR(t, 6), -64)); + WritePair__44(':', __MASK(t, -64)); + WriteDate__43_s = _s.lnk; +} + +static struct Load0__16 { + Texts_Text *T; + SHORTINT *ecnt; + Files_File *f; + Texts_FileMsg *msg; + CHAR (*mods)[64][32], (*procs)[64][32]; + struct Load0__16 *lnk; +} *Load0__16_s; + +static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT span, Texts_Elem *e); + +static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT span, Texts_Elem *e) +{ + Modules_Module M = NIL; + Modules_Command Cmd; + Texts_Alien a = NIL; + LONGINT org, ew, eh; + SHORTINT eno; + Texts_new = NIL; + Files_ReadLInt(&*r, r__typ, &ew); + Files_ReadLInt(&*r, r__typ, &eh); + Files_Read(&*r, r__typ, (void*)&eno); + if (eno > *Load0__16_s->ecnt) { + *Load0__16_s->ecnt = eno; + Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32))); + Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32))); + } + org = Files_Pos(&*r, r__typ); + M = Modules_ThisMod((*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32))); + if (M != NIL) { + Cmd = Modules_ThisCommand(M, (*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32))); + if (Cmd != NIL) { + (*Cmd)(); + } + } + *e = Texts_new; + if (*e != NIL) { + (*e)->W = ew; + (*e)->H = eh; + (*e)->base = *Load0__16_s->T; + (*Load0__16_s->msg).pos = pos; + (*(*e)->handle)(*e, (void*)&*Load0__16_s->msg, Texts_FileMsg__typ); + if (Files_Pos(&*r, r__typ) != org + span) { + *e = NIL; + } + } + if (*e == NIL) { + Files_Set(&*r, r__typ, *Load0__16_s->f, org + span); + __NEW(a, Texts__1); + a->W = ew; + a->H = eh; + a->handle = Texts_HandleAlien; + a->base = *Load0__16_s->T; + a->file = *Load0__16_s->f; + a->org = org; + a->span = span; + __COPY((*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], a->mod, ((LONGINT)(32))); + __COPY((*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], a->proc, ((LONGINT)(32))); + *e = (Texts_Elem)a; + } +} + +static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T) +{ + Texts_Run u = NIL, un = NIL; + Texts_Piece p = NIL; + Texts_Elem e = NIL; + LONGINT org, pos, hlen, plen; + SHORTINT ecnt, fno, fcnt, col, voff; + Files_File f = NIL; + Texts_FileMsg msg; + CHAR mods[64][32], procs[64][32]; + CHAR name[32]; + Texts_FontsFont fnts[32]; + struct Load0__16 _s; + _s.T = &T; + _s.ecnt = &ecnt; + _s.f = &f; + _s.msg = &msg; + _s.mods = (void*)mods; + _s.procs = (void*)procs; + _s.lnk = Load0__16_s; + Load0__16_s = &_s; + pos = Files_Pos(&*r, r__typ); + f = Files_Base(&*r, r__typ); + __NEW(u, Texts_RunDesc); + u->len = 2147483647; + u->fnt = NIL; + u->col = 15; + T->head = u; + ecnt = 0; + fcnt = 0; + msg.id = 0; + msg.r = *r; + Files_ReadLInt(&msg.r, Files_Rider__typ, &hlen); + org = (pos - 2) + hlen; + pos = org; + Files_Read(&msg.r, Files_Rider__typ, (void*)&fno); + while (fno != 0) { + if (fno > fcnt) { + fcnt = fno; + Files_ReadString(&msg.r, Files_Rider__typ, (void*)name, ((LONGINT)(32))); + fnts[__X(fno, ((LONGINT)(32)))] = Texts_FontsThis((void*)name, ((LONGINT)(32))); + } + Files_Read(&msg.r, Files_Rider__typ, (void*)&col); + Files_Read(&msg.r, Files_Rider__typ, (void*)&voff); + Files_ReadLInt(&msg.r, Files_Rider__typ, &plen); + if (plen > 0) { + __NEW(p, Texts_PieceDesc); + p->file = f; + p->org = pos; + p->ascii = 0; + un = (Texts_Run)p; + un->len = plen; + } else { + LoadElem__17(&msg.r, Files_Rider__typ, pos - org, -plen, &e); + un = (Texts_Run)e; + un->len = 1; + } + un->col = col; + un->voff = voff; + pos += un->len; + u->next = un; + un->prev = u; + u = un; + Files_Read(&msg.r, Files_Rider__typ, (void*)&fno); + } + u->next = T->head; + T->head->prev = u; + T->cache = T->head; + T->corg = 0; + Files_ReadLInt(&msg.r, Files_Rider__typ, &T->len); + Files_Set(&*r, r__typ, f, Files_Pos(&msg.r, Files_Rider__typ) + T->len); + Load0__16_s = _s.lnk; +} + +void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T) +{ + INTEGER tag; + Files_ReadInt(&*r, r__typ, &tag); + if (tag != -4095) { + Files_Set(&*r, r__typ, Files_Base(&*r, r__typ), Files_Pos(&*r, r__typ) - 2); + } + Texts_Load0(&*r, r__typ, T); +} + +void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len) +{ + Files_File f = NIL; + Files_Rider r; + Texts_Run u = NIL; + Texts_Piece p = NIL; + CHAR tag, version; + LONGINT hlen; + __DUP(name, name__len, CHAR); + f = Files_Old(name, name__len); + if (f == NIL) { + f = Files_New((CHAR*)"", (LONGINT)1); + } + Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(0))); + Files_Read(&r, Files_Rider__typ, (void*)&tag); + Files_Read(&r, Files_Rider__typ, (void*)&version); + if (tag == 0xf0 || (tag == 0x01 && version == 0xf0)) { + Texts_Load0(&r, Files_Rider__typ, T); + } else { + __NEW(u, Texts_RunDesc); + u->len = 2147483647; + u->fnt = NIL; + u->col = 15; + __NEW(p, Texts_PieceDesc); + if ((tag == 0xf7 && version == 0x07)) { + Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(28))); + Files_ReadLInt(&r, Files_Rider__typ, &hlen); + Files_Set(&r, Files_Rider__typ, f, 22 + hlen); + Files_ReadLInt(&r, Files_Rider__typ, &T->len); + p->org = 26 + hlen; + } else { + T->len = Files_Length(f); + p->org = 0; + } + if (T->len > 0) { + p->len = T->len; + p->fnt = Texts_FontsDefault; + p->col = 15; + p->voff = 0; + p->file = f; + p->ascii = 1; + u->next = (Texts_Run)p; + u->prev = (Texts_Run)p; + p->next = u; + p->prev = u; + } else { + u->next = u; + u->prev = u; + } + T->head = u; + T->cache = T->head; + T->corg = 0; + } + __DEL(name); +} + +static struct Store__39 { + SHORTINT *ecnt; + Texts_FileMsg *msg; + Texts_IdentifyMsg *iden; + CHAR (*mods)[64][32], (*procs)[64][32]; + struct Store__39 *lnk; +} *Store__39_s; + +static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_Elem e); + +static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_Elem e) +{ + Files_Rider r1; + LONGINT org, span; + SHORTINT eno; + __COPY((*Store__39_s->iden).mod, (*Store__39_s->mods)[__X(*Store__39_s->ecnt, ((LONGINT)(64)))], ((LONGINT)(32))); + __COPY((*Store__39_s->iden).proc, (*Store__39_s->procs)[__X(*Store__39_s->ecnt, ((LONGINT)(64)))], ((LONGINT)(32))); + eno = 1; + while (__STRCMP((*Store__39_s->mods)[__X(eno, ((LONGINT)(64)))], (*Store__39_s->iden).mod) != 0 || __STRCMP((*Store__39_s->procs)[__X(eno, ((LONGINT)(64)))], (*Store__39_s->iden).proc) != 0) { + eno += 1; + } + Files_Set(&r1, Files_Rider__typ, Files_Base(&*r, r__typ), Files_Pos(&*r, r__typ)); + Files_WriteLInt(&*r, r__typ, ((LONGINT)(0))); + Files_WriteLInt(&*r, r__typ, ((LONGINT)(0))); + Files_WriteLInt(&*r, r__typ, ((LONGINT)(0))); + Files_Write(&*r, r__typ, eno); + if (eno == *Store__39_s->ecnt) { + *Store__39_s->ecnt += 1; + Files_WriteString(&*r, r__typ, (*Store__39_s->iden).mod, ((LONGINT)(32))); + Files_WriteString(&*r, r__typ, (*Store__39_s->iden).proc, ((LONGINT)(32))); + } + (*Store__39_s->msg).pos = pos; + org = Files_Pos(&*r, r__typ); + (*e->handle)(e, (void*)&*Store__39_s->msg, Texts_FileMsg__typ); + span = Files_Pos(&*r, r__typ) - org; + Files_WriteLInt(&r1, Files_Rider__typ, -span); + Files_WriteLInt(&r1, Files_Rider__typ, e->W); + Files_WriteLInt(&r1, Files_Rider__typ, e->H); +} + +void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T) +{ + Files_Rider r1; + Texts_Run u = NIL, un = NIL; + Texts_Elem e = NIL; + LONGINT org, pos, delta, hlen, rlen; + SHORTINT ecnt, fno, fcnt; + CHAR ch; + Texts_FileMsg msg; + Texts_IdentifyMsg iden; + CHAR mods[64][32], procs[64][32]; + Texts_FontsFont fnts[32]; + CHAR block[1024]; + struct Store__39 _s; + _s.ecnt = &ecnt; + _s.msg = &msg; + _s.iden = &iden; + _s.mods = (void*)mods; + _s.procs = (void*)procs; + _s.lnk = Store__39_s; + Store__39_s = &_s; + org = Files_Pos(&*r, r__typ); + msg.id = 1; + msg.r = *r; + Files_WriteLInt(&msg.r, Files_Rider__typ, ((LONGINT)(0))); + u = T->head->next; + pos = 0; + delta = 0; + fcnt = 1; + ecnt = 1; + while (u != T->head) { + if (__ISP(u, Texts_ElemDesc, 1)) { + iden.mod[0] = 0x00; + (*__GUARDP(u, Texts_ElemDesc, 1)->handle)(__GUARDP(u, Texts_ElemDesc, 1), (void*)&iden, Texts_IdentifyMsg__typ); + } else { + iden.mod[0] = 0x01; + } + if (iden.mod[0] != 0x00) { + fnts[__X(fcnt, ((LONGINT)(32)))] = u->fnt; + fno = 1; + while (__STRCMP(fnts[__X(fno, ((LONGINT)(32)))]->name, u->fnt->name) != 0) { + fno += 1; + } + Files_Write(&msg.r, Files_Rider__typ, fno); + if (fno == fcnt) { + fcnt += 1; + Files_WriteString(&msg.r, Files_Rider__typ, u->fnt->name, ((LONGINT)(32))); + } + Files_Write(&msg.r, Files_Rider__typ, u->col); + Files_Write(&msg.r, Files_Rider__typ, u->voff); + } + if (__ISP(u, Texts_PieceDesc, 1)) { + rlen = u->len; + un = u->next; + while ((((((__ISP(un, Texts_PieceDesc, 1) && un->fnt == u->fnt)) && un->col == u->col)) && un->voff == u->voff)) { + rlen += un->len; + un = un->next; + } + Files_WriteLInt(&msg.r, Files_Rider__typ, rlen); + pos += rlen; + u = un; + } else if (iden.mod[0] != 0x00) { + StoreElem__40(&msg.r, Files_Rider__typ, pos, __GUARDP(u, Texts_ElemDesc, 1)); + pos += 1; + u = u->next; + } else { + delta += 1; + u = u->next; + } + } + Files_Write(&msg.r, Files_Rider__typ, 0); + Files_WriteLInt(&msg.r, Files_Rider__typ, T->len - delta); + hlen = (Files_Pos(&msg.r, Files_Rider__typ) - org) + 2; + Files_Set(&r1, Files_Rider__typ, Files_Base(&msg.r, Files_Rider__typ), org); + Files_WriteLInt(&r1, Files_Rider__typ, hlen); + u = T->head->next; + while (u != T->head) { + if (__ISP(u, Texts_PieceDesc, 1)) { + if (__ISP(u, Texts_PieceDesc, 1)) { + if (((Texts_Piece)u)->ascii) { + Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org); + delta = ((Texts_Piece)u)->len; + while (delta > 0) { + Files_Read(&r1, Files_Rider__typ, (void*)&ch); + delta -= 1; + if (ch == 0x0a) { + Files_Write(&msg.r, Files_Rider__typ, 0x0d); + } else { + Files_Write(&msg.r, Files_Rider__typ, ch); + } + } + } else { + Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org); + delta = ((Texts_Piece)u)->len; + while (delta > 1024) { + Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), ((LONGINT)(1024))); + Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), ((LONGINT)(1024))); + delta -= 1024; + } + Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), delta); + Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), delta); + } + } else __WITHCHK; + } else { + iden.mod[0] = 0x00; + (*__GUARDP(u, Texts_ElemDesc, 1)->handle)(__GUARDP(u, Texts_ElemDesc, 1), (void*)&iden, Texts_IdentifyMsg__typ); + if (iden.mod[0] != 0x00) { + Files_Write(&msg.r, Files_Rider__typ, 0x1c); + } + } + u = u->next; + } + __GUARDEQR(r, r__typ, Files_Rider) = msg.r; + if (T->notify != NIL) { + (*T->notify)(T, 3, ((LONGINT)(0)), ((LONGINT)(0))); + } + Store__39_s = _s.lnk; +} + +void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len) +{ + Files_File f = NIL; + Files_Rider r; + INTEGER i, res; + CHAR bak[64]; + __DUP(name, name__len, CHAR); + f = Files_New(name, name__len); + Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(0))); + Files_Write(&r, Files_Rider__typ, 0xf0); + Files_Write(&r, Files_Rider__typ, 0x01); + Texts_Store(&r, Files_Rider__typ, T); + i = 0; + while (name[__X(i, name__len)] != 0x00) { + i += 1; + } + __COPY(name, bak, ((LONGINT)(64))); + bak[__X(i, ((LONGINT)(64)))] = '.'; + bak[__X(i + 1, ((LONGINT)(64)))] = 'B'; + bak[__X(i + 2, ((LONGINT)(64)))] = 'a'; + bak[__X(i + 3, ((LONGINT)(64)))] = 'k'; + bak[__X(i + 4, ((LONGINT)(64)))] = 0x00; + Files_Rename(name, name__len, bak, ((LONGINT)(64)), &res); + Files_Register(f); + __DEL(name); +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(Texts_new); + P(Texts_del); + P(Texts_FontsDefault); +} + +__TDESC(Texts_FontDesc, 1, 0) = {__TDFLDS("FontDesc", 32), {-4}}; +__TDESC(Texts_RunDesc, 1, 3) = {__TDFLDS("RunDesc", 20), {0, 4, 12, -16}}; +__TDESC(Texts_PieceDesc, 1, 4) = {__TDFLDS("PieceDesc", 28), {0, 4, 12, 20, -20}}; +__TDESC(Texts_ElemMsg, 1, 0) = {__TDFLDS("ElemMsg", 1), {-4}}; +__TDESC(Texts_ElemDesc, 1, 4) = {__TDFLDS("ElemDesc", 36), {0, 4, 12, 32, -20}}; +__TDESC(Texts_FileMsg, 1, 1) = {__TDFLDS("FileMsg", 28), {16, -8}}; +__TDESC(Texts_CopyMsg, 1, 1) = {__TDFLDS("CopyMsg", 4), {0, -8}}; +__TDESC(Texts_IdentifyMsg, 1, 0) = {__TDFLDS("IdentifyMsg", 64), {-4}}; +__TDESC(Texts_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 8), {4, -8}}; +__TDESC(Texts_TextDesc, 1, 2) = {__TDFLDS("TextDesc", 20), {8, 12, -12}}; +__TDESC(Texts_Reader, 1, 4) = {__TDFLDS("Reader", 48), {4, 12, 24, 36, -20}}; +__TDESC(Texts_Scanner, 1, 4) = {__TDFLDS("Scanner", 144), {4, 12, 24, 36, -20}}; +__TDESC(Texts_Writer, 1, 4) = {__TDFLDS("Writer", 36), {0, 4, 20, 32, -20}}; +__TDESC(Texts__1, 1, 5) = {__TDFLDS("", 112), {0, 4, 12, 32, 36, -24}}; + +export void *Texts__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Files); + __MODULE_IMPORT(Modules); + __MODULE_IMPORT(Reals); + __REGMOD("Texts", EnumPtrs); + __INITYP(Texts_FontDesc, Texts_FontDesc, 0); + __INITYP(Texts_RunDesc, Texts_RunDesc, 0); + __INITYP(Texts_PieceDesc, Texts_RunDesc, 1); + __INITYP(Texts_ElemMsg, Texts_ElemMsg, 0); + __INITYP(Texts_ElemDesc, Texts_RunDesc, 1); + __INITYP(Texts_FileMsg, Texts_ElemMsg, 1); + __INITYP(Texts_CopyMsg, Texts_ElemMsg, 1); + __INITYP(Texts_IdentifyMsg, Texts_ElemMsg, 1); + __INITYP(Texts_BufDesc, Texts_BufDesc, 0); + __INITYP(Texts_TextDesc, Texts_TextDesc, 0); + __INITYP(Texts_Reader, Texts_Reader, 0); + __INITYP(Texts_Scanner, Texts_Reader, 1); + __INITYP(Texts_Writer, Texts_Writer, 0); + __INITYP(Texts__1, Texts_ElemDesc, 2); +/* BEGIN */ + Texts_del = NIL; + __NEW(Texts_FontsDefault, Texts_FontDesc); + __MOVE("Syntax10.Scn.Fnt", Texts_FontsDefault->name, 17); + __ENDMOD; +} diff --git a/bootstrap/windows-48/Texts.h b/bootstrap/windows-48/Texts.h new file mode 100644 index 00000000..7b66d3ce --- /dev/null +++ b/bootstrap/windows-48/Texts.h @@ -0,0 +1,173 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Texts__h +#define Texts__h + +#include "SYSTEM.h" +#include "Files.h" + +typedef + struct Texts_BufDesc { + LONGINT len; + char _prvt0[4]; + } Texts_BufDesc; + +typedef + Texts_BufDesc *Texts_Buffer; + +typedef + struct Texts_ElemMsg { + char _prvt0[1]; + } Texts_ElemMsg; + +typedef + struct Texts_ElemDesc *Texts_Elem; + +typedef + struct Texts_CopyMsg { /* Texts_ElemMsg */ + Texts_Elem e; + } Texts_CopyMsg; + +typedef + struct Texts_RunDesc { + LONGINT _prvt0; + char _prvt1[15]; + } Texts_RunDesc; + +typedef + void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, LONGINT *); + +typedef + struct Texts_ElemDesc { + char _prvt0[20]; + LONGINT W, H; + Texts_Handler handle; + char _prvt1[4]; + } Texts_ElemDesc; + +typedef + struct Texts_FileMsg { /* Texts_ElemMsg */ + INTEGER id; + LONGINT pos; + Files_Rider r; + } Texts_FileMsg; + +typedef + struct Texts_FontDesc { + char _prvt0[32]; + } Texts_FontDesc; + +typedef + Texts_FontDesc *Texts_FontsFont; + +typedef + struct Texts_IdentifyMsg { /* Texts_ElemMsg */ + CHAR mod[32], proc[32]; + } Texts_IdentifyMsg; + +typedef + struct Texts_TextDesc *Texts_Text; + +typedef + void (*Texts_Notifier)(Texts_Text, INTEGER, LONGINT, LONGINT); + +typedef + struct Texts_Reader { + BOOLEAN eot; + Texts_FontsFont fnt; + SHORTINT col, voff; + Texts_Elem elem; + char _prvt0[32]; + } Texts_Reader; + +typedef + struct Texts_Scanner { /* Texts_Reader */ + BOOLEAN eot; + Texts_FontsFont fnt; + SHORTINT col, voff; + Texts_Elem elem; + LONGREAL _prvt0; + char _prvt1[24]; + CHAR nextCh; + INTEGER line, class; + LONGINT i; + REAL x; + LONGREAL y; + CHAR c; + SHORTINT len; + CHAR s[64]; + } Texts_Scanner; + +typedef + struct Texts_TextDesc { + LONGINT len; + Texts_Notifier notify; + char _prvt0[12]; + } Texts_TextDesc; + +typedef + struct Texts_Writer { + Texts_Buffer buf; + Texts_FontsFont fnt; + SHORTINT col, voff; + char _prvt0[26]; + } Texts_Writer; + + +import Texts_Elem Texts_new; + +import LONGINT *Texts_FontDesc__typ; +import LONGINT *Texts_RunDesc__typ; +import LONGINT *Texts_ElemMsg__typ; +import LONGINT *Texts_ElemDesc__typ; +import LONGINT *Texts_FileMsg__typ; +import LONGINT *Texts_CopyMsg__typ; +import LONGINT *Texts_IdentifyMsg__typ; +import LONGINT *Texts_BufDesc__typ; +import LONGINT *Texts_TextDesc__typ; +import LONGINT *Texts_Reader__typ; +import LONGINT *Texts_Scanner__typ; +import LONGINT *Texts_Writer__typ; + +import void Texts_Append (Texts_Text T, Texts_Buffer B); +import void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff); +import void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len); +import void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB); +import void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE); +import void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end); +import Texts_Text Texts_ElemBase (Texts_Elem E); +import LONGINT Texts_ElemPos (Texts_Elem E); +import void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B); +import void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +import void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len); +import void Texts_OpenBuf (Texts_Buffer B); +import void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos); +import void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos); +import void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ); +import LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ); +import void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch); +import void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ); +import void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ); +import void Texts_Recall (Texts_Buffer *B); +import void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B); +import void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ); +import void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col); +import void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt); +import void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff); +import void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +import void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch); +import void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d); +import void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e); +import void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x); +import void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n); +import void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ); +import void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n); +import void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x); +import void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n); +import void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k); +import void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x); +import void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len); +import void *Texts__init(void); + + +#endif diff --git a/bootstrap/windows-48/Vishap.c b/bootstrap/windows-48/Vishap.c new file mode 100644 index 00000000..2b9c3901 --- /dev/null +++ b/bootstrap/windows-48/Vishap.c @@ -0,0 +1,168 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkamSf */ +#include "SYSTEM.h" +#include "Configuration.h" +#include "Heap.h" +#include "OPB.h" +#include "OPC.h" +#include "OPM.h" +#include "OPP.h" +#include "OPT.h" +#include "OPV.h" +#include "Platform.h" +#include "Strings.h" +#include "extTools.h" +#include "vt100.h" + + +static CHAR Vishap_mname[256]; + + +export void Vishap_Module (BOOLEAN *done); +static void Vishap_PropagateElementaryTypeSizes (void); +export void Vishap_Translate (void); +static void Vishap_Trap (INTEGER sig); + + +void Vishap_Module (BOOLEAN *done) +{ + BOOLEAN ext, new; + OPT_Node p = NIL; + OPP_Module(&p, OPM_opt); + if (OPM_noerr) { + OPV_Init(); + OPV_AdrAndSize(OPT_topScope); + OPT_Export(&ext, &new); + if (OPM_noerr) { + OPM_OpenFiles((void*)OPT_SelfName, ((LONGINT)(256))); + OPC_Init(); + OPV_Module(p); + if (OPM_noerr) { + if (((OPM_mainProg || OPM_mainLinkStat) && __STRCMP(OPM_modName, "SYSTEM") != 0)) { + OPM_DeleteNewSym(); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"32m", (LONGINT)4); + } + OPM_LogWStr((CHAR*)" Main program.", (LONGINT)16); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + } else { + if (new) { + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"32m", (LONGINT)4); + } + OPM_LogWStr((CHAR*)" New symbol file.", (LONGINT)19); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + OPM_RegisterNewSym(); + } else if (ext) { + OPM_LogWStr((CHAR*)" Extended symbol file.", (LONGINT)24); + OPM_RegisterNewSym(); + } + } + } else { + OPM_DeleteNewSym(); + } + } + } + OPM_CloseFiles(); + OPT_Close(); + OPM_LogWLn(); + *done = OPM_noerr; +} + +static void Vishap_PropagateElementaryTypeSizes (void) +{ + OPT_bytetyp->size = OPM_ByteSize; + OPT_sysptrtyp->size = OPM_PointerSize; + OPT_chartyp->size = OPM_CharSize; + OPT_settyp->size = OPM_SetSize; + OPT_realtyp->size = OPM_RealSize; + OPT_inttyp->size = OPM_IntSize; + OPT_linttyp->size = OPM_LIntSize; + OPT_lrltyp->size = OPM_LRealSize; + OPT_sinttyp->size = OPM_SIntSize; + OPT_booltyp->size = OPM_BoolSize; +} + +void Vishap_Translate (void) +{ + BOOLEAN done; + CHAR modulesobj[2048]; + modulesobj[0] = 0x00; + if (OPM_OpenPar()) { + for (;;) { + OPM_Init(&done, (void*)Vishap_mname, ((LONGINT)(256))); + if (!done) { + return; + } + OPM_InitOptions(); + Vishap_PropagateElementaryTypeSizes(); + Heap_GC(0); + Vishap_Module(&done); + if (!done) { + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Module compilation failed.", (LONGINT)27); + OPM_LogWLn(); + Platform_Exit(1); + } + if (!OPM_dontAsm) { + if (OPM_dontLink) { + extTools_Assemble(OPM_modName, ((LONGINT)(32))); + } else { + if (!(OPM_mainProg || OPM_mainLinkStat)) { + extTools_Assemble(OPM_modName, ((LONGINT)(32))); + Strings_Append((CHAR*)" ", (LONGINT)2, (void*)modulesobj, ((LONGINT)(2048))); + Strings_Append(OPM_modName, ((LONGINT)(32)), (void*)modulesobj, ((LONGINT)(2048))); + Strings_Append((CHAR*)".o", (LONGINT)3, (void*)modulesobj, ((LONGINT)(2048))); + } else { + extTools_LinkMain((void*)OPM_modName, ((LONGINT)(32)), OPM_mainLinkStat, modulesobj, ((LONGINT)(2048))); + } + } + } + } + } +} + +static void Vishap_Trap (INTEGER sig) +{ + Heap_FINALL(); + if (sig == 3) { + Platform_Exit(0); + } else { + if ((sig == 4 && Platform_HaltCode == -15)) { + OPM_LogWStr((CHAR*)" --- Vishap Oberon: internal error", (LONGINT)35); + OPM_LogWLn(); + } + Platform_Exit(2); + } +} + + +export int main(int argc, char **argv) +{ + __INIT(argc, argv); + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Heap); + __MODULE_IMPORT(OPB); + __MODULE_IMPORT(OPC); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPP); + __MODULE_IMPORT(OPT); + __MODULE_IMPORT(OPV); + __MODULE_IMPORT(Platform); + __MODULE_IMPORT(Strings); + __MODULE_IMPORT(extTools); + __MODULE_IMPORT(vt100); + __REGMAIN("Vishap", 0); + __REGCMD("Translate", Vishap_Translate); +/* BEGIN */ + Platform_SetInterruptHandler(Vishap_Trap); + Platform_SetQuitHandler(Vishap_Trap); + Platform_SetBadInstructionHandler(Vishap_Trap); + OPB_typSize = OPV_TypSize; + OPT_typSize = OPV_TypSize; + Vishap_Translate(); + __FINI; +} diff --git a/bootstrap/windows-48/WindowsWrapper.h b/bootstrap/windows-48/WindowsWrapper.h new file mode 100644 index 00000000..cdb8714c --- /dev/null +++ b/bootstrap/windows-48/WindowsWrapper.h @@ -0,0 +1,9 @@ +// WindowsWrapper.h +// +// Includes Windows.h while avoiding conflicts with Oberon types. + +#undef BOOLEAN +#undef CHAR +#include +#define BOOLEAN char +#define CHAR unsigned char diff --git a/bootstrap/windows-48/errors.c b/bootstrap/windows-48/errors.c new file mode 100644 index 00000000..25a074a9 --- /dev/null +++ b/bootstrap/windows-48/errors.c @@ -0,0 +1,198 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" + +typedef + CHAR errors_string[128]; + + +export errors_string errors_errors[350]; + + + + + +export void *errors__init(void) +{ + __DEFMOD; + __REGMOD("errors", 0); +/* BEGIN */ + __MOVE("undeclared identifier", errors_errors[0], 22); + __MOVE("multiply defined identifier", errors_errors[1], 28); + __MOVE("illegal character in number", errors_errors[2], 28); + __MOVE("illegal character in string", errors_errors[3], 28); + __MOVE("identifier does not match procedure name", errors_errors[4], 41); + __MOVE("comment not closed", errors_errors[5], 19); + errors_errors[6][0] = 0x00; + errors_errors[7][0] = 0x00; + errors_errors[8][0] = 0x00; + __MOVE("\'=\' expected", errors_errors[9], 13); + errors_errors[10][0] = 0x00; + errors_errors[11][0] = 0x00; + __MOVE("type definition starts with incorrect symbol", errors_errors[12], 45); + __MOVE("factor starts with incorrect symbol", errors_errors[13], 36); + __MOVE("statement starts with incorrect symbol", errors_errors[14], 39); + __MOVE("declaration followed by incorrect symbol", errors_errors[15], 41); + __MOVE("MODULE expected", errors_errors[16], 16); + errors_errors[17][0] = 0x00; + __MOVE("\'.\' missing", errors_errors[18], 12); + __MOVE("\',\' missing", errors_errors[19], 12); + __MOVE("\':\' missing", errors_errors[20], 12); + errors_errors[21][0] = 0x00; + __MOVE("\')\' missing", errors_errors[22], 12); + __MOVE("\']\' missing", errors_errors[23], 12); + __MOVE("\'}\' missing", errors_errors[24], 12); + __MOVE("OF missing", errors_errors[25], 11); + __MOVE("THEN missing", errors_errors[26], 13); + __MOVE("DO missing", errors_errors[27], 11); + __MOVE("TO missing", errors_errors[28], 11); + errors_errors[29][0] = 0x00; + __MOVE("\'(\' missing", errors_errors[30], 12); + errors_errors[31][0] = 0x00; + errors_errors[32][0] = 0x00; + errors_errors[33][0] = 0x00; + __MOVE("\':=\' missing", errors_errors[34], 13); + __MOVE("\',\' or OF expected", errors_errors[35], 19); + errors_errors[36][0] = 0x00; + errors_errors[37][0] = 0x00; + __MOVE("identifier expected", errors_errors[38], 20); + __MOVE("\';\' missing", errors_errors[39], 12); + errors_errors[40][0] = 0x00; + __MOVE("END missing", errors_errors[41], 12); + errors_errors[42][0] = 0x00; + errors_errors[43][0] = 0x00; + __MOVE("UNTIL missing", errors_errors[44], 14); + errors_errors[45][0] = 0x00; + __MOVE("EXIT not within loop statement", errors_errors[46], 31); + __MOVE("illegally marked identifier", errors_errors[47], 28); + errors_errors[48][0] = 0x00; + errors_errors[49][0] = 0x00; + __MOVE("expression should be constant", errors_errors[50], 30); + __MOVE("constant not an integer", errors_errors[51], 24); + __MOVE("identifier does not denote a type", errors_errors[52], 34); + __MOVE("identifier does not denote a record type", errors_errors[53], 41); + __MOVE("result type of procedure is not a basic type", errors_errors[54], 45); + __MOVE("procedure call of a function", errors_errors[55], 29); + __MOVE("assignment to non-variable", errors_errors[56], 27); + __MOVE("pointer not bound to record or array type", errors_errors[57], 42); + __MOVE("recursive type definition", errors_errors[58], 26); + __MOVE("illegal open array parameter", errors_errors[59], 29); + __MOVE("wrong type of case label", errors_errors[60], 25); + __MOVE("inadmissible type of case label", errors_errors[61], 32); + __MOVE("case label defined more than once", errors_errors[62], 34); + __MOVE("illegal value of constant", errors_errors[63], 26); + __MOVE("more actual than formal parameters", errors_errors[64], 35); + __MOVE("fewer actual than formal parameters", errors_errors[65], 36); + __MOVE("element types of actual array and formal open array differ", errors_errors[66], 59); + __MOVE("actual parameter corresponding to open array is not an array", errors_errors[67], 61); + __MOVE("control variable must be integer", errors_errors[68], 33); + __MOVE("parameter must be an integer constant", errors_errors[69], 38); + __MOVE("pointer or VAR record required as formal receiver", errors_errors[70], 50); + __MOVE("pointer expected as actual receiver", errors_errors[71], 36); + __MOVE("procedure must be bound to a record of the same scope", errors_errors[72], 54); + __MOVE("procedure must have level 0", errors_errors[73], 28); + __MOVE("procedure unknown in base type", errors_errors[74], 31); + __MOVE("invalid call of base procedure", errors_errors[75], 31); + __MOVE("this variable (field) is read only", errors_errors[76], 35); + __MOVE("object is not a record", errors_errors[77], 23); + __MOVE("dereferenced object is not a variable", errors_errors[78], 38); + __MOVE("indexed object is not a variable", errors_errors[79], 33); + __MOVE("index expression is not an integer", errors_errors[80], 35); + __MOVE("index out of specified bounds", errors_errors[81], 30); + __MOVE("indexed variable is not an array", errors_errors[82], 33); + __MOVE("undefined record field", errors_errors[83], 23); + __MOVE("dereferenced variable is not a pointer", errors_errors[84], 39); + __MOVE("guard or test type is not an extension of variable type", errors_errors[85], 56); + __MOVE("guard or testtype is not a pointer", errors_errors[86], 35); + __MOVE("guarded or tested variable is neither a pointer nor a VAR-parameter record", errors_errors[87], 75); + __MOVE("open array not allowed as variable, record field or array element", errors_errors[88], 66); + errors_errors[89][0] = 0x00; + errors_errors[90][0] = 0x00; + errors_errors[91][0] = 0x00; + __MOVE("operand of IN not an integer, or not a set", errors_errors[92], 43); + __MOVE("set element type is not an integer", errors_errors[93], 35); + __MOVE("operand of & is not of type BOOLEAN", errors_errors[94], 36); + __MOVE("operand of OR is not of type BOOLEAN", errors_errors[95], 37); + __MOVE("operand not applicable to (unary) +", errors_errors[96], 36); + __MOVE("operand not applicable to (unary) -", errors_errors[97], 36); + __MOVE("operand of ~ is not of type BOOLEAN", errors_errors[98], 36); + __MOVE("ASSERT fault", errors_errors[99], 13); + __MOVE("incompatible operands of dyadic operator", errors_errors[100], 41); + __MOVE("operand type inapplicable to *", errors_errors[101], 31); + __MOVE("operand type inapplicable to /", errors_errors[102], 31); + __MOVE("operand type inapplicable to DIV", errors_errors[103], 33); + __MOVE("operand type inapplicable to MOD", errors_errors[104], 33); + __MOVE("operand type inapplicable to +", errors_errors[105], 31); + __MOVE("operand type inapplicable to -", errors_errors[106], 31); + __MOVE("operand type inapplicable to = or #", errors_errors[107], 36); + __MOVE("operand type inapplicable to relation", errors_errors[108], 38); + __MOVE("overriding method must be exported", errors_errors[109], 35); + __MOVE("operand is not a type", errors_errors[110], 22); + __MOVE("operand inapplicable to (this) function", errors_errors[111], 40); + __MOVE("operand is not a variable", errors_errors[112], 26); + __MOVE("incompatible assignment", errors_errors[113], 24); + __MOVE("string too long to be assigned", errors_errors[114], 31); + __MOVE("parameter doesn\'t match", errors_errors[115], 24); + __MOVE("number of parameters doesn\'t match", errors_errors[116], 35); + __MOVE("result type doesn\'t match", errors_errors[117], 26); + __MOVE("export mark doesn\'t match with forward declaration", errors_errors[118], 51); + __MOVE("redefinition textually precedes procedure bound to base type", errors_errors[119], 61); + __MOVE("type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN", errors_errors[120], 71); + __MOVE("called object is not a procedure (or is an interrupt procedure)", errors_errors[121], 64); + __MOVE("actual VAR-parameter is not a variable", errors_errors[122], 39); + __MOVE("type of actual parameter is not identical with that of formal VAR-parameter", errors_errors[123], 76); + __MOVE("type of result expression differs from that of procedure", errors_errors[124], 57); + __MOVE("type of case expression is neither INTEGER nor CHAR", errors_errors[125], 52); + __MOVE("this expression cannot be a type or a procedure", errors_errors[126], 48); + __MOVE("illegal use of object", errors_errors[127], 22); + __MOVE("unsatisfied forward reference", errors_errors[128], 30); + __MOVE("unsatisfied forward procedure", errors_errors[129], 30); + __MOVE("WITH clause does not specify a variable", errors_errors[130], 40); + __MOVE("LEN not applied to array", errors_errors[131], 25); + __MOVE("dimension in LEN too large or negative", errors_errors[132], 39); + __MOVE("SYSTEM not imported", errors_errors[135], 20); + __MOVE("key inconsistency of imported module", errors_errors[150], 37); + __MOVE("incorrect symbol file", errors_errors[151], 22); + __MOVE("symbol file of imported module not found", errors_errors[152], 41); + __MOVE("object or symbol file not opened (disk full\?)", errors_errors[153], 46); + __MOVE("recursive import not allowed", errors_errors[154], 29); + __MOVE("generation of new symbol file not allowed", errors_errors[155], 42); + __MOVE("parameter file not found", errors_errors[156], 25); + __MOVE("syntax error in parameter file", errors_errors[157], 31); + __MOVE("not yet implemented", errors_errors[200], 20); + __MOVE("lower bound of set range greater than higher bound", errors_errors[201], 51); + __MOVE("set element greater than MAX(SET) or less than 0", errors_errors[202], 49); + __MOVE("number too large", errors_errors[203], 17); + __MOVE("product too large", errors_errors[204], 18); + __MOVE("division by zero", errors_errors[205], 17); + __MOVE("sum too large", errors_errors[206], 14); + __MOVE("difference too large", errors_errors[207], 21); + __MOVE("overflow in arithmetic shift", errors_errors[208], 29); + __MOVE("case range too large", errors_errors[209], 21); + __MOVE("too many cases in case statement", errors_errors[213], 33); + __MOVE("illegal value of parameter (0 <= p < 256)", errors_errors[218], 42); + __MOVE("machine registers cannot be accessed", errors_errors[219], 37); + __MOVE("illegal value of parameter", errors_errors[220], 27); + __MOVE("too many pointers in a record", errors_errors[221], 30); + __MOVE("too many global pointers", errors_errors[222], 25); + __MOVE("too many record types", errors_errors[223], 22); + __MOVE("too many pointer types", errors_errors[224], 23); + __MOVE("address of pointer variable too large (move forward in text)", errors_errors[225], 61); + __MOVE("too many exported procedures", errors_errors[226], 29); + __MOVE("too many imported modules", errors_errors[227], 26); + __MOVE("too many exported structures", errors_errors[228], 29); + __MOVE("too many nested records for import", errors_errors[229], 35); + __MOVE("too many constants (strings) in module", errors_errors[230], 39); + __MOVE("too many link table entries (external procedures)", errors_errors[231], 50); + __MOVE("too many commands in module", errors_errors[232], 28); + __MOVE("record extension hierarchy too high", errors_errors[233], 36); + __MOVE("export of recursive type not allowed", errors_errors[234], 37); + __MOVE("identifier too long", errors_errors[240], 20); + __MOVE("string too long", errors_errors[241], 16); + __MOVE("address overflow", errors_errors[242], 17); + __MOVE("cyclic type definition not allowed", errors_errors[244], 35); + __MOVE("guarded pointer variable may be manipulated by non-local operations; use auxiliary pointer variable", errors_errors[245], 100); + __MOVE("implicit type cast", errors_errors[301], 19); + __MOVE("inappropriate symbol file ignored", errors_errors[306], 34); + __MOVE("no ELSE symbol after CASE statement sequence may lead to trap", errors_errors[307], 62); + __ENDMOD; +} diff --git a/bootstrap/windows-48/errors.h b/bootstrap/windows-48/errors.h new file mode 100644 index 00000000..c4fe8850 --- /dev/null +++ b/bootstrap/windows-48/errors.h @@ -0,0 +1,18 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef errors__h +#define errors__h + +#include "SYSTEM.h" + +typedef + CHAR errors_string[128]; + + +import errors_string errors_errors[350]; + + +import void *errors__init(void); + + +#endif diff --git a/bootstrap/windows-48/extTools.c b/bootstrap/windows-48/extTools.c new file mode 100644 index 00000000..6f1a6654 --- /dev/null +++ b/bootstrap/windows-48/extTools.c @@ -0,0 +1,112 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "Configuration.h" +#include "Console.h" +#include "OPM.h" +#include "Platform.h" +#include "Strings.h" + + +static CHAR extTools_compilationOptions[1023], extTools_CFLAGS[1023]; + + +export void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len); +export void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len); +static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len); + + +static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len) +{ + INTEGER r, status, exitcode; + __DUP(title, title__len, CHAR); + __DUP(cmd, cmd__len, CHAR); + if (OPM_Verbose) { + Console_String(title, title__len); + Console_String(cmd, cmd__len); + Console_Ln(); + } + r = Platform_System(cmd, cmd__len); + status = __MASK(r, -128); + exitcode = __ASHR(r, 8); + if (exitcode > 127) { + exitcode = exitcode - 256; + } + if (r != 0) { + Console_String(title, title__len); + Console_String(cmd, cmd__len); + Console_Ln(); + Console_String((CHAR*)"-- failed: status ", (LONGINT)19); + Console_Int(status, ((LONGINT)(1))); + Console_String((CHAR*)", exitcode ", (LONGINT)12); + Console_Int(exitcode, ((LONGINT)(1))); + Console_String((CHAR*)".", (LONGINT)2); + Console_Ln(); + if ((status == 0 && exitcode == 127)) { + Console_String((CHAR*)"Is the C compiler in the current command path\?", (LONGINT)47); + Console_Ln(); + } + if (status != 0) { + Platform_Halt(status); + } else { + Platform_Halt(exitcode); + } + } + __DEL(title); + __DEL(cmd); +} + +void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len) +{ + CHAR cmd[1023]; + __DUP(moduleName, moduleName__len, CHAR); + __MOVE("gcc -g", cmd, 7); + Strings_Append(extTools_compilationOptions, ((LONGINT)(1023)), (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)"-c ", (LONGINT)4, (void*)cmd, ((LONGINT)(1023))); + Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)".c", (LONGINT)3, (void*)cmd, ((LONGINT)(1023))); + extTools_execute((CHAR*)"Assemble: ", (LONGINT)11, cmd, ((LONGINT)(1023))); + __DEL(moduleName); +} + +void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len) +{ + CHAR cmd[1023]; + __DUP(additionalopts, additionalopts__len, CHAR); + __MOVE("gcc -g", cmd, 7); + Strings_Append((CHAR*)" ", (LONGINT)2, (void*)cmd, ((LONGINT)(1023))); + Strings_Append(extTools_compilationOptions, ((LONGINT)(1023)), (void*)cmd, ((LONGINT)(1023))); + Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)".c ", (LONGINT)4, (void*)cmd, ((LONGINT)(1023))); + Strings_Append(additionalopts, additionalopts__len, (void*)cmd, ((LONGINT)(1023))); + if (statically) { + Strings_Append((CHAR*)"-static", (LONGINT)8, (void*)cmd, ((LONGINT)(1023))); + } + Strings_Append((CHAR*)" -o ", (LONGINT)5, (void*)cmd, ((LONGINT)(1023))); + Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)" -L\"", (LONGINT)5, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)"/lib\"", (LONGINT)6, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)" -l voc", (LONGINT)8, (void*)cmd, ((LONGINT)(1023))); + extTools_execute((CHAR*)"Assemble and link: ", (LONGINT)20, cmd, ((LONGINT)(1023))); + __DEL(additionalopts); +} + + +export void *extTools__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Console); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(Platform); + __MODULE_IMPORT(Strings); + __REGMOD("extTools", 0); +/* BEGIN */ + Strings_Append((CHAR*)" -I \"", (LONGINT)6, (void*)extTools_compilationOptions, ((LONGINT)(1023))); + Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)extTools_compilationOptions, ((LONGINT)(1023))); + Strings_Append((CHAR*)"/include\" ", (LONGINT)11, (void*)extTools_compilationOptions, ((LONGINT)(1023))); + Platform_GetEnv((CHAR*)"CFLAGS", (LONGINT)7, (void*)extTools_CFLAGS, ((LONGINT)(1023))); + Strings_Append(extTools_CFLAGS, ((LONGINT)(1023)), (void*)extTools_compilationOptions, ((LONGINT)(1023))); + Strings_Append((CHAR*)" ", (LONGINT)2, (void*)extTools_compilationOptions, ((LONGINT)(1023))); + __ENDMOD; +} diff --git a/bootstrap/windows-48/extTools.h b/bootstrap/windows-48/extTools.h new file mode 100644 index 00000000..95d07ddd --- /dev/null +++ b/bootstrap/windows-48/extTools.h @@ -0,0 +1,16 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef extTools__h +#define extTools__h + +#include "SYSTEM.h" + + + + +import void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len); +import void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len); +import void *extTools__init(void); + + +#endif diff --git a/bootstrap/windows-48/vt100.c b/bootstrap/windows-48/vt100.c new file mode 100644 index 00000000..649ea068 --- /dev/null +++ b/bootstrap/windows-48/vt100.c @@ -0,0 +1,258 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#include "SYSTEM.h" +#include "Console.h" +#include "Strings.h" + + +export CHAR vt100_CSI[5]; +static CHAR vt100_tmpstr[32]; + + +export void vt100_CHA (INTEGER n); +export void vt100_CNL (INTEGER n); +export void vt100_CPL (INTEGER n); +export void vt100_CUB (INTEGER n); +export void vt100_CUD (INTEGER n); +export void vt100_CUF (INTEGER n); +export void vt100_CUP (INTEGER n, INTEGER m); +export void vt100_CUU (INTEGER n); +export void vt100_DECTCEMh (void); +export void vt100_DECTCEMl (void); +export void vt100_DSR (INTEGER n); +export void vt100_ED (INTEGER n); +export void vt100_EL (INTEGER n); +static void vt100_EscSeq (INTEGER n, CHAR *letter, LONGINT letter__len); +static void vt100_EscSeq0 (CHAR *letter, LONGINT letter__len); +static void vt100_EscSeq2 (INTEGER n, INTEGER m, CHAR *letter, LONGINT letter__len); +static void vt100_EscSeqSwapped (INTEGER n, CHAR *letter, LONGINT letter__len); +export void vt100_HVP (INTEGER n, INTEGER m); +export void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len); +export void vt100_RCP (void); +static void vt100_Reverse0 (CHAR *str, LONGINT str__len, INTEGER start, INTEGER end); +export void vt100_SCP (void); +export void vt100_SD (INTEGER n); +export void vt100_SGR (INTEGER n); +export void vt100_SGR2 (INTEGER n, INTEGER m); +export void vt100_SU (INTEGER n); +export void vt100_SetAttr (CHAR *attr, LONGINT attr__len); + + +static void vt100_Reverse0 (CHAR *str, LONGINT str__len, INTEGER start, INTEGER end) +{ + CHAR h; + while (start < end) { + h = str[__X(start, str__len)]; + str[__X(start, str__len)] = str[__X(end, str__len)]; + str[__X(end, str__len)] = h; + start += 1; + end -= 1; + } +} + +void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len) +{ + CHAR b[21]; + INTEGER s, e; + SHORTINT maxLength; + maxLength = 11; + if (int_ == (-2147483647-1)) { + __MOVE("-2147483648", b, 12); + e = 11; + } else { + if (int_ < 0) { + b[0] = '-'; + int_ = -int_; + s = 1; + } else { + s = 0; + } + e = s; + do { + b[__X(e, ((LONGINT)(21)))] = (CHAR)(__MOD(int_, 10) + 48); + int_ = __DIV(int_, 10); + e += 1; + } while (!(int_ == 0)); + b[__X(e, ((LONGINT)(21)))] = 0x00; + vt100_Reverse0((void*)b, ((LONGINT)(21)), s, e - 1); + } + __COPY(b, str, str__len); +} + +static void vt100_EscSeq0 (CHAR *letter, LONGINT letter__len) +{ + CHAR cmd[9]; + __DUP(letter, letter__len, CHAR); + __COPY(vt100_CSI, cmd, ((LONGINT)(9))); + Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(9))); + Console_String(cmd, ((LONGINT)(9))); + __DEL(letter); +} + +static void vt100_EscSeq (INTEGER n, CHAR *letter, LONGINT letter__len) +{ + CHAR nstr[2]; + CHAR cmd[7]; + __DUP(letter, letter__len, CHAR); + vt100_IntToStr(n, (void*)nstr, ((LONGINT)(2))); + __COPY(vt100_CSI, cmd, ((LONGINT)(7))); + Strings_Append(nstr, ((LONGINT)(2)), (void*)cmd, ((LONGINT)(7))); + Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(7))); + Console_String(cmd, ((LONGINT)(7))); + __DEL(letter); +} + +static void vt100_EscSeqSwapped (INTEGER n, CHAR *letter, LONGINT letter__len) +{ + CHAR nstr[2]; + CHAR cmd[7]; + __DUP(letter, letter__len, CHAR); + vt100_IntToStr(n, (void*)nstr, ((LONGINT)(2))); + __COPY(vt100_CSI, cmd, ((LONGINT)(7))); + Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(7))); + Strings_Append(nstr, ((LONGINT)(2)), (void*)cmd, ((LONGINT)(7))); + Console_String(cmd, ((LONGINT)(7))); + __DEL(letter); +} + +static void vt100_EscSeq2 (INTEGER n, INTEGER m, CHAR *letter, LONGINT letter__len) +{ + CHAR nstr[5], mstr[5]; + CHAR cmd[12]; + __DUP(letter, letter__len, CHAR); + vt100_IntToStr(n, (void*)nstr, ((LONGINT)(5))); + vt100_IntToStr(m, (void*)mstr, ((LONGINT)(5))); + __COPY(vt100_CSI, cmd, ((LONGINT)(12))); + Strings_Append(nstr, ((LONGINT)(5)), (void*)cmd, ((LONGINT)(12))); + Strings_Append((CHAR*)";", (LONGINT)2, (void*)cmd, ((LONGINT)(12))); + Strings_Append(mstr, ((LONGINT)(5)), (void*)cmd, ((LONGINT)(12))); + Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(12))); + Console_String(cmd, ((LONGINT)(12))); + __DEL(letter); +} + +void vt100_CUU (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"A", (LONGINT)2); +} + +void vt100_CUD (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"B", (LONGINT)2); +} + +void vt100_CUF (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"C", (LONGINT)2); +} + +void vt100_CUB (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"D", (LONGINT)2); +} + +void vt100_CNL (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"E", (LONGINT)2); +} + +void vt100_CPL (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"F", (LONGINT)2); +} + +void vt100_CHA (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"G", (LONGINT)2); +} + +void vt100_CUP (INTEGER n, INTEGER m) +{ + vt100_EscSeq2(n, m, (CHAR*)"H", (LONGINT)2); +} + +void vt100_ED (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"J", (LONGINT)2); +} + +void vt100_EL (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"K", (LONGINT)2); +} + +void vt100_SU (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"S", (LONGINT)2); +} + +void vt100_SD (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"T", (LONGINT)2); +} + +void vt100_HVP (INTEGER n, INTEGER m) +{ + vt100_EscSeq2(n, m, (CHAR*)"f", (LONGINT)2); +} + +void vt100_SGR (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"m", (LONGINT)2); +} + +void vt100_SGR2 (INTEGER n, INTEGER m) +{ + vt100_EscSeq2(n, m, (CHAR*)"m", (LONGINT)2); +} + +void vt100_DSR (INTEGER n) +{ + vt100_EscSeq(6, (CHAR*)"n", (LONGINT)2); +} + +void vt100_SCP (void) +{ + vt100_EscSeq0((CHAR*)"s", (LONGINT)2); +} + +void vt100_RCP (void) +{ + vt100_EscSeq0((CHAR*)"u", (LONGINT)2); +} + +void vt100_DECTCEMl (void) +{ + vt100_EscSeq0((CHAR*)"\?25l", (LONGINT)5); +} + +void vt100_DECTCEMh (void) +{ + vt100_EscSeq0((CHAR*)"\?25h", (LONGINT)5); +} + +void vt100_SetAttr (CHAR *attr, LONGINT attr__len) +{ + CHAR tmpstr[16]; + __DUP(attr, attr__len, CHAR); + __COPY(vt100_CSI, tmpstr, ((LONGINT)(16))); + Strings_Append(attr, attr__len, (void*)tmpstr, ((LONGINT)(16))); + Console_String(tmpstr, ((LONGINT)(16))); + __DEL(attr); +} + + +export void *vt100__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Console); + __MODULE_IMPORT(Strings); + __REGMOD("vt100", 0); + __REGCMD("DECTCEMh", vt100_DECTCEMh); + __REGCMD("DECTCEMl", vt100_DECTCEMl); + __REGCMD("RCP", vt100_RCP); + __REGCMD("SCP", vt100_SCP); +/* BEGIN */ + __COPY("", vt100_CSI, ((LONGINT)(5))); + Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5))); + __ENDMOD; +} diff --git a/bootstrap/windows-48/vt100.h b/bootstrap/windows-48/vt100.h new file mode 100644 index 00000000..6d210ec9 --- /dev/null +++ b/bootstrap/windows-48/vt100.h @@ -0,0 +1,37 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef vt100__h +#define vt100__h + +#include "SYSTEM.h" + + +import CHAR vt100_CSI[5]; + + +import void vt100_CHA (INTEGER n); +import void vt100_CNL (INTEGER n); +import void vt100_CPL (INTEGER n); +import void vt100_CUB (INTEGER n); +import void vt100_CUD (INTEGER n); +import void vt100_CUF (INTEGER n); +import void vt100_CUP (INTEGER n, INTEGER m); +import void vt100_CUU (INTEGER n); +import void vt100_DECTCEMh (void); +import void vt100_DECTCEMl (void); +import void vt100_DSR (INTEGER n); +import void vt100_ED (INTEGER n); +import void vt100_EL (INTEGER n); +import void vt100_HVP (INTEGER n, INTEGER m); +import void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len); +import void vt100_RCP (void); +import void vt100_SCP (void); +import void vt100_SD (INTEGER n); +import void vt100_SGR (INTEGER n); +import void vt100_SGR2 (INTEGER n, INTEGER m); +import void vt100_SU (INTEGER n); +import void vt100_SetAttr (CHAR *attr, LONGINT attr__len); +import void *vt100__init(void); + + +#endif diff --git a/bootstrap/windows-88/Configuration.c b/bootstrap/windows-88/Configuration.c new file mode 100644 index 00000000..c4d62d40 --- /dev/null +++ b/bootstrap/windows-88/Configuration.c @@ -0,0 +1,17 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" + + + + + + + +export void *Configuration__init(void) +{ + __DEFMOD; + __REGMOD("Configuration", 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/windows-88/Configuration.h b/bootstrap/windows-88/Configuration.h new file mode 100644 index 00000000..b076eaee --- /dev/null +++ b/bootstrap/windows-88/Configuration.h @@ -0,0 +1,15 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Configuration__h +#define Configuration__h + +#define LARGE +#include "SYSTEM.h" + + + + +import void *Configuration__init(void); + + +#endif diff --git a/bootstrap/windows-88/Console.c b/bootstrap/windows-88/Console.c new file mode 100644 index 00000000..e4c5285c --- /dev/null +++ b/bootstrap/windows-88/Console.c @@ -0,0 +1,151 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "Platform.h" + + +static CHAR Console_line[128]; +static INTEGER Console_pos; + + +export void Console_Bool (BOOLEAN b); +export void Console_Char (CHAR ch); +export void Console_Flush (void); +export void Console_Hex (LONGINT i); +export void Console_Int (LONGINT i, LONGINT n); +export void Console_Ln (void); +export void Console_Read (CHAR *ch); +export void Console_ReadLine (CHAR *line, LONGINT line__len); +export void Console_String (CHAR *s, LONGINT s__len); + + +void Console_Flush (void) +{ + INTEGER error; + error = Platform_Write(Platform_StdOut, (LONGINT)(uintptr_t)Console_line, Console_pos); + Console_pos = 0; +} + +void Console_Char (CHAR ch) +{ + if (Console_pos == 128) { + Console_Flush(); + } + Console_line[__X(Console_pos, ((LONGINT)(128)))] = ch; + Console_pos += 1; + if (ch == 0x0a) { + Console_Flush(); + } +} + +void Console_String (CHAR *s, LONGINT s__len) +{ + INTEGER i; + __DUP(s, s__len, CHAR); + i = 0; + while (s[__X(i, s__len)] != 0x00) { + Console_Char(s[__X(i, s__len)]); + i += 1; + } + __DEL(s); +} + +void Console_Int (LONGINT i, LONGINT n) +{ + CHAR s[32]; + LONGINT i1, k; + if (i == __LSHL(1, 63, LONGINT)) { + __MOVE("8085774586302733229", s, 20); + k = 19; + } else { + i1 = __ABS(i); + s[0] = (CHAR)(__MOD(i1, 10) + 48); + i1 = __DIV(i1, 10); + k = 1; + while (i1 > 0) { + s[__X(k, ((LONGINT)(32)))] = (CHAR)(__MOD(i1, 10) + 48); + i1 = __DIV(i1, 10); + k += 1; + } + } + if (i < 0) { + s[__X(k, ((LONGINT)(32)))] = '-'; + k += 1; + } + while (n > k) { + Console_Char(' '); + n -= 1; + } + while (k > 0) { + k -= 1; + Console_Char(s[__X(k, ((LONGINT)(32)))]); + } +} + +void Console_Ln (void) +{ + Console_Char(0x0a); +} + +void Console_Bool (BOOLEAN b) +{ + if (b) { + Console_String((CHAR*)"TRUE", (LONGINT)5); + } else { + Console_String((CHAR*)"FALSE", (LONGINT)6); + } +} + +void Console_Hex (LONGINT i) +{ + LONGINT k, n; + k = -28; + while (k <= 0) { + n = __MASK(__ASH(i, k), -16); + if (n <= 9) { + Console_Char((CHAR)(48 + n)); + } else { + Console_Char((CHAR)(55 + n)); + } + k += 4; + } +} + +void Console_Read (CHAR *ch) +{ + LONGINT n; + INTEGER error; + Console_Flush(); + error = Platform_ReadBuf(Platform_StdIn, (void*)&*ch, ((LONGINT)(1)), &n); + if (n != 1) { + *ch = 0x00; + } +} + +void Console_ReadLine (CHAR *line, LONGINT line__len) +{ + LONGINT i; + CHAR ch; + Console_Flush(); + i = 0; + Console_Read(&ch); + while ((((i < line__len - 1 && ch != 0x0a)) && ch != 0x00)) { + line[__X(i, line__len)] = ch; + i += 1; + Console_Read(&ch); + } + line[__X(i, line__len)] = 0x00; +} + + +export void *Console__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Platform); + __REGMOD("Console", 0); + __REGCMD("Flush", Console_Flush); + __REGCMD("Ln", Console_Ln); +/* BEGIN */ + Console_pos = 0; + __ENDMOD; +} diff --git a/bootstrap/windows-88/Console.h b/bootstrap/windows-88/Console.h new file mode 100644 index 00000000..d8a9b11e --- /dev/null +++ b/bootstrap/windows-88/Console.h @@ -0,0 +1,24 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Console__h +#define Console__h + +#define LARGE +#include "SYSTEM.h" + + + + +import void Console_Bool (BOOLEAN b); +import void Console_Char (CHAR ch); +import void Console_Flush (void); +import void Console_Hex (LONGINT i); +import void Console_Int (LONGINT i, LONGINT n); +import void Console_Ln (void); +import void Console_Read (CHAR *ch); +import void Console_ReadLine (CHAR *line, LONGINT line__len); +import void Console_String (CHAR *s, LONGINT s__len); +import void *Console__init(void); + + +#endif diff --git a/bootstrap/windows-88/Files.c b/bootstrap/windows-88/Files.c new file mode 100644 index 00000000..f5f4a2aa --- /dev/null +++ b/bootstrap/windows-88/Files.c @@ -0,0 +1,1079 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "Configuration.h" +#include "Console.h" +#include "Heap.h" +#include "Platform.h" +#include "Strings.h" + +typedef + struct Files_Handle *Files_File; + +typedef + struct Files_BufDesc { + Files_File f; + BOOLEAN chg; + LONGINT org, size; + SYSTEM_BYTE data[4096]; + } Files_BufDesc; + +typedef + Files_BufDesc *Files_Buffer; + +typedef + CHAR Files_FileName[101]; + +typedef + struct Files_Handle { + Files_FileName workName, registerName; + BOOLEAN tempFile; + Platform_FileIdentity identity; + LONGINT fd, len, pos; + Files_Buffer bufs[4]; + INTEGER swapper, state; + } Files_Handle; + +typedef + struct Files_Rider { + LONGINT res; + BOOLEAN eof; + Files_Buffer buf; + LONGINT org, offset; + } Files_Rider; + + +static LONGINT Files_fileTab[256]; +static INTEGER Files_tempno; +static CHAR Files_HOME[1024]; +static struct { + LONGINT len[1]; + CHAR data[1]; +} *Files_SearchPath; + +export LONGINT *Files_Handle__typ; +export LONGINT *Files_BufDesc__typ; +export LONGINT *Files_Rider__typ; + +export Files_File Files_Base (Files_Rider *r, LONGINT *r__typ); +static Files_File Files_CacheEntry (Platform_FileIdentity identity); +export void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res); +export void Files_Close (Files_File f); +static void Files_Create (Files_File f); +export void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res); +static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INTEGER errcode); +static void Files_Finalize (SYSTEM_PTR o); +static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len); +static void Files_Flush (Files_Buffer buf); +export void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d); +export void Files_GetName (Files_File f, CHAR *name, LONGINT name__len); +static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len); +static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len); +static void Files_Init (void); +export LONGINT Files_Length (Files_File f); +static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len); +export Files_File Files_New (CHAR *name, LONGINT name__len); +export Files_File Files_Old (CHAR *name, LONGINT name__len); +export LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ); +export void Files_Purge (Files_File f); +export void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x); +export void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x); +export void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len); +export void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n); +export void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x); +export void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x); +export void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x); +export void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +export void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x); +export void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x); +export void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x); +export void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +export void Files_Register (Files_File f); +export void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res); +static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len); +export void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos); +export void Files_SetSearchPath (CHAR *path, LONGINT path__len); +export void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x); +export void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x); +export void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n); +export void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x); +export void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x); +export void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x); +export void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x); +export void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x); +export void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x); +export void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); + +#define Files_IdxTrap() __HALT(-1) + +static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INTEGER errcode) +{ + __DUP(s, s__len, CHAR); + Console_Ln(); + Console_String((CHAR*)"-- ", (LONGINT)4); + Console_String(s, s__len); + Console_String((CHAR*)": ", (LONGINT)3); + if (f != NIL) { + if (f->registerName[0] != 0x00) { + Console_String(f->registerName, ((LONGINT)(101))); + } else { + Console_String(f->workName, ((LONGINT)(101))); + } + if (f->fd != 0) { + Console_String((CHAR*)"f.fd = ", (LONGINT)8); + Console_Int(f->fd, ((LONGINT)(1))); + } + } + if (errcode != 0) { + Console_String((CHAR*)" errcode = ", (LONGINT)12); + Console_Int(errcode, ((LONGINT)(1))); + } + Console_Ln(); + __HALT(99); + __DEL(s); +} + +static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len) +{ + INTEGER i, j; + __DUP(dir, dir__len, CHAR); + __DUP(name, name__len, CHAR); + i = 0; + j = 0; + while (dir[i] != 0x00) { + dest[i] = dir[i]; + i += 1; + } + if (dest[i - 1] != '/') { + dest[i] = '/'; + i += 1; + } + while (name[j] != 0x00) { + dest[i] = name[j]; + i += 1; + j += 1; + } + dest[i] = 0x00; + __DEL(dir); + __DEL(name); +} + +static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len) +{ + LONGINT n, i, j; + __DUP(finalName, finalName__len, CHAR); + Files_tempno += 1; + n = Files_tempno; + i = 0; + if (finalName[0] != '/') { + while (Platform_CWD[i] != 0x00) { + name[i] = Platform_CWD[i]; + i += 1; + } + if (Platform_CWD[i - 1] != '/') { + name[i] = '/'; + i += 1; + } + } + j = 0; + while (finalName[j] != 0x00) { + name[i] = finalName[j]; + i += 1; + j += 1; + } + i -= 1; + while (name[i] != '/') { + i -= 1; + } + name[i + 1] = '.'; + name[i + 2] = 't'; + name[i + 3] = 'm'; + name[i + 4] = 'p'; + name[i + 5] = '.'; + i += 6; + while (n > 0) { + name[i] = (CHAR)(__MOD(n, 10) + 48); + n = __DIV(n, 10); + i += 1; + } + name[i] = '.'; + i += 1; + n = Platform_PID; + while (n > 0) { + name[i] = (CHAR)(__MOD(n, 10) + 48); + n = __DIV(n, 10); + i += 1; + } + name[i] = 0x00; + __DEL(finalName); +} + +static void Files_Create (Files_File f) +{ + Platform_FileIdentity identity; + BOOLEAN done; + INTEGER error; + CHAR err[32]; + if (f->fd == -1) { + if (f->state == 1) { + Files_GetTempName(f->registerName, ((LONGINT)(101)), (void*)f->workName, ((LONGINT)(101))); + f->tempFile = 1; + } else if (f->state == 2) { + __COPY(f->registerName, f->workName, ((LONGINT)(101))); + f->registerName[0] = 0x00; + f->tempFile = 0; + } + error = Platform_Unlink((void*)f->workName, ((LONGINT)(101))); + error = Platform_New((void*)f->workName, ((LONGINT)(101)), &f->fd); + done = error == 0; + if ((!done && Platform_TooManyFiles(error)) || (done && f->fd >= 256)) { + if ((done && f->fd >= 256)) { + error = Platform_Close(f->fd); + } + Heap_GC(1); + error = Platform_New((void*)f->workName, ((LONGINT)(101)), &f->fd); + done = f->fd == 0; + } + if (done) { + if (f->fd >= 256) { + error = Platform_Close(f->fd); + Files_Err((CHAR*)"too many files open", (LONGINT)20, f, 0); + } else { + Files_fileTab[f->fd] = (LONGINT)(uintptr_t)f; + Heap_FileCount += 1; + Heap_RegisterFinalizer((void*)f, Files_Finalize); + f->state = 0; + f->pos = 0; + error = Platform_Identify(f->fd, &f->identity, Platform_FileIdentity__typ); + } + } else { + if (Platform_NoSuchDirectory(error)) { + __MOVE("no such directory", err, 18); + } else if (Platform_TooManyFiles(error)) { + __MOVE("too many files open", err, 20); + } else { + __MOVE("file not created", err, 17); + } + Files_Err(err, ((LONGINT)(32)), f, error); + } + } +} + +static void Files_Flush (Files_Buffer buf) +{ + INTEGER error; + Files_File f = NIL; + if (buf->chg) { + f = buf->f; + Files_Create(f); + if (buf->org != f->pos) { + error = Platform_Seek(f->fd, buf->org, Platform_SeekSet); + } + error = Platform_Write(f->fd, (LONGINT)(uintptr_t)buf->data, buf->size); + if (error != 0) { + Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error); + } + f->pos = buf->org + buf->size; + buf->chg = 0; + error = Platform_Identify(f->fd, &f->identity, Platform_FileIdentity__typ); + if (error != 0) { + Files_Err((CHAR*)"error identifying file", (LONGINT)23, f, error); + } + } +} + +void Files_Close (Files_File f) +{ + LONGINT i; + INTEGER error; + if (f->state != 1 || f->registerName[0] != 0x00) { + Files_Create(f); + i = 0; + while ((i < 4 && f->bufs[i] != NIL)) { + Files_Flush(f->bufs[i]); + i += 1; + } + error = Platform_Sync(f->fd); + if (error != 0) { + Files_Err((CHAR*)"error writing file", (LONGINT)19, f, error); + } + Files_fileTab[f->fd] = 0; + error = Platform_Close(f->fd); + f->fd = -1; + f->state = 1; + Heap_FileCount -= 1; + } +} + +LONGINT Files_Length (Files_File f) +{ + LONGINT _o_result; + _o_result = f->len; + return _o_result; +} + +Files_File Files_New (CHAR *name, LONGINT name__len) +{ + Files_File _o_result; + Files_File f = NIL; + __DUP(name, name__len, CHAR); + __NEW(f, Files_Handle); + f->workName[0] = 0x00; + __COPY(name, f->registerName, ((LONGINT)(101))); + f->fd = -1; + f->state = 1; + f->len = 0; + f->pos = 0; + f->swapper = -1; + _o_result = f; + __DEL(name); + return _o_result; +} + +static void Files_ScanPath (INTEGER *pos, CHAR *dir, LONGINT dir__len) +{ + INTEGER i; + CHAR ch; + i = 0; + if (Files_SearchPath == NIL) { + if (*pos == 0) { + dir[0] = '.'; + i = 1; + *pos += 1; + } + } else { + ch = (Files_SearchPath->data)[*pos]; + while (ch == ' ' || ch == ';') { + *pos += 1; + ch = (Files_SearchPath->data)[*pos]; + } + if (ch == '~') { + *pos += 1; + ch = (Files_SearchPath->data)[*pos]; + while (Files_HOME[i] != 0x00) { + dir[i] = Files_HOME[i]; + i += 1; + } + if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) { + while ((i > 0 && dir[i - 1] != '/')) { + i -= 1; + } + } + } + while ((ch != 0x00 && ch != ';')) { + dir[i] = ch; + i += 1; + *pos += 1; + ch = (Files_SearchPath->data)[*pos]; + } + while ((i > 0 && dir[i - 1] == ' ')) { + i -= 1; + } + } + dir[i] = 0x00; +} + +static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len) +{ + BOOLEAN _o_result; + INTEGER i; + CHAR ch; + i = 0; + ch = name[0]; + while ((ch != 0x00 && ch != '/')) { + i += 1; + ch = name[i]; + } + _o_result = ch == '/'; + return _o_result; +} + +static Files_File Files_CacheEntry (Platform_FileIdentity identity) +{ + Files_File _o_result; + Files_File f = NIL; + INTEGER i, error; + i = 0; + while (i < 256) { + f = (Files_File)(uintptr_t)Files_fileTab[i]; + if ((f != NIL && Platform_SameFile(identity, f->identity))) { + if (!Platform_SameFileTime(identity, f->identity)) { + i = 0; + while (i < 4) { + if (f->bufs[i] != NIL) { + f->bufs[i]->org = -1; + f->bufs[i] = NIL; + } + i += 1; + } + f->swapper = -1; + f->identity = identity; + error = Platform_Size(f->fd, &f->len); + } + _o_result = f; + return _o_result; + } + i += 1; + } + _o_result = NIL; + return _o_result; +} + +Files_File Files_Old (CHAR *name, LONGINT name__len) +{ + Files_File _o_result; + Files_File f = NIL; + LONGINT fd; + INTEGER pos; + BOOLEAN done; + CHAR dir[256], path[256]; + INTEGER error; + Platform_FileIdentity identity; + __DUP(name, name__len, CHAR); + if (name[0] != 0x00) { + if (Files_HasDir((void*)name, name__len)) { + dir[0] = 0x00; + __COPY(name, path, ((LONGINT)(256))); + } else { + pos = 0; + Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256))); + Files_MakeFileName(dir, ((LONGINT)(256)), name, name__len, (void*)path, ((LONGINT)(256))); + Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256))); + } + for (;;) { + error = Platform_OldRW((void*)path, ((LONGINT)(256)), &fd); + done = error == 0; + if ((!done && Platform_TooManyFiles(error)) || (done && fd >= 256)) { + if ((done && fd >= 256)) { + error = Platform_Close(fd); + } + Heap_GC(1); + error = Platform_OldRW((void*)path, ((LONGINT)(256)), &fd); + done = error == 0; + if ((!done && Platform_TooManyFiles(error))) { + Files_Err((CHAR*)"too many files open", (LONGINT)20, f, error); + } + } + if ((!done && Platform_Inaccessible(error))) { + error = Platform_OldRO((void*)path, ((LONGINT)(256)), &fd); + done = error == 0; + } + if ((!done && !Platform_Absent(error))) { + Console_String((CHAR*)"Warning: Files.Old ", (LONGINT)20); + Console_String(name, name__len); + Console_String((CHAR*)" error = ", (LONGINT)10); + Console_Int(error, ((LONGINT)(0))); + Console_Ln(); + } + if (done) { + error = Platform_Identify(fd, &identity, Platform_FileIdentity__typ); + f = Files_CacheEntry(identity); + if (f != NIL) { + error = Platform_Close(fd); + _o_result = f; + __DEL(name); + return _o_result; + } else if (fd >= 256) { + error = Platform_Close(fd); + Files_Err((CHAR*)"too many files open", (LONGINT)20, f, 0); + } else { + __NEW(f, Files_Handle); + Files_fileTab[fd] = (LONGINT)(uintptr_t)f; + Heap_FileCount += 1; + Heap_RegisterFinalizer((void*)f, Files_Finalize); + f->fd = fd; + f->state = 0; + f->pos = 0; + f->swapper = -1; + error = Platform_Size(fd, &f->len); + __COPY(name, f->workName, ((LONGINT)(101))); + f->registerName[0] = 0x00; + f->tempFile = 0; + f->identity = identity; + _o_result = f; + __DEL(name); + return _o_result; + } + } else if (dir[0] == 0x00) { + _o_result = NIL; + __DEL(name); + return _o_result; + } else { + Files_MakeFileName(dir, ((LONGINT)(256)), name, name__len, (void*)path, ((LONGINT)(256))); + Files_ScanPath(&pos, (void*)dir, ((LONGINT)(256))); + } + } + } else { + _o_result = NIL; + __DEL(name); + return _o_result; + } + __RETCHK; +} + +void Files_Purge (Files_File f) +{ + INTEGER i; + Platform_FileIdentity identity; + INTEGER error; + i = 0; + while (i < 4) { + if (f->bufs[i] != NIL) { + f->bufs[i]->org = -1; + f->bufs[i] = NIL; + } + i += 1; + } + if (f->fd != -1) { + error = Platform_Truncate(f->fd, ((LONGINT)(0))); + error = Platform_Seek(f->fd, ((LONGINT)(0)), Platform_SeekSet); + } + f->pos = 0; + f->len = 0; + f->swapper = -1; + error = Platform_Identify(f->fd, &identity, Platform_FileIdentity__typ); + Platform_SetMTime(&f->identity, Platform_FileIdentity__typ, identity); +} + +void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d) +{ + Platform_FileIdentity identity; + INTEGER error; + Files_Create(f); + error = Platform_Identify(f->fd, &identity, Platform_FileIdentity__typ); + Platform_MTimeAsClock(identity, &*t, &*d); +} + +LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ) +{ + LONGINT _o_result; + _o_result = (*r).org + (*r).offset; + return _o_result; +} + +void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos) +{ + LONGINT org, offset, i, n; + Files_Buffer buf = NIL; + INTEGER error; + if (f != NIL) { + if (pos > f->len) { + pos = f->len; + } else if (pos < 0) { + pos = 0; + } + offset = __MASK(pos, -4096); + org = pos - offset; + i = 0; + while ((((i < 4 && f->bufs[i] != NIL)) && org != f->bufs[i]->org)) { + i += 1; + } + if (i < 4) { + if (f->bufs[i] == NIL) { + __NEW(buf, Files_BufDesc); + buf->chg = 0; + buf->org = -1; + buf->f = f; + f->bufs[i] = buf; + } else { + buf = f->bufs[i]; + } + } else { + f->swapper = __MASK(f->swapper + 1, -4); + buf = f->bufs[f->swapper]; + Files_Flush(buf); + } + if (buf->org != org) { + if (org == f->len) { + buf->size = 0; + } else { + Files_Create(f); + if (f->pos != org) { + error = Platform_Seek(f->fd, org, Platform_SeekSet); + } + error = Platform_ReadBuf(f->fd, (void*)buf->data, ((LONGINT)(4096)), &n); + if (error != 0) { + Files_Err((CHAR*)"read from file not done", (LONGINT)24, f, error); + } + f->pos = org + n; + buf->size = n; + } + buf->org = org; + buf->chg = 0; + } + } else { + buf = NIL; + org = 0; + offset = 0; + } + (*r).buf = buf; + (*r).org = org; + (*r).offset = offset; + (*r).eof = 0; + (*r).res = 0; +} + +void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x) +{ + LONGINT offset; + Files_Buffer buf = NIL; + buf = (*r).buf; + offset = (*r).offset; + if ((*r).org != buf->org) { + Files_Set(&*r, r__typ, buf->f, (*r).org + offset); + buf = (*r).buf; + offset = (*r).offset; + } + if (offset < buf->size) { + *x = buf->data[offset]; + (*r).offset = offset + 1; + } else if ((*r).org + offset < buf->f->len) { + Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset); + *x = (*r).buf->data[0]; + (*r).offset = 1; + } else { + *x = 0x00; + (*r).eof = 1; + } +} + +void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n) +{ + LONGINT xpos, min, restInBuf, offset; + Files_Buffer buf = NIL; + if (n > x__len) { + Files_IdxTrap(); + } + xpos = 0; + buf = (*r).buf; + offset = (*r).offset; + while (n > 0) { + if ((*r).org != buf->org || offset >= 4096) { + Files_Set(&*r, r__typ, buf->f, (*r).org + offset); + buf = (*r).buf; + offset = (*r).offset; + } + restInBuf = buf->size - offset; + if (restInBuf == 0) { + (*r).res = n; + (*r).eof = 1; + return; + } else if (n > restInBuf) { + min = restInBuf; + } else { + min = n; + } + __MOVE((LONGINT)(uintptr_t)buf->data + offset, (LONGINT)(uintptr_t)x + xpos, min); + offset += min; + (*r).offset = offset; + xpos += min; + n -= min; + } + (*r).res = 0; + (*r).eof = 0; +} + +void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len) +{ + Files_ReadBytes(&*r, r__typ, (void*)x, x__len * ((LONGINT)(1)), ((LONGINT)(1))); +} + +Files_File Files_Base (Files_Rider *r, LONGINT *r__typ) +{ + Files_File _o_result; + _o_result = (*r).buf->f; + return _o_result; +} + +void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x) +{ + Files_Buffer buf = NIL; + LONGINT offset; + buf = (*r).buf; + offset = (*r).offset; + if ((*r).org != buf->org || offset >= 4096) { + Files_Set(&*r, r__typ, buf->f, (*r).org + offset); + buf = (*r).buf; + offset = (*r).offset; + } + buf->data[offset] = x; + buf->chg = 1; + if (offset == buf->size) { + buf->size += 1; + buf->f->len += 1; + } + (*r).offset = offset + 1; + (*r).res = 0; +} + +void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n) +{ + LONGINT xpos, min, restInBuf, offset; + Files_Buffer buf = NIL; + if (n > x__len) { + Files_IdxTrap(); + } + xpos = 0; + buf = (*r).buf; + offset = (*r).offset; + while (n > 0) { + if ((*r).org != buf->org || offset >= 4096) { + Files_Set(&*r, r__typ, buf->f, (*r).org + offset); + buf = (*r).buf; + offset = (*r).offset; + } + restInBuf = 4096 - offset; + if (n > restInBuf) { + min = restInBuf; + } else { + min = n; + } + __MOVE((LONGINT)(uintptr_t)x + xpos, (LONGINT)(uintptr_t)buf->data + offset, min); + offset += min; + (*r).offset = offset; + if (offset > buf->size) { + buf->f->len += offset - buf->size; + buf->size = offset; + } + xpos += min; + n -= min; + buf->chg = 1; + } + (*r).res = 0; +} + +void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res) +{ + __DUP(name, name__len, CHAR); + *res = Platform_Unlink((void*)name, name__len); + __DEL(name); +} + +void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res) +{ + LONGINT fdold, fdnew, n; + INTEGER error, ignore; + Platform_FileIdentity oldidentity, newidentity; + CHAR buf[4096]; + __DUP(old, old__len, CHAR); + __DUP(new, new__len, CHAR); + error = Platform_IdentifyByName(old, old__len, &oldidentity, Platform_FileIdentity__typ); + if (error == 0) { + error = Platform_IdentifyByName(new, new__len, &newidentity, Platform_FileIdentity__typ); + if ((error != 0 && !Platform_SameFile(oldidentity, newidentity))) { + Files_Delete(new, new__len, &error); + } + error = Platform_Rename((void*)old, old__len, (void*)new, new__len); + if (!Platform_DifferentFilesystems(error)) { + *res = error; + return; + } else { + error = Platform_OldRO((void*)old, old__len, &fdold); + if (error != 0) { + *res = 2; + return; + } + error = Platform_New((void*)new, new__len, &fdnew); + if (error != 0) { + error = Platform_Close(fdold); + *res = 3; + return; + } + error = Platform_Read(fdold, (LONGINT)(uintptr_t)buf, ((LONGINT)(4096)), &n); + while (n > 0) { + error = Platform_Write(fdnew, (LONGINT)(uintptr_t)buf, n); + if (error != 0) { + ignore = Platform_Close(fdold); + ignore = Platform_Close(fdnew); + Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error); + } + error = Platform_Read(fdold, (LONGINT)(uintptr_t)buf, ((LONGINT)(4096)), &n); + } + ignore = Platform_Close(fdold); + ignore = Platform_Close(fdnew); + if (n == 0) { + error = Platform_Unlink((void*)old, old__len); + *res = 0; + } else { + Files_Err((CHAR*)"cannot move file", (LONGINT)17, NIL, error); + } + } + } else { + *res = 2; + } + __DEL(old); + __DEL(new); +} + +void Files_Register (Files_File f) +{ + INTEGER idx, errcode; + Files_File f1 = NIL; + CHAR file[104]; + if ((f->state == 1 && f->registerName[0] != 0x00)) { + f->state = 2; + } + Files_Close(f); + if (f->registerName[0] != 0x00) { + Files_Rename(f->workName, ((LONGINT)(101)), f->registerName, ((LONGINT)(101)), &errcode); + if (errcode != 0) { + __COPY(f->registerName, file, ((LONGINT)(104))); + __HALT(99); + } + __COPY(f->registerName, f->workName, ((LONGINT)(101))); + f->registerName[0] = 0x00; + f->tempFile = 0; + } +} + +void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res) +{ + __DUP(path, path__len, CHAR); + *res = Platform_Chdir((void*)path, path__len); + __DEL(path); +} + +static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len) +{ + LONGINT i, j; + if (!Platform_LittleEndian) { + i = src__len; + j = 0; + while (i > 0) { + i -= 1; + dest[j] = src[i]; + j += 1; + } + } else { + __MOVE((LONGINT)(uintptr_t)src, (LONGINT)(uintptr_t)dest, src__len); + } +} + +void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x) +{ + Files_Read(&*R, R__typ, (CHAR*)(void*)&*x); +} + +void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x) +{ + CHAR b[2]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(2)), ((LONGINT)(2))); + *x = (int)b[0] + __ASHL((int)b[1], 8); +} + +void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x) +{ + CHAR b[4]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); + *x = (((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((int)b[2], 16)) + __ASHL((int)b[3], 24); +} + +void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x) +{ + CHAR b[4]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); + *x = (SET)((((int)b[0] + __ASHL((int)b[1], 8)) + __ASHL((int)b[2], 16)) + __ASHL((int)b[3], 24)); +} + +void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x) +{ + CHAR b[4]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); + Files_FlipBytes((void*)b, ((LONGINT)(4)), (void*)&*x, ((LONGINT)(4))); +} + +void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x) +{ + CHAR b[8]; + Files_ReadBytes(&*R, R__typ, (void*)b, ((LONGINT)(8)), ((LONGINT)(8))); + Files_FlipBytes((void*)b, ((LONGINT)(8)), (void*)&*x, ((LONGINT)(8))); +} + +void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len) +{ + INTEGER i; + CHAR ch; + i = 0; + do { + Files_Read(&*R, R__typ, (void*)&ch); + x[i] = ch; + i += 1; + } while (!(ch == 0x00)); +} + +void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len) +{ + INTEGER i; + CHAR ch; + BOOLEAN b; + i = 0; + b = 0; + do { + Files_Read(&*R, R__typ, (void*)&ch); + if ((ch == 0x00 || ch == 0x0a) || ch == 0x0d) { + b = 1; + } else { + x[i] = ch; + i += 1; + } + } while (!b); +} + +void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x) +{ + SHORTINT s; + CHAR ch; + LONGINT n; + s = 0; + n = 0; + Files_Read(&*R, R__typ, (void*)&ch); + while ((int)ch >= 128) { + n += __ASH((LONGINT)((int)ch - 128), s); + s += 7; + Files_Read(&*R, R__typ, (void*)&ch); + } + n += __ASH((LONGINT)(__MASK((int)ch, -64) - __ASHL(__ASHR((int)ch, 6), 6)), s); + *x = n; +} + +void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x) +{ + Files_Write(&*R, R__typ, __VAL(CHAR, x)); +} + +void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x) +{ + CHAR b[2]; + b[0] = (CHAR)x; + b[1] = (CHAR)__ASHR(x, 8); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(2)), ((LONGINT)(2))); +} + +void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x) +{ + CHAR b[4]; + b[0] = (CHAR)x; + b[1] = (CHAR)__ASHR(x, 8); + b[2] = (CHAR)__ASHR(x, 16); + b[3] = (CHAR)__ASHR(x, 24); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); +} + +void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x) +{ + CHAR b[4]; + LONGINT i; + i = (LONGINT)x; + b[0] = (CHAR)i; + b[1] = (CHAR)__ASHR(i, 8); + b[2] = (CHAR)__ASHR(i, 16); + b[3] = (CHAR)__ASHR(i, 24); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); +} + +void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x) +{ + CHAR b[4]; + Files_FlipBytes((void*)&x, ((LONGINT)(4)), (void*)b, ((LONGINT)(4))); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(4)), ((LONGINT)(4))); +} + +void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x) +{ + CHAR b[8]; + Files_FlipBytes((void*)&x, ((LONGINT)(8)), (void*)b, ((LONGINT)(8))); + Files_WriteBytes(&*R, R__typ, (void*)b, ((LONGINT)(8)), ((LONGINT)(8))); +} + +void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len) +{ + INTEGER i; + i = 0; + while (x[i] != 0x00) { + i += 1; + } + Files_WriteBytes(&*R, R__typ, (void*)x, x__len * ((LONGINT)(1)), i + 1); +} + +void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x) +{ + while (x < -64 || x > 63) { + Files_Write(&*R, R__typ, (CHAR)(__MASK(x, -128) + 128)); + x = __ASHR(x, 7); + } + Files_Write(&*R, R__typ, (CHAR)__MASK(x, -128)); +} + +void Files_GetName (Files_File f, CHAR *name, LONGINT name__len) +{ + __COPY(f->workName, name, name__len); +} + +static void Files_Finalize (SYSTEM_PTR o) +{ + Files_File f = NIL; + LONGINT res; + f = (Files_File)(uintptr_t)o; + if (f->fd >= 0) { + Files_fileTab[f->fd] = 0; + res = Platform_Close(f->fd); + f->fd = -1; + Heap_FileCount -= 1; + if (f->tempFile) { + res = Platform_Unlink((void*)f->workName, ((LONGINT)(101))); + } + } +} + +void Files_SetSearchPath (CHAR *path, LONGINT path__len) +{ + __DUP(path, path__len, CHAR); + if (Strings_Length(path, path__len) != 0) { + Files_SearchPath = __NEWARR(NIL, ((LONGINT)(1)), 1, 1, 1, (LONGINT)(Strings_Length(path, path__len) + 1)); + __COPY(path, Files_SearchPath->data, Files_SearchPath->len[0]); + } else { + Files_SearchPath = NIL; + } + __DEL(path); +} + +static void Files_Init (void) +{ + LONGINT i; + i = 0; + while (i < 256) { + Files_fileTab[i] = 0; + i += 1; + } + Files_tempno = -1; + Heap_FileCount = 0; + Files_SearchPath = NIL; + Files_HOME[0] = 0x00; + Platform_GetEnv((CHAR*)"HOME", (LONGINT)5, (void*)Files_HOME, ((LONGINT)(1024))); +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(Files_SearchPath); +} + +__TDESC(Files_Handle, 1, 4) = {__TDFLDS("Handle", 312), {272, 280, 288, 296, -40}}; +__TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4128), {0, -16}}; +__TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 40), {16, -16}}; + +export void *Files__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Console); + __MODULE_IMPORT(Heap); + __MODULE_IMPORT(Platform); + __MODULE_IMPORT(Strings); + __REGMOD("Files", EnumPtrs); + __INITYP(Files_Handle, Files_Handle, 0); + __INITYP(Files_BufDesc, Files_BufDesc, 0); + __INITYP(Files_Rider, Files_Rider, 0); +/* BEGIN */ + Files_Init(); + __ENDMOD; +} diff --git a/bootstrap/windows-88/Files.h b/bootstrap/windows-88/Files.h new file mode 100644 index 00000000..565ac5ff --- /dev/null +++ b/bootstrap/windows-88/Files.h @@ -0,0 +1,71 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tspkaSfF */ + +#ifndef Files__h +#define Files__h + +#define LARGE +#include "SYSTEM.h" + +typedef + struct Files_Handle *Files_File; + +typedef + struct Files_Handle { + char _prvt0[248]; + LONGINT fd; + char _prvt1[56]; + } Files_Handle; + +typedef + struct Files_Rider { + LONGINT res; + BOOLEAN eof; + char _prvt0[31]; + } Files_Rider; + + + +import LONGINT *Files_Handle__typ; +import LONGINT *Files_Rider__typ; + +import Files_File Files_Base (Files_Rider *r, LONGINT *r__typ); +import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INTEGER *res); +import void Files_Close (Files_File f); +import void Files_Delete (CHAR *name, LONGINT name__len, INTEGER *res); +import void Files_GetDate (Files_File f, LONGINT *t, LONGINT *d); +import void Files_GetName (Files_File f, CHAR *name, LONGINT name__len); +import LONGINT Files_Length (Files_File f); +import Files_File Files_New (CHAR *name, LONGINT name__len); +import Files_File Files_Old (CHAR *name, LONGINT name__len); +import LONGINT Files_Pos (Files_Rider *r, LONGINT *r__typ); +import void Files_Purge (Files_File f); +import void Files_Read (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x); +import void Files_ReadBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN *x); +import void Files_ReadByte (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len); +import void Files_ReadBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n); +import void Files_ReadInt (Files_Rider *R, LONGINT *R__typ, INTEGER *x); +import void Files_ReadLInt (Files_Rider *R, LONGINT *R__typ, LONGINT *x); +import void Files_ReadLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL *x); +import void Files_ReadLine (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +import void Files_ReadNum (Files_Rider *R, LONGINT *R__typ, LONGINT *x); +import void Files_ReadReal (Files_Rider *R, LONGINT *R__typ, REAL *x); +import void Files_ReadSet (Files_Rider *R, LONGINT *R__typ, SET *x); +import void Files_ReadString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +import void Files_Register (Files_File f); +import void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INTEGER *res); +import void Files_Set (Files_Rider *r, LONGINT *r__typ, Files_File f, LONGINT pos); +import void Files_SetSearchPath (CHAR *path, LONGINT path__len); +import void Files_Write (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE x); +import void Files_WriteBool (Files_Rider *R, LONGINT *R__typ, BOOLEAN x); +import void Files_WriteBytes (Files_Rider *r, LONGINT *r__typ, SYSTEM_BYTE *x, LONGINT x__len, LONGINT n); +import void Files_WriteInt (Files_Rider *R, LONGINT *R__typ, INTEGER x); +import void Files_WriteLInt (Files_Rider *R, LONGINT *R__typ, LONGINT x); +import void Files_WriteLReal (Files_Rider *R, LONGINT *R__typ, LONGREAL x); +import void Files_WriteNum (Files_Rider *R, LONGINT *R__typ, LONGINT x); +import void Files_WriteReal (Files_Rider *R, LONGINT *R__typ, REAL x); +import void Files_WriteSet (Files_Rider *R, LONGINT *R__typ, SET x); +import void Files_WriteString (Files_Rider *R, LONGINT *R__typ, CHAR *x, LONGINT x__len); +import void *Files__init(void); + + +#endif diff --git a/bootstrap/windows-88/Heap.c b/bootstrap/windows-88/Heap.c new file mode 100644 index 00000000..929a8283 --- /dev/null +++ b/bootstrap/windows-88/Heap.c @@ -0,0 +1,753 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tskSfF */ +#define LARGE +#include "SYSTEM.h" + +struct Heap__1 { + CHAR ch; + SYSTEM_PTR p; +}; + +typedef + struct Heap_CmdDesc *Heap_Cmd; + +typedef + CHAR Heap_CmdName[24]; + +typedef + void (*Heap_Command)(void); + +typedef + struct Heap_CmdDesc { + Heap_Cmd next; + Heap_CmdName name; + Heap_Command cmd; + } Heap_CmdDesc; + +typedef + void (*Heap_EnumProc)(void(*)(SYSTEM_PTR)); + +typedef + struct Heap_FinDesc *Heap_FinNode; + +typedef + void (*Heap_Finalizer)(SYSTEM_PTR); + +typedef + struct Heap_FinDesc { + Heap_FinNode next; + LONGINT obj; + BOOLEAN marked; + Heap_Finalizer finalize; + } Heap_FinDesc; + +typedef + struct Heap_ModuleDesc *Heap_Module; + +typedef + CHAR Heap_ModuleName[20]; + +typedef + struct Heap_ModuleDesc { + Heap_Module next; + Heap_ModuleName name; + LONGINT refcnt; + Heap_Cmd cmds; + LONGINT types; + Heap_EnumProc enumPtrs; + LONGINT reserved1, reserved2; + } Heap_ModuleDesc; + + +export SYSTEM_PTR Heap_modules; +static LONGINT Heap_freeList[10]; +static LONGINT Heap_bigBlocks; +export LONGINT Heap_allocated; +static BOOLEAN Heap_firstTry; +static LONGINT Heap_heap, Heap_heapend; +export LONGINT Heap_heapsize; +static Heap_FinNode Heap_fin; +static INTEGER Heap_lockdepth; +static BOOLEAN Heap_interrupted; +export INTEGER Heap_FileCount; + +export LONGINT *Heap_ModuleDesc__typ; +export LONGINT *Heap_CmdDesc__typ; +export LONGINT *Heap_FinDesc__typ; +export LONGINT *Heap__1__typ; + +static void Heap_CheckFin (void); +static void Heap_ExtendHeap (LONGINT blksz); +export void Heap_FINALL (void); +static void Heap_Finalize (void); +export void Heap_GC (BOOLEAN markStack); +static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len); +export void Heap_INCREF (Heap_Module m); +export void Heap_InitHeap (void); +export void Heap_Lock (void); +static void Heap_Mark (LONGINT q); +static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len); +static void Heap_MarkP (SYSTEM_PTR p); +static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len); +export SYSTEM_PTR Heap_NEWBLK (LONGINT size); +export SYSTEM_PTR Heap_NEWREC (LONGINT tag); +static LONGINT Heap_NewChunk (LONGINT blksz); +export void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd); +export SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs); +export void Heap_REGTYP (Heap_Module m, LONGINT typ); +export void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize); +static void Heap_Scan (void); +static void Heap_Sift (LONGINT l, LONGINT r, LONGINT *a, LONGINT a__len); +export void Heap_Unlock (void); + +extern void *Heap__init(); +extern LONGINT Platform_MainStackFrame; +extern LONGINT Platform_OSAllocate(LONGINT size); +#define Heap_FetchAddress(pointer) (LONGINT)(uintptr_t)(*((void**)((uintptr_t)pointer))) +#define Heap_HeapModuleInit() Heap__init() +#define Heap_OSAllocate(size) Platform_OSAllocate(size) +#define Heap_PlatformHalt(code) Platform_Halt(code) +#define Heap_PlatformMainStackFrame() Platform_MainStackFrame + +void Heap_Lock (void) +{ + Heap_lockdepth += 1; +} + +void Heap_Unlock (void) +{ + Heap_lockdepth -= 1; + if ((Heap_interrupted && Heap_lockdepth == 0)) { + Heap_PlatformHalt(((LONGINT)(-9))); + } +} + +SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs) +{ + SYSTEM_PTR _o_result; + Heap_Module m; + if (__STRCMP(name, "Heap") == 0) { + __SYSNEW(m, 80); + } else { + __NEW(m, Heap_ModuleDesc); + } + m->types = 0; + m->cmds = NIL; + __COPY(name, m->name, ((LONGINT)(20))); + m->refcnt = 0; + m->enumPtrs = enumPtrs; + m->next = (Heap_Module)(uintptr_t)Heap_modules; + Heap_modules = (SYSTEM_PTR)m; + _o_result = (void*)m; + return _o_result; +} + +void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd) +{ + Heap_Cmd c; + if (__STRCMP(m->name, "Heap") == 0) { + __SYSNEW(c, 40); + } else { + __NEW(c, Heap_CmdDesc); + } + __COPY(name, c->name, ((LONGINT)(24))); + c->cmd = cmd; + c->next = m->cmds; + m->cmds = c; +} + +void Heap_REGTYP (Heap_Module m, LONGINT typ) +{ + __PUT(typ, m->types, LONGINT); + m->types = typ; +} + +void Heap_INCREF (Heap_Module m) +{ + m->refcnt += 1; +} + +static LONGINT Heap_NewChunk (LONGINT blksz) +{ + LONGINT _o_result; + LONGINT chnk; + chnk = Heap_OSAllocate(blksz + 24); + if (chnk != 0) { + __PUT(chnk + 8, chnk + (24 + blksz), LONGINT); + __PUT(chnk + 24, chnk + 32, LONGINT); + __PUT(chnk + 32, blksz, LONGINT); + __PUT(chnk + 40, -8, LONGINT); + __PUT(chnk + 48, Heap_bigBlocks, LONGINT); + Heap_bigBlocks = chnk + 24; + Heap_heapsize += blksz; + } + _o_result = chnk; + return _o_result; +} + +static void Heap_ExtendHeap (LONGINT blksz) +{ + LONGINT size, chnk, j, next; + if (blksz > 320000) { + size = blksz; + } else { + size = 320000; + } + chnk = Heap_NewChunk(size); + if (chnk != 0) { + if (chnk < Heap_heap) { + __PUT(chnk, Heap_heap, LONGINT); + Heap_heap = chnk; + } else { + j = Heap_heap; + next = Heap_FetchAddress(j); + while ((next != 0 && chnk > next)) { + j = next; + next = Heap_FetchAddress(j); + } + __PUT(chnk, next, LONGINT); + __PUT(j, chnk, LONGINT); + } + if (next == 0) { + Heap_heapend = Heap_FetchAddress(chnk + 8); + } + } +} + +SYSTEM_PTR Heap_NEWREC (LONGINT tag) +{ + SYSTEM_PTR _o_result; + LONGINT i, i0, di, blksz, restsize, t, adr, end, next, prev; + SYSTEM_PTR new; + Heap_Lock(); + blksz = Heap_FetchAddress(tag); + i0 = __ASHR(blksz, 5); + i = i0; + if (i < 9) { + adr = Heap_freeList[i]; + while (adr == 0) { + i += 1; + adr = Heap_freeList[i]; + } + } + if (i < 9) { + next = Heap_FetchAddress(adr + 24); + Heap_freeList[i] = next; + if (i != i0) { + di = i - i0; + restsize = __ASHL(di, 5); + end = adr + restsize; + __PUT(end + 8, blksz, LONGINT); + __PUT(end + 16, -8, LONGINT); + __PUT(end, end + 8, LONGINT); + __PUT(adr + 8, restsize, LONGINT); + __PUT(adr + 24, Heap_freeList[di], LONGINT); + Heap_freeList[di] = adr; + adr += restsize; + } + } else { + adr = Heap_bigBlocks; + prev = 0; + for (;;) { + if (adr == 0) { + if (Heap_firstTry) { + Heap_GC(1); + blksz += 32; + if (__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2) < Heap_heapsize) { + Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 96), 7) - Heap_heapsize); + } + Heap_firstTry = 0; + new = Heap_NEWREC(tag); + Heap_firstTry = 1; + if (new == NIL) { + Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 96), 7) - Heap_heapsize); + new = Heap_NEWREC(tag); + } + Heap_Unlock(); + _o_result = new; + return _o_result; + } else { + Heap_Unlock(); + _o_result = NIL; + return _o_result; + } + } + t = Heap_FetchAddress(adr + 8); + if (t >= blksz) { + break; + } + prev = adr; + adr = Heap_FetchAddress(adr + 24); + } + restsize = t - blksz; + end = adr + restsize; + __PUT(end + 8, blksz, LONGINT); + __PUT(end + 16, -8, LONGINT); + __PUT(end, end + 8, LONGINT); + if (restsize > 288) { + __PUT(adr + 8, restsize, LONGINT); + } else { + next = Heap_FetchAddress(adr + 24); + if (prev == 0) { + Heap_bigBlocks = next; + } else { + __PUT(prev + 24, next, LONGINT); + } + if (restsize > 0) { + di = __ASHR(restsize, 5); + __PUT(adr + 8, restsize, LONGINT); + __PUT(adr + 24, Heap_freeList[di], LONGINT); + Heap_freeList[di] = adr; + } + } + adr += restsize; + } + i = adr + 32; + end = adr + blksz; + while (i < end) { + __PUT(i, 0, LONGINT); + __PUT(i + 8, 0, LONGINT); + __PUT(i + 16, 0, LONGINT); + __PUT(i + 24, 0, LONGINT); + i += 32; + } + __PUT(adr + 24, 0, LONGINT); + __PUT(adr, tag, LONGINT); + __PUT(adr + 8, 0, LONGINT); + __PUT(adr + 16, 0, LONGINT); + Heap_allocated += blksz; + Heap_Unlock(); + _o_result = (SYSTEM_PTR)(uintptr_t)(adr + 8); + return _o_result; +} + +SYSTEM_PTR Heap_NEWBLK (LONGINT size) +{ + SYSTEM_PTR _o_result; + LONGINT blksz, tag; + SYSTEM_PTR new; + Heap_Lock(); + blksz = __ASHL(__ASHR(size + 63, 5), 5); + new = Heap_NEWREC((LONGINT)(uintptr_t)&blksz); + tag = ((LONGINT)(uintptr_t)new + blksz) - 24; + __PUT(tag - 8, 0, LONGINT); + __PUT(tag, blksz, LONGINT); + __PUT(tag + 8, -8, LONGINT); + __PUT((LONGINT)(uintptr_t)new - 8, tag, LONGINT); + Heap_Unlock(); + _o_result = new; + return _o_result; +} + +static void Heap_Mark (LONGINT q) +{ + LONGINT p, tag, fld, n, offset, tagbits; + if (q != 0) { + tagbits = Heap_FetchAddress(q - 8); + if (!__ODD(tagbits)) { + __PUT(q - 8, tagbits + 1, LONGINT); + p = 0; + tag = tagbits + 8; + for (;;) { + __GET(tag, offset, LONGINT); + if (offset < 0) { + __PUT(q - 8, (tag + offset) + 1, LONGINT); + if (p == 0) { + break; + } + n = q; + q = p; + tag = Heap_FetchAddress(q - 8); + tag -= 1; + __GET(tag, offset, LONGINT); + fld = q + offset; + p = Heap_FetchAddress(fld); + __PUT(fld, (SYSTEM_PTR)(uintptr_t)n, SYSTEM_PTR); + } else { + fld = q + offset; + n = Heap_FetchAddress(fld); + if (n != 0) { + tagbits = Heap_FetchAddress(n - 8); + if (!__ODD(tagbits)) { + __PUT(n - 8, tagbits + 1, LONGINT); + __PUT(q - 8, tag + 1, LONGINT); + __PUT(fld, (SYSTEM_PTR)(uintptr_t)p, SYSTEM_PTR); + p = q; + q = n; + tag = tagbits; + } + } + } + tag += 8; + } + } + } +} + +static void Heap_MarkP (SYSTEM_PTR p) +{ + Heap_Mark((LONGINT)(uintptr_t)p); +} + +static void Heap_Scan (void) +{ + LONGINT chnk, adr, end, start, tag, i, size, freesize; + Heap_bigBlocks = 0; + i = 1; + while (i < 9) { + Heap_freeList[i] = 0; + i += 1; + } + freesize = 0; + Heap_allocated = 0; + chnk = Heap_heap; + while (chnk != 0) { + adr = chnk + 24; + end = Heap_FetchAddress(chnk + 8); + while (adr < end) { + tag = Heap_FetchAddress(adr); + if (__ODD(tag)) { + if (freesize > 0) { + start = adr - freesize; + __PUT(start, start + 8, LONGINT); + __PUT(start + 8, freesize, LONGINT); + __PUT(start + 16, -8, LONGINT); + i = __ASHR(freesize, 5); + freesize = 0; + if (i < 9) { + __PUT(start + 24, Heap_freeList[i], LONGINT); + Heap_freeList[i] = start; + } else { + __PUT(start + 24, Heap_bigBlocks, LONGINT); + Heap_bigBlocks = start; + } + } + tag -= 1; + __PUT(adr, tag, LONGINT); + size = Heap_FetchAddress(tag); + Heap_allocated += size; + adr += size; + } else { + size = Heap_FetchAddress(tag); + freesize += size; + adr += size; + } + } + if (freesize > 0) { + start = adr - freesize; + __PUT(start, start + 8, LONGINT); + __PUT(start + 8, freesize, LONGINT); + __PUT(start + 16, -8, LONGINT); + i = __ASHR(freesize, 5); + freesize = 0; + if (i < 9) { + __PUT(start + 24, Heap_freeList[i], LONGINT); + Heap_freeList[i] = start; + } else { + __PUT(start + 24, Heap_bigBlocks, LONGINT); + Heap_bigBlocks = start; + } + } + chnk = Heap_FetchAddress(chnk); + } +} + +static void Heap_Sift (LONGINT l, LONGINT r, LONGINT *a, LONGINT a__len) +{ + LONGINT i, j, x; + j = l; + x = a[j]; + for (;;) { + i = j; + j = __ASHL(j, 1) + 1; + if ((j < r && a[j] < a[j + 1])) { + j += 1; + } + if (j > r || a[j] <= x) { + break; + } + a[i] = a[j]; + } + a[i] = x; +} + +static void Heap_HeapSort (LONGINT n, LONGINT *a, LONGINT a__len) +{ + LONGINT l, r, x; + l = __ASHR(n, 1); + r = n - 1; + while (l > 0) { + l -= 1; + Heap_Sift(l, r, (void*)a, a__len); + } + while (r > 0) { + x = a[0]; + a[0] = a[r]; + a[r] = x; + r -= 1; + Heap_Sift(l, r, (void*)a, a__len); + } +} + +static void Heap_MarkCandidates (LONGINT n, LONGINT *cand, LONGINT cand__len) +{ + LONGINT chnk, adr, tag, next, lim, lim1, i, ptr, size; + chnk = Heap_heap; + i = 0; + lim = cand[n - 1]; + while ((chnk != 0 && chnk < lim)) { + adr = chnk + 24; + lim1 = Heap_FetchAddress(chnk + 8); + if (lim < lim1) { + lim1 = lim; + } + while (adr < lim1) { + tag = Heap_FetchAddress(adr); + if (__ODD(tag)) { + size = Heap_FetchAddress(tag - 1); + adr += size; + } else { + size = Heap_FetchAddress(tag); + ptr = adr + 8; + while (cand[i] < ptr) { + i += 1; + } + if (i == n) { + return; + } + next = adr + size; + if (cand[i] < next) { + Heap_Mark(ptr); + } + adr = next; + } + } + chnk = Heap_FetchAddress(chnk); + } +} + +static void Heap_CheckFin (void) +{ + Heap_FinNode n; + LONGINT tag; + n = Heap_fin; + while (n != NIL) { + tag = Heap_FetchAddress(n->obj - 8); + if (!__ODD(tag)) { + n->marked = 0; + Heap_Mark(n->obj); + } else { + n->marked = 1; + } + n = n->next; + } +} + +static void Heap_Finalize (void) +{ + Heap_FinNode n, prev; + n = Heap_fin; + prev = NIL; + while (n != NIL) { + if (!n->marked) { + if (n == Heap_fin) { + Heap_fin = Heap_fin->next; + } else { + prev->next = n->next; + } + (*n->finalize)((SYSTEM_PTR)(uintptr_t)n->obj); + if (prev == NIL) { + n = Heap_fin; + } else { + n = n->next; + } + } else { + prev = n; + n = n->next; + } + } +} + +void Heap_FINALL (void) +{ + Heap_FinNode n; + while (Heap_fin != NIL) { + n = Heap_fin; + Heap_fin = Heap_fin->next; + (*n->finalize)((SYSTEM_PTR)(uintptr_t)n->obj); + } +} + +static void Heap_MarkStack (LONGINT n, LONGINT *cand, LONGINT cand__len) +{ + SYSTEM_PTR frame; + LONGINT inc, nofcand, sp, p, stack0, ptr; + struct Heap__1 align; + if (n > 0) { + Heap_MarkStack(n - 1, cand, cand__len); + if (n > 100) { + return; + } + } + if (n == 0) { + nofcand = 0; + sp = (LONGINT)(uintptr_t)&frame; + stack0 = Heap_PlatformMainStackFrame(); + inc = (LONGINT)(uintptr_t)&align.p - (LONGINT)(uintptr_t)&align; + if (sp > stack0) { + inc = -inc; + } + while (sp != stack0) { + __GET(sp, p, LONGINT); + if ((p > Heap_heap && p < Heap_heapend)) { + if (nofcand == cand__len) { + Heap_HeapSort(nofcand, (void*)cand, cand__len); + Heap_MarkCandidates(nofcand, (void*)cand, cand__len); + nofcand = 0; + } + cand[nofcand] = p; + nofcand += 1; + } + sp += inc; + } + if (nofcand > 0) { + Heap_HeapSort(nofcand, (void*)cand, cand__len); + Heap_MarkCandidates(nofcand, (void*)cand, cand__len); + } + } +} + +void Heap_GC (BOOLEAN markStack) +{ + Heap_Module m; + LONGINT i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23; + LONGINT cand[10000]; + if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) { + Heap_Lock(); + m = (Heap_Module)(uintptr_t)Heap_modules; + while (m != NIL) { + if (m->enumPtrs != NIL) { + (*m->enumPtrs)(Heap_MarkP); + } + m = m->next; + } + if (markStack) { + i0 = -100; + i1 = -101; + i2 = -102; + i3 = -103; + i4 = -104; + i5 = -105; + i6 = -106; + i7 = -107; + i8 = 1; + i9 = 2; + i10 = 3; + i11 = 4; + i12 = 5; + i13 = 6; + i14 = 7; + i15 = 8; + i16 = 9; + i17 = 10; + i18 = 11; + i19 = 12; + i20 = 13; + i21 = 14; + i22 = 15; + i23 = 16; + for (;;) { + i0 += 1; + i1 += 2; + i2 += 3; + i3 += 4; + i4 += 5; + i5 += 6; + i6 += 7; + i7 += 8; + i8 += 9; + i9 += 10; + i10 += 11; + i11 += 12; + i12 += 13; + i13 += 14; + i14 += 15; + i15 += 16; + i16 += 17; + i17 += 18; + i18 += 19; + i19 += 20; + i20 += 21; + i21 += 22; + i22 += 23; + i23 += 24; + if ((i0 == -99 && i15 == 24)) { + Heap_MarkStack(((LONGINT)(32)), (void*)cand, ((LONGINT)(10000))); + break; + } + } + if (((((((((((((((((((((((i0 + i1) + i2) + i3) + i4) + i5) + i6) + i7) + i8) + i9) + i10) + i11) + i12) + i13) + i14) + i15) + i16) + i17) + i18) + i19) + i20) + i21) + i22) + i23 > 10000) { + return; + } + } + Heap_CheckFin(); + Heap_Scan(); + Heap_Finalize(); + Heap_Unlock(); + } +} + +void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize) +{ + Heap_FinNode f; + __NEW(f, Heap_FinDesc); + f->obj = (LONGINT)(uintptr_t)obj; + f->finalize = finalize; + f->marked = 1; + f->next = Heap_fin; + Heap_fin = f; +} + +void Heap_InitHeap (void) +{ + Heap_heap = Heap_NewChunk(((LONGINT)(256000))); + Heap_heapend = Heap_FetchAddress(Heap_heap + 8); + __PUT(Heap_heap, 0, LONGINT); + Heap_allocated = 0; + Heap_firstTry = 1; + Heap_freeList[9] = 1; + Heap_lockdepth = 0; + Heap_FileCount = 0; + Heap_modules = NIL; + Heap_heapsize = 0; + Heap_bigBlocks = 0; + Heap_fin = NIL; + Heap_interrupted = 0; + Heap_HeapModuleInit(); +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(Heap_modules); + P(Heap_fin); +} + +__TDESC(Heap_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 80), {0, 40, -24}}; +__TDESC(Heap_CmdDesc, 1, 1) = {__TDFLDS("CmdDesc", 40), {0, -16}}; +__TDESC(Heap_FinDesc, 1, 1) = {__TDFLDS("FinDesc", 32), {0, -16}}; +__TDESC(Heap__1, 1, 1) = {__TDFLDS("", 16), {8, -16}}; + +export void *Heap__init(void) +{ + __DEFMOD; + __REGMOD("Heap", EnumPtrs); + __REGCMD("FINALL", Heap_FINALL); + __REGCMD("InitHeap", Heap_InitHeap); + __REGCMD("Lock", Heap_Lock); + __REGCMD("Unlock", Heap_Unlock); + __INITYP(Heap_ModuleDesc, Heap_ModuleDesc, 0); + __INITYP(Heap_CmdDesc, Heap_CmdDesc, 0); + __INITYP(Heap_FinDesc, Heap_FinDesc, 0); + __INITYP(Heap__1, Heap__1, 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/windows-88/Heap.h b/bootstrap/windows-88/Heap.h new file mode 100644 index 00000000..1b23ddb3 --- /dev/null +++ b/bootstrap/windows-88/Heap.h @@ -0,0 +1,55 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tskSfF */ + +#ifndef Heap__h +#define Heap__h + +#define LARGE +#include "SYSTEM.h" + +typedef + CHAR Heap_CmdName[24]; + +typedef + void (*Heap_Command)(void); + +typedef + void (*Heap_EnumProc)(void(*)(SYSTEM_PTR)); + +typedef + void (*Heap_Finalizer)(SYSTEM_PTR); + +typedef + struct Heap_ModuleDesc *Heap_Module; + +typedef + struct Heap_ModuleDesc { + LONGINT _prvt0; + char _prvt1[72]; + } Heap_ModuleDesc; + +typedef + CHAR Heap_ModuleName[20]; + + +import SYSTEM_PTR Heap_modules; +import LONGINT Heap_allocated, Heap_heapsize; +import INTEGER Heap_FileCount; + +import LONGINT *Heap_ModuleDesc__typ; + +import void Heap_FINALL (void); +import void Heap_GC (BOOLEAN markStack); +import void Heap_INCREF (Heap_Module m); +import void Heap_InitHeap (void); +import void Heap_Lock (void); +import SYSTEM_PTR Heap_NEWBLK (LONGINT size); +import SYSTEM_PTR Heap_NEWREC (LONGINT tag); +import void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd); +import SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs); +import void Heap_REGTYP (Heap_Module m, LONGINT typ); +import void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize); +import void Heap_Unlock (void); +import void *Heap__init(void); + + +#endif diff --git a/bootstrap/windows-88/Modules.c b/bootstrap/windows-88/Modules.c new file mode 100644 index 00000000..77278391 --- /dev/null +++ b/bootstrap/windows-88/Modules.c @@ -0,0 +1,172 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "Console.h" +#include "Heap.h" + +typedef + struct Modules_CmdDesc *Modules_Cmd; + +typedef + void (*Modules_Command)(void); + +typedef + struct Modules_CmdDesc { + Modules_Cmd next; + CHAR name[24]; + Modules_Command cmd; + } Modules_CmdDesc; + +typedef + struct Modules_ModuleDesc *Modules_Module; + +typedef + CHAR Modules_ModuleName[20]; + +typedef + struct Modules_ModuleDesc { + Modules_Module next; + Modules_ModuleName name; + LONGINT refcnt; + Modules_Cmd cmds; + LONGINT types; + void (*enumPtrs)(void(*)(LONGINT)); + LONGINT reserved1, reserved2; + } Modules_ModuleDesc; + + +export INTEGER Modules_res; +export CHAR Modules_resMsg[256]; +export Modules_ModuleName Modules_imported, Modules_importing; + +export LONGINT *Modules_ModuleDesc__typ; +export LONGINT *Modules_CmdDesc__typ; + +static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len); +export void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all); +export Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len); +export Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len); + +#define Modules_modules() (Modules_Module)Heap_modules +#define Modules_setmodules(m) Heap_modules = m + +static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len) +{ + INTEGER i, j; + __DUP(b, b__len, CHAR); + i = 0; + while (a[__X(i, a__len)] != 0x00) { + i += 1; + } + j = 0; + while (b[__X(j, b__len)] != 0x00) { + a[__X(i, a__len)] = b[__X(j, b__len)]; + i += 1; + j += 1; + } + a[__X(i, a__len)] = 0x00; + __DEL(b); +} + +Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len) +{ + Modules_Module _o_result; + Modules_Module m = NIL; + CHAR bodyname[64]; + Modules_Command body; + __DUP(name, name__len, CHAR); + m = Modules_modules(); + while ((m != NIL && __STRCMP(m->name, name) != 0)) { + m = m->next; + } + if (m != NIL) { + Modules_res = 0; + Modules_resMsg[0] = 0x00; + } else { + Modules_res = 1; + __COPY(name, Modules_importing, ((LONGINT)(20))); + __MOVE(" module \"", Modules_resMsg, 10); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), name, name__len); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)"\" not found", (LONGINT)12); + } + _o_result = m; + __DEL(name); + return _o_result; +} + +Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len) +{ + Modules_Command _o_result; + Modules_Cmd c = NIL; + __DUP(name, name__len, CHAR); + c = mod->cmds; + while ((c != NIL && __STRCMP(c->name, name) != 0)) { + c = c->next; + } + if (c != NIL) { + Modules_res = 0; + Modules_resMsg[0] = 0x00; + _o_result = c->cmd; + __DEL(name); + return _o_result; + } else { + Modules_res = 2; + __MOVE(" command \"", Modules_resMsg, 11); + __COPY(name, Modules_importing, ((LONGINT)(20))); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), mod->name, ((LONGINT)(20))); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)".", (LONGINT)2); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), name, name__len); + Modules_Append((void*)Modules_resMsg, ((LONGINT)(256)), (CHAR*)"\" not found", (LONGINT)12); + _o_result = NIL; + __DEL(name); + return _o_result; + } + __RETCHK; +} + +void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all) +{ + Modules_Module m = NIL, p = NIL; + __DUP(name, name__len, CHAR); + m = Modules_modules(); + if (all) { + Modules_res = 1; + __MOVE("unloading \"all\" not yet supported", Modules_resMsg, 34); + } else { + while ((m != NIL && __STRCMP(m->name, name) != 0)) { + p = m; + m = m->next; + } + if ((m != NIL && m->refcnt == 0)) { + if (m == Modules_modules()) { + Modules_setmodules(m->next); + } else { + p->next = m->next; + } + Modules_res = 0; + } else { + Modules_res = 1; + if (m == NIL) { + __MOVE("module not found", Modules_resMsg, 17); + } else { + __MOVE("clients of this module exist", Modules_resMsg, 29); + } + } + } + __DEL(name); +} + +__TDESC(Modules_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 80), {0, 40, -24}}; +__TDESC(Modules_CmdDesc, 1, 1) = {__TDFLDS("CmdDesc", 40), {0, -16}}; + +export void *Modules__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Console); + __MODULE_IMPORT(Heap); + __REGMOD("Modules", 0); + __INITYP(Modules_ModuleDesc, Modules_ModuleDesc, 0); + __INITYP(Modules_CmdDesc, Modules_CmdDesc, 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/windows-88/Modules.h b/bootstrap/windows-88/Modules.h new file mode 100644 index 00000000..88bb46e1 --- /dev/null +++ b/bootstrap/windows-88/Modules.h @@ -0,0 +1,55 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Modules__h +#define Modules__h + +#define LARGE +#include "SYSTEM.h" + +typedef + struct Modules_CmdDesc *Modules_Cmd; + +typedef + void (*Modules_Command)(void); + +typedef + struct Modules_CmdDesc { + Modules_Cmd next; + CHAR name[24]; + Modules_Command cmd; + } Modules_CmdDesc; + +typedef + struct Modules_ModuleDesc *Modules_Module; + +typedef + CHAR Modules_ModuleName[20]; + +typedef + struct Modules_ModuleDesc { + Modules_Module next; + Modules_ModuleName name; + LONGINT refcnt; + Modules_Cmd cmds; + LONGINT types; + void (*enumPtrs)(void(*)(LONGINT)); + char _prvt0[16]; + } Modules_ModuleDesc; + + +import INTEGER Modules_res; +import CHAR Modules_resMsg[256]; +import Modules_ModuleName Modules_imported, Modules_importing; + +import LONGINT *Modules_ModuleDesc__typ; +import LONGINT *Modules_CmdDesc__typ; + +import void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all); +import Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len); +import Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len); +import void *Modules__init(void); + +#define Modules_modules() (Modules_Module)Heap_modules +#define Modules_setmodules(m) Heap_modules = m + +#endif diff --git a/bootstrap/windows-88/OPB.c b/bootstrap/windows-88/OPB.c new file mode 100644 index 00000000..428d0881 --- /dev/null +++ b/bootstrap/windows-88/OPB.c @@ -0,0 +1,2678 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "OPM.h" +#include "OPS.h" +#include "OPT.h" + + +export void (*OPB_typSize)(OPT_Struct); +static INTEGER OPB_exp; +static LONGINT OPB_maxExp; + + +export void OPB_Assign (OPT_Node *x, OPT_Node y); +static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node y); +static LONGINT OPB_BoolToInt (BOOLEAN b); +export void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp); +static void OPB_CharToString (OPT_Node n); +static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode); +static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo); +export void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames); +static void OPB_CheckProc (OPT_Struct x, OPT_Object y); +static void OPB_CheckPtr (OPT_Node x, OPT_Node y); +static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x); +static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp); +static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y); +export void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y); +static void OPB_Convert (OPT_Node *x, OPT_Struct typ); +export void OPB_DeRef (OPT_Node *x); +static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar); +export OPT_Node OPB_EmptySet (void); +export void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc); +export void OPB_Field (OPT_Node *x, OPT_Object y); +export void OPB_In (OPT_Node *x, OPT_Node y); +export void OPB_Index (OPT_Node *x, OPT_Node y); +export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ); +static BOOLEAN OPB_IntToBool (LONGINT i); +export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y); +export void OPB_MOp (SHORTINT op, OPT_Node *x); +export OPT_Node OPB_NewBoolConst (BOOLEAN boolval); +export OPT_Node OPB_NewIntConst (LONGINT intval); +export OPT_Node OPB_NewLeaf (OPT_Object obj); +export OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ); +export OPT_Node OPB_NewString (OPS_String str, LONGINT len); +export OPT_Node OPB_Nil (void); +static BOOLEAN OPB_NotVar (OPT_Node x); +export void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y); +export void OPB_OptIf (OPT_Node *x); +export void OPB_Param (OPT_Node ap, OPT_Object fp); +export void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar); +export void OPB_Return (OPT_Node *x, OPT_Object proc); +export void OPB_SetElem (OPT_Node *x); +static void OPB_SetIntType (OPT_Node node); +export void OPB_SetRange (OPT_Node *x, OPT_Node y); +export void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno); +export void OPB_StPar0 (OPT_Node *par0, INTEGER fctno); +export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno); +export void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n); +export void OPB_StaticLink (SHORTINT dlev); +export void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard); +static void OPB_err (INTEGER n); +static LONGINT OPB_log (LONGINT x); + + +static void OPB_err (INTEGER n) +{ + OPM_err(n); +} + +OPT_Node OPB_NewLeaf (OPT_Object obj) +{ + OPT_Node _o_result; + OPT_Node node = NIL; + switch (obj->mode) { + case 1: + node = OPT_NewNode(0); + node->readonly = (obj->vis == 2 && obj->mnolev < 0); + break; + case 2: + node = OPT_NewNode(1); + break; + case 3: + node = OPT_NewNode(7); + node->conval = OPT_NewConst(); + __GUARDEQP(node->conval, OPT_ConstDesc) = *obj->conval; + break; + case 5: + node = OPT_NewNode(8); + break; + case 6: case 7: case 8: case 9: case 10: + node = OPT_NewNode(9); + break; + default: + OPB_err(127); + node = OPT_NewNode(0); + break; + } + node->obj = obj; + node->typ = obj->typ; + _o_result = node; + return _o_result; +} + +void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y) +{ + OPT_Node node = NIL; + node = OPT_NewNode(class); + node->typ = OPT_notyp; + node->left = *x; + node->right = y; + *x = node; +} + +void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y) +{ + if (*x == NIL) { + *x = y; + } else { + (*last)->link = y; + } + while (y->link != NIL) { + y = y->link; + } + *last = y; +} + +static LONGINT OPB_BoolToInt (BOOLEAN b) +{ + LONGINT _o_result; + if (b) { + _o_result = 1; + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +static BOOLEAN OPB_IntToBool (LONGINT i) +{ + BOOLEAN _o_result; + if (i == 0) { + _o_result = 0; + return _o_result; + } else { + _o_result = 1; + return _o_result; + } + __RETCHK; +} + +OPT_Node OPB_NewBoolConst (BOOLEAN boolval) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->typ = OPT_booltyp; + x->conval = OPT_NewConst(); + x->conval->intval = OPB_BoolToInt(boolval); + _o_result = x; + return _o_result; +} + +void OPB_OptIf (OPT_Node *x) +{ + OPT_Node if_ = NIL, pred = NIL; + if_ = (*x)->left; + while (if_->left->class == 7) { + if (OPB_IntToBool(if_->left->conval->intval)) { + *x = if_->right; + return; + } else if (if_->link == NIL) { + *x = (*x)->right; + return; + } else { + if_ = if_->link; + (*x)->left = if_; + } + } + pred = if_; + if_ = if_->link; + while (if_ != NIL) { + if (if_->left->class == 7) { + if (OPB_IntToBool(if_->left->conval->intval)) { + pred->link = NIL; + (*x)->right = if_->right; + return; + } else { + if_ = if_->link; + pred->link = if_; + } + } else { + pred = if_; + if_ = if_->link; + } + } +} + +OPT_Node OPB_Nil (void) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->typ = OPT_niltyp; + x->conval = OPT_NewConst(); + x->conval->intval = 0; + _o_result = x; + return _o_result; +} + +OPT_Node OPB_EmptySet (void) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->typ = OPT_settyp; + x->conval = OPT_NewConst(); + x->conval->setval = 0x0; + _o_result = x; + return _o_result; +} + +static void OPB_SetIntType (OPT_Node node) +{ + LONGINT v; + v = node->conval->intval; + if ((OPM_MinSInt <= (LONGINT)v && (LONGINT)v <= OPM_MaxSInt)) { + node->typ = OPT_sinttyp; + } else if ((OPM_MinInt <= (LONGINT)v && (LONGINT)v <= OPM_MaxInt)) { + node->typ = OPT_inttyp; + } else if ((OPM_MinLInt <= v && v <= OPM_MaxLInt)) { + node->typ = OPT_linttyp; + } else { + OPB_err(203); + node->typ = OPT_sinttyp; + node->conval->intval = 1; + } +} + +OPT_Node OPB_NewIntConst (LONGINT intval) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->conval = OPT_NewConst(); + x->conval->intval = intval; + OPB_SetIntType(x); + _o_result = x; + return _o_result; +} + +OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->conval = OPT_NewConst(); + x->conval->realval = realval; + x->typ = typ; + x->conval->intval = -1; + _o_result = x; + return _o_result; +} + +OPT_Node OPB_NewString (OPS_String str, LONGINT len) +{ + OPT_Node _o_result; + OPT_Node x = NIL; + x = OPT_NewNode(7); + x->conval = OPT_NewConst(); + x->typ = OPT_stringtyp; + x->conval->intval = -1; + x->conval->intval2 = len; + x->conval->ext = OPT_NewExt(); + __COPY(str, *x->conval->ext, ((LONGINT)(256))); + _o_result = x; + return _o_result; +} + +static void OPB_CharToString (OPT_Node n) +{ + CHAR ch; + n->typ = OPT_stringtyp; + ch = (CHAR)n->conval->intval; + n->conval->ext = OPT_NewExt(); + if (ch == 0x00) { + n->conval->intval2 = 1; + } else { + n->conval->intval2 = 2; + (*n->conval->ext)[1] = 0x00; + } + (*n->conval->ext)[0] = ch; + n->conval->intval = -1; + n->obj = NIL; +} + +static void OPB_BindNodes (SHORTINT class, OPT_Struct typ, OPT_Node *x, OPT_Node y) +{ + OPT_Node node = NIL; + node = OPT_NewNode(class); + node->typ = typ; + node->left = *x; + node->right = y; + *x = node; +} + +static BOOLEAN OPB_NotVar (OPT_Node x) +{ + BOOLEAN _o_result; + _o_result = (x->class >= 7 && ((x->class != 11 || x->subcl != 29) || x->left->class >= 7)); + return _o_result; +} + +void OPB_DeRef (OPT_Node *x) +{ + OPT_Object strobj = NIL, bstrobj = NIL; + OPT_Struct typ = NIL, btyp = NIL; + typ = (*x)->typ; + if ((*x)->class >= 7) { + OPB_err(78); + } else if (typ->form == 13) { + if (typ == OPT_sysptrtyp) { + OPB_err(57); + } + btyp = typ->BaseTyp; + strobj = typ->strobj; + bstrobj = btyp->strobj; + if ((((((strobj != NIL && strobj->name[0] != 0x00)) && bstrobj != NIL)) && bstrobj->name[0] != 0x00)) { + btyp->pbused = 1; + } + OPB_BindNodes(3, btyp, &*x, NIL); + } else { + OPB_err(84); + } +} + +void OPB_Index (OPT_Node *x, OPT_Node y) +{ + INTEGER f; + OPT_Struct typ = NIL; + f = y->typ->form; + if ((*x)->class >= 7) { + OPB_err(79); + } else if (!__IN(f, 0x70) || __IN(y->class, 0x0300)) { + OPB_err(80); + y->typ = OPT_inttyp; + } + if ((*x)->typ->comp == 2) { + typ = (*x)->typ->BaseTyp; + if ((y->class == 7 && (y->conval->intval < 0 || y->conval->intval >= (*x)->typ->n))) { + OPB_err(81); + } + } else if ((*x)->typ->comp == 3) { + typ = (*x)->typ->BaseTyp; + if ((y->class == 7 && y->conval->intval < 0)) { + OPB_err(81); + } + } else { + OPB_err(82); + typ = OPT_undftyp; + } + OPB_BindNodes(4, typ, &*x, y); + (*x)->readonly = (*x)->left->readonly; +} + +void OPB_Field (OPT_Node *x, OPT_Object y) +{ + if ((*x)->class >= 7) { + OPB_err(77); + } + if ((y != NIL && __IN(y->mode, 0x2010))) { + OPB_BindNodes(2, y->typ, &*x, NIL); + (*x)->obj = y; + (*x)->readonly = (*x)->left->readonly || (y->vis == 2 && y->mnolev < 0); + } else { + OPB_err(83); + (*x)->typ = OPT_undftyp; + } +} + +static struct TypTest__57 { + OPT_Node *x; + OPT_Object *obj; + BOOLEAN *guard; + struct TypTest__57 *lnk; +} *TypTest__57_s; + +static void GTT__58 (OPT_Struct t0, OPT_Struct t1); + +static void GTT__58 (OPT_Struct t0, OPT_Struct t1) +{ + OPT_Node node = NIL; + OPT_Struct t = NIL; + t = t0; + while ((((t != NIL && t != t1)) && t != OPT_undftyp)) { + t = t->BaseTyp; + } + if (t != t1) { + while ((((t1 != NIL && t1 != t0)) && t1 != OPT_undftyp)) { + t1 = t1->BaseTyp; + } + if (t1 == t0 || t0->form == 0) { + if (*TypTest__57_s->guard) { + OPB_BindNodes(5, NIL, &*TypTest__57_s->x, NIL); + (*TypTest__57_s->x)->readonly = (*TypTest__57_s->x)->left->readonly; + } else { + node = OPT_NewNode(11); + node->subcl = 16; + node->left = *TypTest__57_s->x; + node->obj = *TypTest__57_s->obj; + *TypTest__57_s->x = node; + } + } else { + OPB_err(85); + } + } else if (t0 != t1) { + OPB_err(85); + } else if (!*TypTest__57_s->guard) { + if ((*TypTest__57_s->x)->class == 5) { + node = OPT_NewNode(11); + node->subcl = 16; + node->left = *TypTest__57_s->x; + node->obj = *TypTest__57_s->obj; + *TypTest__57_s->x = node; + } else { + *TypTest__57_s->x = OPB_NewBoolConst(1); + } + } +} + +void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard) +{ + struct TypTest__57 _s; + _s.x = x; + _s.obj = &obj; + _s.guard = &guard; + _s.lnk = TypTest__57_s; + TypTest__57_s = &_s; + if (OPB_NotVar(*x)) { + OPB_err(112); + } else if ((*x)->typ->form == 13) { + if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) { + OPB_err(85); + } else if (obj->typ->form == 13) { + GTT__58((*x)->typ->BaseTyp, obj->typ->BaseTyp); + } else { + OPB_err(86); + } + } else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) { + GTT__58((*x)->typ, obj->typ); + } else { + OPB_err(87); + } + if (guard) { + (*x)->typ = obj->typ; + } else { + (*x)->typ = OPT_booltyp; + } + TypTest__57_s = _s.lnk; +} + +void OPB_In (OPT_Node *x, OPT_Node y) +{ + INTEGER f; + LONGINT k; + f = (*x)->typ->form; + if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) { + OPB_err(126); + } else if ((__IN(f, 0x70) && y->typ->form == 9)) { + if ((*x)->class == 7) { + k = (*x)->conval->intval; + if (k < 0 || k > (LONGINT)OPM_MaxSet) { + OPB_err(202); + } else if (y->class == 7) { + (*x)->conval->intval = OPB_BoolToInt(__IN(k, y->conval->setval)); + (*x)->obj = NIL; + } else { + OPB_BindNodes(12, OPT_booltyp, &*x, y); + (*x)->subcl = 15; + } + } else { + OPB_BindNodes(12, OPT_booltyp, &*x, y); + (*x)->subcl = 15; + } + } else { + OPB_err(92); + } + (*x)->typ = OPT_booltyp; +} + +static LONGINT OPB_log (LONGINT x) +{ + LONGINT _o_result; + OPB_exp = 0; + if (x > 0) { + while (!__ODD(x)) { + x = __ASHR(x, 1); + OPB_exp += 1; + } + } + _o_result = x; + return _o_result; +} + +static void OPB_CheckRealType (INTEGER f, INTEGER nr, OPT_Const x) +{ + LONGREAL min, max, r; + if (f == 7) { + min = OPM_MinReal; + max = OPM_MaxReal; + } else { + min = OPM_MinLReal; + max = OPM_MaxLReal; + } + r = __ABS(x->realval); + if (r > max || r < min) { + OPB_err(nr); + x->realval = (LONGREAL)1; + } else if (f == 7) { + x->realval = x->realval; + } + x->intval = -1; +} + +static struct MOp__28 { + struct MOp__28 *lnk; +} *MOp__28_s; + +static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z); + +static OPT_Node NewOp__29 (SHORTINT op, OPT_Struct typ, OPT_Node z) +{ + OPT_Node _o_result; + OPT_Node node = NIL; + node = OPT_NewNode(11); + node->subcl = op; + node->typ = typ; + node->left = z; + _o_result = node; + return _o_result; +} + +void OPB_MOp (SHORTINT op, OPT_Node *x) +{ + INTEGER f; + OPT_Struct typ = NIL; + OPT_Node z = NIL; + struct MOp__28 _s; + _s.lnk = MOp__28_s; + MOp__28_s = &_s; + z = *x; + if (z->class == 8 || z->class == 9) { + OPB_err(126); + } else { + typ = z->typ; + f = typ->form; + switch (op) { + case 33: + if (f == 2) { + if (z->class == 7) { + z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval)); + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(98); + } + break; + case 6: + if (!__IN(f, 0x01f0)) { + OPB_err(96); + } + break; + case 7: + if (__IN(f, 0x03f0)) { + if (z->class == 7) { + if (__IN(f, 0x70)) { + if (z->conval->intval == (-9223372036854775807-1)) { + OPB_err(203); + } else { + z->conval->intval = -z->conval->intval; + OPB_SetIntType(z); + } + } else if (__IN(f, 0x0180)) { + z->conval->realval = -z->conval->realval; + } else { + z->conval->setval = ~z->conval->setval; + } + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(97); + } + break; + case 21: + if (__IN(f, 0x01f0)) { + if (z->class == 7) { + if (__IN(f, 0x70)) { + if (z->conval->intval == (-9223372036854775807-1)) { + OPB_err(203); + } else { + z->conval->intval = __ABS(z->conval->intval); + OPB_SetIntType(z); + } + } else { + z->conval->realval = __ABS(z->conval->realval); + } + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(111); + } + break; + case 22: + if (f == 3) { + if (z->class == 7) { + z->conval->intval = (int)__CAP((CHAR)z->conval->intval); + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(111); + z->typ = OPT_chartyp; + } + break; + case 23: + if (__IN(f, 0x70)) { + if (z->class == 7) { + z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval)); + z->obj = NIL; + } else { + z = NewOp__29(op, typ, z); + } + } else { + OPB_err(111); + } + z->typ = OPT_booltyp; + break; + case 24: + if ((((z->class == 7 && f == 3)) && z->conval->intval >= 32)) { + OPB_CharToString(z); + f = 10; + } + if (z->class < 7 || f == 10) { + z = NewOp__29(op, typ, z); + } else { + OPB_err(127); + } + z->typ = OPT_linttyp; + break; + case 25: + if ((__IN(f, 0x70) && z->class == 7)) { + if ((0 <= z->conval->intval && z->conval->intval <= -1)) { + z = NewOp__29(op, typ, z); + } else { + OPB_err(219); + } + } else { + OPB_err(69); + } + z->typ = OPT_booltyp; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.MOp, op = ", (LONGINT)33); + OPM_LogWNum(op, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } + *x = z; + MOp__28_s = _s.lnk; +} + +static void OPB_CheckPtr (OPT_Node x, OPT_Node y) +{ + INTEGER g; + OPT_Struct p = NIL, q = NIL, t = NIL; + g = y->typ->form; + if (g == 13) { + p = x->typ->BaseTyp; + q = y->typ->BaseTyp; + if ((p->comp == 4 && q->comp == 4)) { + if (p->extlev < q->extlev) { + t = p; + p = q; + q = t; + } + while ((((p != q && p != NIL)) && p != OPT_undftyp)) { + p = p->BaseTyp; + } + if (p == NIL) { + OPB_err(100); + } + } else { + OPB_err(100); + } + } else if (g != 11) { + OPB_err(100); + } +} + +void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames) +{ + OPT_Struct ft = NIL, at = NIL; + while (fp != NIL) { + if (ap != NIL) { + ft = fp->typ; + at = ap->typ; + while ((ft->comp == 3 && at->comp == 3)) { + ft = ft->BaseTyp; + at = at->BaseTyp; + } + if (ft != at) { + if ((ft->form == 14 && at->form == 14)) { + if (ft->BaseTyp == at->BaseTyp) { + OPB_CheckParameters(ft->link, at->link, 0); + } else { + OPB_err(117); + } + } else { + OPB_err(115); + } + } + if (fp->mode != ap->mode || (checkNames && __STRCMP(fp->name, ap->name) != 0)) { + OPB_err(115); + } + ap = ap->link; + } else { + OPB_err(116); + } + fp = fp->link; + } + if (ap != NIL) { + OPB_err(116); + } +} + +static void OPB_CheckProc (OPT_Struct x, OPT_Object y) +{ + if (__IN(y->mode, 0x04c0)) { + if (y->mode == 6) { + if (y->mnolev == 0) { + y->mode = 7; + } else { + OPB_err(73); + } + } + if (x->BaseTyp == y->typ) { + OPB_CheckParameters(x->link, y->link, 0); + } else { + OPB_err(117); + } + } else { + OPB_err(113); + } +} + +static struct ConstOp__13 { + OPT_Node *x; + INTEGER *f; + OPT_Const *xval, *yval; + struct ConstOp__13 *lnk; +} *ConstOp__13_s; + +static INTEGER ConstCmp__14 (void); + +static INTEGER ConstCmp__14 (void) +{ + INTEGER _o_result; + INTEGER res; + switch (*ConstOp__13_s->f) { + case 0: + res = 9; + break; + case 1: case 3: case 4: case 5: case 6: + if ((*ConstOp__13_s->xval)->intval < (*ConstOp__13_s->yval)->intval) { + res = 11; + } else if ((*ConstOp__13_s->xval)->intval > (*ConstOp__13_s->yval)->intval) { + res = 13; + } else { + res = 9; + } + break; + case 7: case 8: + if ((*ConstOp__13_s->xval)->realval < (*ConstOp__13_s->yval)->realval) { + res = 11; + } else if ((*ConstOp__13_s->xval)->realval > (*ConstOp__13_s->yval)->realval) { + res = 13; + } else { + res = 9; + } + break; + case 2: + if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) { + res = 10; + } else { + res = 9; + } + break; + case 9: + if ((*ConstOp__13_s->xval)->setval != (*ConstOp__13_s->yval)->setval) { + res = 10; + } else { + res = 9; + } + break; + case 10: + if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) < 0) { + res = 11; + } else if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) > 0) { + res = 13; + } else { + res = 9; + } + break; + case 11: case 13: case 14: + if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) { + res = 10; + } else { + res = 9; + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", (LONGINT)37); + OPM_LogWNum(*ConstOp__13_s->f, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + (*ConstOp__13_s->x)->typ = OPT_booltyp; + _o_result = res; + return _o_result; +} + +static void OPB_ConstOp (INTEGER op, OPT_Node x, OPT_Node y) +{ + INTEGER f, g; + OPT_Const xval = NIL, yval = NIL; + LONGINT xv, yv; + BOOLEAN temp; + struct ConstOp__13 _s; + _s.x = &x; + _s.f = &f; + _s.xval = &xval; + _s.yval = &yval; + _s.lnk = ConstOp__13_s; + ConstOp__13_s = &_s; + f = x->typ->form; + g = y->typ->form; + xval = x->conval; + yval = y->conval; + if (f != g) { + switch (f) { + case 3: + if (g == 10) { + OPB_CharToString(x); + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 4: + if (__IN(g, 0x70)) { + x->typ = y->typ; + } else if (g == 7) { + x->typ = OPT_realtyp; + xval->realval = xval->intval; + } else if (g == 8) { + x->typ = OPT_lrltyp; + xval->realval = xval->intval; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 5: + if (g == 4) { + y->typ = OPT_inttyp; + } else if (__IN(g, 0x70)) { + x->typ = y->typ; + } else if (g == 7) { + x->typ = OPT_realtyp; + xval->realval = xval->intval; + } else if (g == 8) { + x->typ = OPT_lrltyp; + xval->realval = xval->intval; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 6: + if (__IN(g, 0x70)) { + y->typ = OPT_linttyp; + } else if (g == 7) { + x->typ = OPT_realtyp; + xval->realval = xval->intval; + } else if (g == 8) { + x->typ = OPT_lrltyp; + xval->realval = xval->intval; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 7: + if (__IN(g, 0x70)) { + y->typ = x->typ; + yval->realval = yval->intval; + } else if (g == 8) { + x->typ = OPT_lrltyp; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 8: + if (__IN(g, 0x70)) { + y->typ = x->typ; + yval->realval = yval->intval; + } else if (g == 7) { + y->typ = OPT_lrltyp; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 10: + if (g == 3) { + OPB_CharToString(y); + g = 10; + } else { + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + } + break; + case 11: + if (!__IN(g, 0x6000)) { + OPB_err(100); + } + break; + case 13: + OPB_CheckPtr(x, y); + break; + case 14: + if (g != 11) { + OPB_err(100); + } + break; + default: + OPB_err(100); + y->typ = x->typ; + __GUARDEQP(yval, OPT_ConstDesc) = *xval; + break; + } + f = x->typ->form; + } + switch (op) { + case 1: + if (__IN(f, 0x70)) { + xv = xval->intval; + yv = yval->intval; + if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807-1))) && yv != (-9223372036854775807-1))) && -xv <= __DIV(9223372036854775807, -yv))) { + xval->intval = xv * yv; + OPB_SetIntType(x); + } else { + OPB_err(204); + } + } else if (__IN(f, 0x0180)) { + temp = __ABS(yval->realval) <= (LONGREAL)1; + if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 / (LONGREAL)__ABS(yval->realval)) { + xval->realval = xval->realval * yval->realval; + OPB_CheckRealType(f, 204, xval); + } else { + OPB_err(204); + } + } else if (f == 9) { + xval->setval = (xval->setval & yval->setval); + } else if (f != 0) { + OPB_err(101); + } + break; + case 2: + if (__IN(f, 0x70)) { + if (yval->intval != 0) { + xval->realval = xval->intval / (REAL)yval->intval; + OPB_CheckRealType(7, 205, xval); + } else { + OPB_err(205); + xval->realval = (LONGREAL)1; + } + x->typ = OPT_realtyp; + } else if (__IN(f, 0x0180)) { + temp = __ABS(yval->realval) >= (LONGREAL)1; + if (temp || __ABS(xval->realval) <= 1.79769296342094e+308 * __ABS(yval->realval)) { + xval->realval = xval->realval / yval->realval; + OPB_CheckRealType(f, 205, xval); + } else { + OPB_err(205); + } + } else if (f == 9) { + xval->setval = xval->setval ^ yval->setval; + } else if (f != 0) { + OPB_err(102); + } + break; + case 3: + if (__IN(f, 0x70)) { + if (yval->intval != 0) { + xval->intval = __DIV(xval->intval, yval->intval); + OPB_SetIntType(x); + } else { + OPB_err(205); + } + } else if (f != 0) { + OPB_err(103); + } + break; + case 4: + if (__IN(f, 0x70)) { + if (yval->intval != 0) { + xval->intval = __MOD(xval->intval, yval->intval); + OPB_SetIntType(x); + } else { + OPB_err(205); + } + } else if (f != 0) { + OPB_err(104); + } + break; + case 5: + if (f == 2) { + xval->intval = OPB_BoolToInt((OPB_IntToBool(xval->intval) && OPB_IntToBool(yval->intval))); + } else { + OPB_err(94); + } + break; + case 6: + if (__IN(f, 0x70)) { + temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807 - yval->intval); + if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807-1) - yval->intval)) { + xval->intval += yval->intval; + OPB_SetIntType(x); + } else { + OPB_err(206); + } + } else if (__IN(f, 0x0180)) { + temp = (yval->realval >= (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 - yval->realval); + if (temp || (yval->realval < (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 - yval->realval)) { + xval->realval = xval->realval + yval->realval; + OPB_CheckRealType(f, 206, xval); + } else { + OPB_err(206); + } + } else if (f == 9) { + xval->setval = xval->setval | yval->setval; + } else if (f != 0) { + OPB_err(105); + } + break; + case 7: + if (__IN(f, 0x70)) { + if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807 + yval->intval)) { + xval->intval -= yval->intval; + OPB_SetIntType(x); + } else { + OPB_err(207); + } + } else if (__IN(f, 0x0180)) { + temp = (yval->realval >= (LONGREAL)0 && xval->realval >= -1.79769296342094e+308 + yval->realval); + if (temp || (yval->realval < (LONGREAL)0 && xval->realval <= 1.79769296342094e+308 + yval->realval)) { + xval->realval = xval->realval - yval->realval; + OPB_CheckRealType(f, 207, xval); + } else { + OPB_err(207); + } + } else if (f == 9) { + xval->setval = (xval->setval & ~yval->setval); + } else if (f != 0) { + OPB_err(106); + } + break; + case 8: + if (f == 2) { + xval->intval = OPB_BoolToInt(OPB_IntToBool(xval->intval) || OPB_IntToBool(yval->intval)); + } else { + OPB_err(95); + } + break; + case 9: + xval->intval = OPB_BoolToInt(ConstCmp__14() == 9); + break; + case 10: + xval->intval = OPB_BoolToInt(ConstCmp__14() != 9); + break; + case 11: + if (__IN(f, 0x2a04)) { + OPB_err(108); + } else { + xval->intval = OPB_BoolToInt(ConstCmp__14() == 11); + } + break; + case 12: + if (__IN(f, 0x2a04)) { + OPB_err(108); + } else { + xval->intval = OPB_BoolToInt(ConstCmp__14() != 13); + } + break; + case 13: + if (__IN(f, 0x2a04)) { + OPB_err(108); + } else { + xval->intval = OPB_BoolToInt(ConstCmp__14() == 13); + } + break; + case 14: + if (__IN(f, 0x2a04)) { + OPB_err(108); + } else { + xval->intval = OPB_BoolToInt(ConstCmp__14() != 11); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstOp, op = ", (LONGINT)37); + OPM_LogWNum(op, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + ConstOp__13_s = _s.lnk; +} + +static void OPB_Convert (OPT_Node *x, OPT_Struct typ) +{ + OPT_Node node = NIL; + INTEGER f, g; + LONGINT k; + LONGREAL r; + f = (*x)->typ->form; + g = typ->form; + if ((*x)->class == 7) { + if (__IN(f, 0x70)) { + if (__IN(g, 0x70)) { + if (f > g) { + OPB_SetIntType(*x); + if ((int)(*x)->typ->form > g) { + OPB_err(203); + (*x)->conval->intval = 1; + } + } + } else if (__IN(g, 0x0180)) { + (*x)->conval->realval = (*x)->conval->intval; + (*x)->conval->intval = -1; + } else { + k = (*x)->conval->intval; + if (0 > k || k > 255) { + OPB_err(220); + } + } + } else if (__IN(f, 0x0180)) { + if (__IN(g, 0x0180)) { + OPB_CheckRealType(g, 203, (*x)->conval); + } else { + r = (*x)->conval->realval; + if (r < -9.22337203685478e+018 || r > 9.22337203685478e+018) { + OPB_err(203); + r = (LONGREAL)1; + } + (*x)->conval->intval = __ENTIER(r); + OPB_SetIntType(*x); + } + } + (*x)->obj = NIL; + } else if (((((*x)->class == 11 && (*x)->subcl == 20)) && ((int)(*x)->left->typ->form < f || f > g))) { + if ((*x)->left->typ == typ) { + *x = (*x)->left; + } + } else { + node = OPT_NewNode(11); + node->subcl = 20; + node->left = *x; + *x = node; + } + (*x)->typ = typ; +} + +static struct Op__38 { + INTEGER *f, *g; + struct Op__38 *lnk; +} *Op__38_s; + +static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y); +static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y); + +static void NewOp__39 (SHORTINT op, OPT_Struct typ, OPT_Node *x, OPT_Node y) +{ + OPT_Node node = NIL; + node = OPT_NewNode(12); + node->subcl = op; + node->typ = typ; + node->left = *x; + node->right = y; + *x = node; +} + +static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y) +{ + BOOLEAN _o_result; + BOOLEAN ok, xCharArr, yCharArr; + xCharArr = (__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 10; + yCharArr = (__IN((*y)->typ->comp, 0x0c) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 10; + if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) { + OPB_CharToString(*y); + *Op__38_s->g = 10; + yCharArr = 1; + } + if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) { + OPB_CharToString(*x); + *Op__38_s->f = 10; + xCharArr = 1; + } + ok = (xCharArr && yCharArr); + if (ok) { + if ((*Op__38_s->f == 10 && (*x)->conval->intval2 == 1)) { + (*x)->typ = OPT_chartyp; + (*x)->conval->intval = 0; + OPB_Index(&*y, OPB_NewIntConst(((LONGINT)(0)))); + } else if ((*Op__38_s->g == 10 && (*y)->conval->intval2 == 1)) { + (*y)->typ = OPT_chartyp; + (*y)->conval->intval = 0; + OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0)))); + } + } + _o_result = ok; + return _o_result; +} + +void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y) +{ + INTEGER f, g; + OPT_Node t = NIL, z = NIL; + OPT_Struct typ = NIL; + BOOLEAN do_; + LONGINT val; + struct Op__38 _s; + _s.f = &f; + _s.g = &g; + _s.lnk = Op__38_s; + Op__38_s = &_s; + z = *x; + if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) { + OPB_err(126); + } else if ((z->class == 7 && y->class == 7)) { + OPB_ConstOp(op, z, y); + z->obj = NIL; + } else { + if (z->typ != y->typ) { + g = y->typ->form; + switch (z->typ->form) { + case 3: + if (z->class == 7) { + OPB_CharToString(z); + } else { + OPB_err(100); + } + break; + case 4: + if (__IN(g, 0x01f0)) { + OPB_Convert(&z, y->typ); + } else { + OPB_err(100); + } + break; + case 5: + if (g == 4) { + OPB_Convert(&y, z->typ); + } else if (__IN(g, 0x01f0)) { + OPB_Convert(&z, y->typ); + } else { + OPB_err(100); + } + break; + case 6: + if (__IN(g, 0x70)) { + OPB_Convert(&y, z->typ); + } else if (__IN(g, 0x0180)) { + OPB_Convert(&z, y->typ); + } else { + OPB_err(100); + } + break; + case 7: + if (__IN(g, 0x70)) { + OPB_Convert(&y, z->typ); + } else if (__IN(g, 0x0180)) { + OPB_Convert(&z, y->typ); + } else { + OPB_err(100); + } + break; + case 8: + if (__IN(g, 0x01f0)) { + OPB_Convert(&y, z->typ); + } else if (__IN(g, 0x0180)) { + OPB_Convert(&y, z->typ); + } else { + OPB_err(100); + } + break; + case 11: + if (!__IN(g, 0x6000)) { + OPB_err(100); + } + break; + case 13: + OPB_CheckPtr(z, y); + break; + case 14: + if (g != 11) { + OPB_err(100); + } + break; + case 10: + break; + case 15: + if (z->typ->comp == 4) { + OPB_err(100); + } + break; + default: + OPB_err(100); + break; + } + } + typ = z->typ; + f = typ->form; + g = y->typ->form; + switch (op) { + case 1: + do_ = 1; + if (__IN(f, 0x70)) { + if (z->class == 7) { + val = z->conval->intval; + if (val == 1) { + do_ = 0; + z = y; + } else if (val == 0) { + do_ = 0; + } else if (OPB_log(val) == 1) { + t = y; + y = z; + z = t; + op = 17; + y->typ = OPT_sinttyp; + y->conval->intval = OPB_exp; + y->obj = NIL; + } + } else if (y->class == 7) { + val = y->conval->intval; + if (val == 1) { + do_ = 0; + } else if (val == 0) { + do_ = 0; + z = y; + } else if (OPB_log(val) == 1) { + op = 17; + y->typ = OPT_sinttyp; + y->conval->intval = OPB_exp; + y->obj = NIL; + } + } + } else if (!__IN(f, 0x0381)) { + OPB_err(105); + typ = OPT_undftyp; + } + if (do_) { + NewOp__39(op, typ, &z, y); + } + break; + case 2: + if (__IN(f, 0x70)) { + if ((y->class == 7 && y->conval->intval == 0)) { + OPB_err(205); + } + OPB_Convert(&z, OPT_realtyp); + OPB_Convert(&y, OPT_realtyp); + typ = OPT_realtyp; + } else if (__IN(f, 0x0180)) { + if ((y->class == 7 && y->conval->realval == (LONGREAL)0)) { + OPB_err(205); + } + } else if ((f != 9 && f != 0)) { + OPB_err(102); + typ = OPT_undftyp; + } + NewOp__39(op, typ, &z, y); + break; + case 3: + do_ = 1; + if (__IN(f, 0x70)) { + if (y->class == 7) { + val = y->conval->intval; + if (val == 0) { + OPB_err(205); + } else if (val == 1) { + do_ = 0; + } else if (OPB_log(val) == 1) { + op = 17; + y->typ = OPT_sinttyp; + y->conval->intval = -OPB_exp; + y->obj = NIL; + } + } + } else if (f != 0) { + OPB_err(103); + typ = OPT_undftyp; + } + if (do_) { + NewOp__39(op, typ, &z, y); + } + break; + case 4: + if (__IN(f, 0x70)) { + if (y->class == 7) { + if (y->conval->intval == 0) { + OPB_err(205); + } else if (OPB_log(y->conval->intval) == 1) { + op = 18; + y->conval->intval = __ASH(-1, OPB_exp); + y->obj = NIL; + } + } + } else if (f != 0) { + OPB_err(104); + typ = OPT_undftyp; + } + NewOp__39(op, typ, &z, y); + break; + case 5: + if (f == 2) { + if (z->class == 7) { + if (OPB_IntToBool(z->conval->intval)) { + z = y; + } + } else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) { + } else { + NewOp__39(op, typ, &z, y); + } + } else if (f != 0) { + OPB_err(94); + z->typ = OPT_undftyp; + } + break; + case 6: + if (!__IN(f, 0x03f1)) { + OPB_err(105); + typ = OPT_undftyp; + } + do_ = 1; + if (__IN(f, 0x70)) { + if ((z->class == 7 && z->conval->intval == 0)) { + do_ = 0; + z = y; + } + if ((y->class == 7 && y->conval->intval == 0)) { + do_ = 0; + } + } + if (do_) { + NewOp__39(op, typ, &z, y); + } + break; + case 7: + if (!__IN(f, 0x03f1)) { + OPB_err(106); + typ = OPT_undftyp; + } + if ((!__IN(f, 0x70) || y->class != 7) || y->conval->intval != 0) { + NewOp__39(op, typ, &z, y); + } + break; + case 8: + if (f == 2) { + if (z->class == 7) { + if (!OPB_IntToBool(z->conval->intval)) { + z = y; + } + } else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) { + } else { + NewOp__39(op, typ, &z, y); + } + } else if (f != 0) { + OPB_err(95); + z->typ = OPT_undftyp; + } + break; + case 9: case 10: + if (__IN(f, 0x6bff) || strings__41(&z, &y)) { + typ = OPT_booltyp; + } else { + OPB_err(107); + typ = OPT_undftyp; + } + NewOp__39(op, typ, &z, y); + break; + case 11: case 12: case 13: case 14: + if (__IN(f, 0x01f9) || strings__41(&z, &y)) { + typ = OPT_booltyp; + } else { + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"ELSE in Op()", (LONGINT)13); + OPM_LogWLn(); + OPB_err(108); + typ = OPT_undftyp; + } + NewOp__39(op, typ, &z, y); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", (LONGINT)32); + OPM_LogWNum(op, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } + *x = z; + Op__38_s = _s.lnk; +} + +void OPB_SetRange (OPT_Node *x, OPT_Node y) +{ + LONGINT k, l; + if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) { + OPB_err(126); + } else if ((__IN((*x)->typ->form, 0x70) && __IN(y->typ->form, 0x70))) { + if ((*x)->class == 7) { + k = (*x)->conval->intval; + if (0 > k || k > (LONGINT)OPM_MaxSet) { + OPB_err(202); + } + } + if (y->class == 7) { + l = y->conval->intval; + if (0 > l || l > (LONGINT)OPM_MaxSet) { + OPB_err(202); + } + } + if (((*x)->class == 7 && y->class == 7)) { + if (k <= l) { + (*x)->conval->setval = __SETRNG(k, l); + } else { + OPB_err(201); + (*x)->conval->setval = __SETRNG(l, k); + } + (*x)->obj = NIL; + } else { + OPB_BindNodes(10, OPT_settyp, &*x, y); + } + } else { + OPB_err(93); + } + (*x)->typ = OPT_settyp; +} + +void OPB_SetElem (OPT_Node *x) +{ + LONGINT k; + if ((*x)->class == 8 || (*x)->class == 9) { + OPB_err(126); + } else if (!__IN((*x)->typ->form, 0x70)) { + OPB_err(93); + } else if ((*x)->class == 7) { + k = (*x)->conval->intval; + if ((0 <= k && k <= (LONGINT)OPM_MaxSet)) { + (*x)->conval->setval = __SETOF(k); + } else { + OPB_err(202); + } + (*x)->obj = NIL; + } else { + OPB_Convert(&*x, OPT_settyp); + } + (*x)->typ = OPT_settyp; +} + +static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode) +{ + INTEGER f, g; + OPT_Struct y = NIL, p = NIL, q = NIL; + if (OPM_Verbose) { + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"PROCEDURE CheckAssign", (LONGINT)22); + OPM_LogWLn(); + } + y = ynode->typ; + f = x->form; + g = y->form; + if (OPM_Verbose) { + OPM_LogWStr((CHAR*)"y.form = ", (LONGINT)10); + OPM_LogWNum(y->form, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"f = ", (LONGINT)5); + OPM_LogWNum(f, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"g = ", (LONGINT)5); + OPM_LogWNum(g, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"ynode.typ.syze = ", (LONGINT)18); + OPM_LogWNum(ynode->typ->size, ((LONGINT)(0))); + OPM_LogWLn(); + } + if (ynode->class == 8 || (ynode->class == 9 && f != 14)) { + OPB_err(126); + } + switch (f) { + case 0: case 10: + break; + case 1: + if (!__IN(g, 0x1a)) { + OPB_err(113); + } + break; + case 2: case 3: case 4: case 9: + if (g != f) { + OPB_err(113); + } + break; + case 5: + if (!__IN(g, 0x30)) { + OPB_err(113); + } + break; + case 6: + if (OPM_LIntSize == 4) { + if (!__IN(g, 0x70)) { + OPB_err(113); + } + } else { + if (!__IN(g, 0x70)) { + OPB_err(113); + } + } + break; + case 7: + if (!__IN(g, 0xf0)) { + OPB_err(113); + } + break; + case 8: + if (!__IN(g, 0x01f0)) { + OPB_err(113); + } + break; + case 13: + if ((x == y || g == 11) || (x == OPT_sysptrtyp && g == 13)) { + } else if (g == 13) { + p = x->BaseTyp; + q = y->BaseTyp; + if ((p->comp == 4 && q->comp == 4)) { + while ((((q != p && q != NIL)) && q != OPT_undftyp)) { + q = q->BaseTyp; + } + if (q == NIL) { + OPB_err(113); + } + } else { + OPB_err(113); + } + } else { + OPB_err(113); + } + break; + case 14: + if (ynode->class == 9) { + OPB_CheckProc(x, ynode->obj); + } else if (x == y || g == 11) { + } else { + OPB_err(113); + } + break; + case 12: case 11: + OPB_err(113); + break; + case 15: + x->pvused = 1; + if (x->comp == 2) { + if ((ynode->class == 7 && g == 3)) { + OPB_CharToString(ynode); + y = ynode->typ; + g = 10; + } + if (x == y) { + } else if (x->BaseTyp == OPT_chartyp) { + if (g == 10) { + if (ynode->conval->intval2 > x->n) { + OPB_err(114); + } + } else if ((__IN(y->comp, 0x0c) && y->BaseTyp == OPT_chartyp)) { + } else { + OPB_err(113); + } + } else { + OPB_err(113); + } + } else if ((x->comp == 3 && x->BaseTyp == OPT_chartyp)) { + if ((__IN(y->comp, 0x0c) && y->BaseTyp == OPT_chartyp)) { + } else { + OPB_err(113); + } + } else if (x->comp == 4) { + if (x == y) { + } else if (y->comp == 4) { + q = y->BaseTyp; + while ((((q != NIL && q != x)) && q != OPT_undftyp)) { + q = q->BaseTyp; + } + if (q == NIL) { + OPB_err(113); + } + } else { + OPB_err(113); + } + } else { + OPB_err(113); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.CheckAssign, f = ", (LONGINT)40); + OPM_LogWNum(f, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + if ((((((ynode->class == 7 && g < f)) && __IN(g, 0xf0))) && __IN(f, 0x01e0))) { + OPB_Convert(&ynode, x); + } +} + +static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo) +{ +} + +void OPB_StPar0 (OPT_Node *par0, INTEGER fctno) +{ + INTEGER f; + OPT_Struct typ = NIL; + OPT_Node x = NIL; + x = *par0; + f = x->typ->form; + switch (fctno) { + case 0: + if ((__IN(f, 0x70) && x->class == 7)) { + if ((0 <= x->conval->intval && x->conval->intval <= 255)) { + OPB_BindNodes(28, OPT_notyp, &x, x); + } else { + OPB_err(218); + } + } else { + OPB_err(69); + } + x->typ = OPT_notyp; + break; + case 1: + typ = OPT_notyp; + if (OPB_NotVar(x)) { + OPB_err(112); + } else if (f == 13) { + if (x->readonly) { + OPB_err(76); + } + f = x->typ->BaseTyp->comp; + if (__IN(f, 0x1c)) { + if (f == 3) { + typ = x->typ->BaseTyp; + } + OPB_BindNodes(19, OPT_notyp, &x, NIL); + x->subcl = 1; + } else { + OPB_err(111); + } + } else { + OPB_err(111); + } + x->typ = typ; + break; + case 2: + OPB_MOp(21, &x); + break; + case 3: + OPB_MOp(22, &x); + break; + case 4: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (f == 3) { + OPB_Convert(&x, OPT_inttyp); + } else { + OPB_err(111); + } + x->typ = OPT_inttyp; + break; + case 5: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x0180)) { + OPB_Convert(&x, OPT_linttyp); + } else { + OPB_err(111); + } + x->typ = OPT_linttyp; + break; + case 6: + OPB_MOp(23, &x); + break; + case 7: + if (x->class == 8) { + switch (f) { + case 2: + x = OPB_NewBoolConst(0); + break; + case 3: + x = OPB_NewIntConst(((LONGINT)(0))); + x->typ = OPT_chartyp; + break; + case 4: + x = OPB_NewIntConst(OPM_MinSInt); + break; + case 5: + x = OPB_NewIntConst(OPM_MinInt); + break; + case 6: + x = OPB_NewIntConst(OPM_MinLInt); + break; + case 9: + x = OPB_NewIntConst(((LONGINT)(0))); + x->typ = OPT_inttyp; + break; + case 7: + x = OPB_NewRealConst(OPM_MinReal, OPT_realtyp); + break; + case 8: + x = OPB_NewRealConst(OPM_MinLReal, OPT_lrltyp); + break; + default: + OPB_err(111); + break; + } + } else { + OPB_err(110); + } + break; + case 8: + if (x->class == 8) { + switch (f) { + case 2: + x = OPB_NewBoolConst(1); + break; + case 3: + x = OPB_NewIntConst(((LONGINT)(255))); + x->typ = OPT_chartyp; + break; + case 4: + x = OPB_NewIntConst(OPM_MaxSInt); + break; + case 5: + x = OPB_NewIntConst(OPM_MaxInt); + break; + case 6: + x = OPB_NewIntConst(OPM_MaxLInt); + break; + case 9: + x = OPB_NewIntConst(OPM_MaxSet); + x->typ = OPT_inttyp; + break; + case 7: + x = OPB_NewRealConst(OPM_MaxReal, OPT_realtyp); + break; + case 8: + x = OPB_NewRealConst(OPM_MaxLReal, OPT_lrltyp); + break; + default: + OPB_err(111); + break; + } + } else { + OPB_err(110); + } + break; + case 9: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x71)) { + OPB_Convert(&x, OPT_chartyp); + } else { + OPB_err(111); + x->typ = OPT_chartyp; + } + break; + case 10: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (f == 5) { + OPB_Convert(&x, OPT_sinttyp); + } else if (f == 6) { + OPB_Convert(&x, OPT_inttyp); + } else if (f == 8) { + OPB_Convert(&x, OPT_realtyp); + } else { + OPB_err(111); + } + break; + case 11: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (f == 4) { + OPB_Convert(&x, OPT_inttyp); + } else if (f == 5) { + OPB_Convert(&x, OPT_linttyp); + } else if (f == 7) { + OPB_Convert(&x, OPT_lrltyp); + } else if (f == 3) { + OPB_Convert(&x, OPT_linttyp); + } else { + OPB_err(111); + } + break; + case 13: case 14: + if (OPB_NotVar(x)) { + OPB_err(112); + } else if (!__IN(f, 0x70)) { + OPB_err(111); + } else if (x->readonly) { + OPB_err(76); + } + break; + case 15: case 16: + if (OPB_NotVar(x)) { + OPB_err(112); + } else if (x->typ != OPT_settyp) { + OPB_err(111); + x->typ = OPT_settyp; + } else if (x->readonly) { + OPB_err(76); + } + break; + case 17: + if (!__IN(x->typ->comp, 0x0c)) { + OPB_err(131); + } + break; + case 18: + if ((x->class == 7 && f == 3)) { + OPB_CharToString(x); + f = 10; + } + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (((!__IN(x->typ->comp, 0x0c) || x->typ->BaseTyp->form != 3) && f != 10)) { + OPB_err(111); + } + break; + case 19: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + if (f != 6) { + OPB_Convert(&x, OPT_linttyp); + } + } else { + OPB_err(111); + x->typ = OPT_linttyp; + } + break; + case 20: + OPB_CheckLeaf(x, 0); + OPB_MOp(24, &x); + break; + case 12: + if (x->class != 8) { + OPB_err(110); + x = OPB_NewIntConst(((LONGINT)(1))); + } else if (__IN(f, 0x63fe) || __IN(x->typ->comp, 0x14)) { + (*OPB_typSize)(x->typ); + x->typ->pvused = 1; + x = OPB_NewIntConst(x->typ->size); + } else { + OPB_err(111); + x = OPB_NewIntConst(((LONGINT)(1))); + } + break; + case 21: + OPB_MOp(25, &x); + break; + case 22: case 23: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (!__IN(f, 0x027a)) { + OPB_err(111); + } + break; + case 24: case 25: case 28: case 31: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if ((x->class == 7 && __IN(f, 0x30))) { + OPB_Convert(&x, OPT_linttyp); + } else if (!__IN(f, 0x2040)) { + OPB_err(111); + x->typ = OPT_linttyp; + } + break; + case 26: case 27: + if ((__IN(f, 0x70) && x->class == 7)) { + if (x->conval->intval < 0 || x->conval->intval > -1) { + OPB_err(220); + } + } else { + OPB_err(69); + } + break; + case 29: + if (x->class != 8) { + OPB_err(110); + } else if (__IN(f, 0x1401) || x->typ->comp == 3) { + OPB_err(111); + } + break; + case 30: + if (OPB_NotVar(x)) { + OPB_err(112); + } else if (f == 13) { + } else { + OPB_err(111); + } + break; + case 32: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + x = OPB_NewBoolConst(0); + } else if (f != 2) { + OPB_err(120); + x = OPB_NewBoolConst(0); + } else { + OPB_MOp(33, &x); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPB.StPar0, fctno = ", (LONGINT)39); + OPM_LogWNum(fctno, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + *par0 = x; +} + +static struct StPar1__52 { + struct StPar1__52 *lnk; +} *StPar1__52_s; + +static OPT_Node NewOp__53 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right); + +static OPT_Node NewOp__53 (SHORTINT class, SHORTINT subcl, OPT_Node left, OPT_Node right) +{ + OPT_Node _o_result; + OPT_Node node = NIL; + node = OPT_NewNode(class); + node->subcl = subcl; + node->left = left; + node->right = right; + _o_result = node; + return _o_result; +} + +void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno) +{ + INTEGER f, L; + OPT_Struct typ = NIL; + OPT_Node p = NIL, t = NIL; + struct StPar1__52 _s; + _s.lnk = StPar1__52_s; + StPar1__52_s = &_s; + p = *par0; + f = x->typ->form; + switch (fctno) { + case 13: case 14: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + p->typ = OPT_notyp; + } else { + if (x->typ != p->typ) { + if ((x->class == 7 && __IN(f, 0x70))) { + OPB_Convert(&x, p->typ); + } else { + OPB_err(111); + } + } + p = NewOp__53(19, fctno, p, x); + p->typ = OPT_notyp; + } + break; + case 15: case 16: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval > (LONGINT)OPM_MaxSet))) { + OPB_err(202); + } + p = NewOp__53(19, fctno, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + break; + case 17: + if (!__IN(f, 0x70) || x->class != 7) { + OPB_err(69); + } else if (f == 4) { + L = (int)x->conval->intval; + typ = p->typ; + while ((L > 0 && __IN(typ->comp, 0x0c))) { + typ = typ->BaseTyp; + L -= 1; + } + if (L != 0 || !__IN(typ->comp, 0x0c)) { + OPB_err(132); + } else { + x->obj = NIL; + if (typ->comp == 3) { + while (p->class == 4) { + p = p->left; + x->conval->intval += 1; + } + p = NewOp__53(12, 19, p, x); + p->typ = OPT_linttyp; + } else { + p = x; + p->conval->intval = typ->n; + OPB_SetIntType(p); + } + } + } else { + OPB_err(132); + } + break; + case 18: + if (OPB_NotVar(x)) { + OPB_err(112); + } else if ((__IN(x->typ->comp, 0x0c) && x->typ->BaseTyp->form == 3)) { + if (x->readonly) { + OPB_err(76); + } + t = x; + x = p; + p = t; + p = NewOp__53(19, 18, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + break; + case 19: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + if ((p->class == 7 && x->class == 7)) { + if (-OPB_maxExp > x->conval->intval || x->conval->intval > OPB_maxExp) { + OPB_err(208); + p->conval->intval = 1; + } else if (x->conval->intval >= 0) { + if (__ABS(p->conval->intval) <= __DIV(9223372036854775807, __ASH(1, x->conval->intval))) { + p->conval->intval = p->conval->intval * __ASH(1, x->conval->intval); + } else { + OPB_err(208); + p->conval->intval = 1; + } + } else { + p->conval->intval = __ASH(p->conval->intval, x->conval->intval); + } + p->obj = NIL; + } else { + p = NewOp__53(12, 17, p, x); + p->typ = OPT_linttyp; + } + } else { + OPB_err(111); + } + break; + case 1: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (p->typ->comp == 3) { + if (__IN(f, 0x70)) { + if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) { + OPB_err(63); + } + } else { + OPB_err(111); + } + p->right = x; + p->typ = p->typ->BaseTyp; + } else { + OPB_err(64); + } + break; + case 22: case 23: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (!__IN(f, 0x70)) { + OPB_err(111); + } else { + if (fctno == 22) { + p = NewOp__53(12, 27, p, x); + } else { + p = NewOp__53(12, 28, p, x); + } + p->typ = p->left->typ; + } + break; + case 24: case 25: case 26: case 27: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x63ff)) { + if (fctno == 24 || fctno == 26) { + if (OPB_NotVar(x)) { + OPB_err(112); + } + t = x; + x = p; + p = t; + } + p = NewOp__53(19, fctno, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + break; + case 28: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + p = NewOp__53(12, 26, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_booltyp; + break; + case 29: + if (((x->class == 8 || x->class == 9) || __IN(f, 0x1401)) || x->typ->comp == 3) { + OPB_err(126); + } + t = OPT_NewNode(11); + t->subcl = 29; + t->left = x; + x = t; + x->typ = p->typ; + p = x; + break; + case 30: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + p = NewOp__53(19, 30, p, x); + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + break; + case 31: + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if ((x->class == 7 && __IN(f, 0x30))) { + OPB_Convert(&x, OPT_linttyp); + } else if (!__IN(f, 0x2040)) { + OPB_err(111); + x->typ = OPT_linttyp; + } + p->link = x; + break; + case 32: + if ((__IN(f, 0x70) && x->class == 7)) { + if ((0 <= x->conval->intval && x->conval->intval <= 255)) { + OPB_BindNodes(28, OPT_notyp, &x, x); + x->conval = OPT_NewConst(); + x->conval->intval = OPM_errpos; + OPB_Construct(15, &p, x); + p->conval = OPT_NewConst(); + p->conval->intval = OPM_errpos; + OPB_Construct(20, &p, NIL); + OPB_OptIf(&p); + if (p == NIL) { + } else if (p->class == 28) { + OPB_err(99); + } else { + p->subcl = 32; + } + } else { + OPB_err(218); + } + } else { + OPB_err(69); + } + break; + default: + OPB_err(64); + break; + } + *par0 = p; + StPar1__52_s = _s.lnk; +} + +void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n) +{ + OPT_Node node = NIL; + INTEGER f; + OPT_Node p = NIL; + p = *par0; + f = x->typ->form; + if (fctno == 1) { + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (p->typ->comp != 3) { + OPB_err(64); + } else if (__IN(f, 0x70)) { + if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) { + OPB_err(63); + } + node = p->right; + while (node->link != NIL) { + node = node->link; + } + node->link = x; + p->typ = p->typ->BaseTyp; + } else { + OPB_err(111); + } + } else if ((fctno == 31 && n == 2)) { + if (x->class == 8 || x->class == 9) { + OPB_err(126); + } else if (__IN(f, 0x70)) { + node = OPT_NewNode(19); + node->subcl = 31; + node->right = p; + node->left = p->link; + p->link = x; + p = node; + } else { + OPB_err(111); + } + p->typ = OPT_notyp; + } else { + OPB_err(64); + } + *par0 = p; +} + +void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno) +{ + INTEGER dim; + OPT_Node x = NIL, p = NIL; + p = *par0; + if (fctno <= 19) { + if ((fctno == 1 && p->typ != OPT_notyp)) { + if (p->typ->comp == 3) { + OPB_err(65); + } + p->typ = OPT_notyp; + } else if (fctno <= 12) { + if (parno < 1) { + OPB_err(65); + } + } else { + if (((fctno == 13 || fctno == 14) && parno == 1)) { + OPB_BindNodes(19, OPT_notyp, &p, OPB_NewIntConst(((LONGINT)(1)))); + p->subcl = fctno; + p->right->typ = p->left->typ; + } else if ((fctno == 17 && parno == 1)) { + if (p->typ->comp == 3) { + dim = 0; + while (p->class == 4) { + p = p->left; + dim += 1; + } + OPB_BindNodes(12, OPT_linttyp, &p, OPB_NewIntConst(dim)); + p->subcl = 19; + } else { + p = OPB_NewIntConst(p->typ->n); + } + } else if (parno < 2) { + OPB_err(65); + } + } + } else if (fctno == 32) { + if (parno == 1) { + x = NIL; + OPB_BindNodes(28, OPT_notyp, &x, OPB_NewIntConst(((LONGINT)(0)))); + x->conval = OPT_NewConst(); + x->conval->intval = OPM_errpos; + OPB_Construct(15, &p, x); + p->conval = OPT_NewConst(); + p->conval->intval = OPM_errpos; + OPB_Construct(20, &p, NIL); + OPB_OptIf(&p); + if (p == NIL) { + } else if (p->class == 28) { + OPB_err(99); + } else { + p->subcl = 32; + } + } else if (parno < 1) { + OPB_err(65); + } + } else { + if ((parno < 1 || (fctno > 21 && parno < 2)) || (fctno == 31 && parno < 3)) { + OPB_err(65); + } + } + *par0 = p; +} + +static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar) +{ + INTEGER f; + f = atyp->comp; + ftyp = ftyp->BaseTyp; + atyp = atyp->BaseTyp; + if ((fvarpar && ftyp == OPT_bytetyp)) { + if (!__IN(f, 0x0c) || !__IN(atyp->form, 0x1e)) { + if (__IN(18, OPM_opt)) { + OPB_err(-301); + } + } + } else if (__IN(f, 0x0c)) { + if (ftyp->comp == 3) { + OPB_DynArrParCheck(ftyp, atyp, fvarpar); + } else if (ftyp != atyp) { + if ((((!fvarpar && ftyp->form == 13)) && atyp->form == 13)) { + ftyp = ftyp->BaseTyp; + atyp = atyp->BaseTyp; + if ((ftyp->comp == 4 && atyp->comp == 4)) { + while ((((ftyp != atyp && atyp != NIL)) && atyp != OPT_undftyp)) { + atyp = atyp->BaseTyp; + } + if (atyp == NIL) { + OPB_err(113); + } + } else { + OPB_err(66); + } + } else { + OPB_err(66); + } + } + } else { + OPB_err(67); + } +} + +static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp) +{ + if (fp->typ->form == 13) { + if ((*x)->class == 3) { + *x = (*x)->left; + } else { + OPB_err(71); + } + } +} + +void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar) +{ + if (((*x)->obj != NIL && __IN((*x)->obj->mode, 0x22c0))) { + *fpar = (*x)->obj->link; + if ((*x)->obj->mode == 13) { + OPB_CheckReceiver(&(*x)->left, *fpar); + *fpar = (*fpar)->link; + } + } else if (((((*x)->class != 8 && (*x)->typ != NIL)) && (*x)->typ->form == 14)) { + *fpar = (*x)->typ->link; + } else { + OPB_err(121); + *fpar = NIL; + (*x)->typ = OPT_undftyp; + } +} + +void OPB_Param (OPT_Node ap, OPT_Object fp) +{ + OPT_Struct q = NIL; + if (fp->typ->form != 0) { + if (fp->mode == 2) { + if (OPB_NotVar(ap)) { + OPB_err(122); + } else { + OPB_CheckLeaf(ap, 0); + } + if (ap->readonly) { + OPB_err(76); + } + if (fp->typ->comp == 3) { + OPB_DynArrParCheck(fp->typ, ap->typ, 1); + } else if ((fp->typ->comp == 4 && ap->typ->comp == 4)) { + q = ap->typ; + while ((((q != fp->typ && q != NIL)) && q != OPT_undftyp)) { + q = q->BaseTyp; + } + if (q == NIL) { + OPB_err(111); + } + } else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 13)) { + } else if ((ap->typ != fp->typ && !((fp->typ->form == 1 && __IN(ap->typ->form, 0x18))))) { + OPB_err(123); + } else if ((fp->typ->form == 13 && ap->class == 5)) { + OPB_err(123); + } + } else if (fp->typ->comp == 3) { + if ((ap->class == 7 && ap->typ->form == 3)) { + OPB_CharToString(ap); + } + if ((ap->typ->form == 10 && fp->typ->BaseTyp->form == 3)) { + } else if (ap->class >= 7) { + OPB_err(59); + } else { + OPB_DynArrParCheck(fp->typ, ap->typ, 0); + } + } else { + OPB_CheckAssign(fp->typ, ap); + } + } +} + +void OPB_StaticLink (SHORTINT dlev) +{ + OPT_Object scope = NIL; + scope = OPT_topScope; + while (dlev > 0) { + dlev -= 1; + scope->link->conval->setval |= __SETOF(3); + scope = scope->left; + } +} + +void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp) +{ + OPT_Struct typ = NIL; + OPT_Node p = NIL; + SHORTINT lev; + if ((*x)->class == 9) { + typ = (*x)->typ; + lev = (*x)->obj->mnolev; + if (lev > 0) { + OPB_StaticLink(OPT_topScope->mnolev - lev); + } + if ((*x)->obj->mode == 10) { + OPB_err(121); + } + } else if (((*x)->class == 2 && (*x)->obj->mode == 13)) { + typ = (*x)->typ; + (*x)->class = 9; + p = (*x)->left; + (*x)->left = NIL; + p->link = apar; + apar = p; + fp = (*x)->obj->link; + } else { + typ = (*x)->typ->BaseTyp; + } + OPB_BindNodes(13, typ, &*x, apar); + (*x)->obj = fp; +} + +void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc) +{ + OPT_Node x = NIL; + x = OPT_NewNode(18); + x->typ = OPT_notyp; + x->obj = proc; + x->left = *procdec; + x->right = stat; + *procdec = x; +} + +void OPB_Return (OPT_Node *x, OPT_Object proc) +{ + OPT_Node node = NIL; + if (proc == NIL) { + if (*x != NIL) { + OPB_err(124); + } + } else { + if (*x != NIL) { + OPB_CheckAssign(proc->typ, *x); + } else if (proc->typ != OPT_notyp) { + OPB_err(124); + } + } + node = OPT_NewNode(26); + node->typ = OPT_notyp; + node->obj = proc; + node->left = *x; + *x = node; +} + +void OPB_Assign (OPT_Node *x, OPT_Node y) +{ + OPT_Node z = NIL; + SHORTINT subcl; + if ((*x)->class >= 7) { + OPB_err(56); + } + OPB_CheckAssign((*x)->typ, y); + if ((*x)->readonly) { + OPB_err(76); + } + if ((*x)->typ->comp == 4) { + if ((*x)->class == 5) { + z = (*x)->left; + } else { + z = *x; + } + if ((z->class == 3 && z->left->class == 5)) { + z->left = z->left->left; + } + if (((*x)->typ->strobj != NIL && (z->class == 3 || z->class == 1))) { + OPB_BindNodes(6, (*x)->typ, &z, NIL); + *x = z; + } + } else if (((((((*x)->typ->comp == 2 && (*x)->typ->BaseTyp == OPT_chartyp)) && y->typ->form == 10)) && y->conval->intval2 == 1)) { + y->typ = OPT_chartyp; + y->conval->intval = 0; + OPB_Index(&*x, OPB_NewIntConst(((LONGINT)(0)))); + } + if ((((((__IN((*x)->typ->comp, 0x0c) && (*x)->typ->BaseTyp == OPT_chartyp)) && __IN(y->typ->comp, 0x0c))) && y->typ->BaseTyp == OPT_chartyp)) { + subcl = 18; + } else { + subcl = 0; + } + OPB_BindNodes(19, OPT_notyp, &*x, y); + (*x)->subcl = subcl; +} + +void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ) +{ + OPT_Node node = NIL; + node = OPT_NewNode(14); + node->typ = typ; + node->conval = OPT_NewConst(); + node->conval->intval = typ->txtpos; + if (*inittd == NIL) { + *inittd = node; + } else { + (*last)->link = node; + } + *last = node; +} + + +export void *OPB__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPS); + __MODULE_IMPORT(OPT); + __REGMOD("OPB", 0); +/* BEGIN */ + OPB_maxExp = OPB_log(4611686018427387904); + OPB_maxExp = OPB_exp; + __ENDMOD; +} diff --git a/bootstrap/windows-88/OPB.h b/bootstrap/windows-88/OPB.h new file mode 100644 index 00000000..c8165f54 --- /dev/null +++ b/bootstrap/windows-88/OPB.h @@ -0,0 +1,50 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPB__h +#define OPB__h + +#define LARGE +#include "SYSTEM.h" +#include "OPS.h" +#include "OPT.h" + + +import void (*OPB_typSize)(OPT_Struct); + + +import void OPB_Assign (OPT_Node *x, OPT_Node y); +import void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp); +import void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames); +import void OPB_Construct (SHORTINT class, OPT_Node *x, OPT_Node y); +import void OPB_DeRef (OPT_Node *x); +import OPT_Node OPB_EmptySet (void); +import void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc); +import void OPB_Field (OPT_Node *x, OPT_Object y); +import void OPB_In (OPT_Node *x, OPT_Node y); +import void OPB_Index (OPT_Node *x, OPT_Node y); +import void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ); +import void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y); +import void OPB_MOp (SHORTINT op, OPT_Node *x); +import OPT_Node OPB_NewBoolConst (BOOLEAN boolval); +import OPT_Node OPB_NewIntConst (LONGINT intval); +import OPT_Node OPB_NewLeaf (OPT_Object obj); +import OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ); +import OPT_Node OPB_NewString (OPS_String str, LONGINT len); +import OPT_Node OPB_Nil (void); +import void OPB_Op (SHORTINT op, OPT_Node *x, OPT_Node y); +import void OPB_OptIf (OPT_Node *x); +import void OPB_Param (OPT_Node ap, OPT_Object fp); +import void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar); +import void OPB_Return (OPT_Node *x, OPT_Object proc); +import void OPB_SetElem (OPT_Node *x); +import void OPB_SetRange (OPT_Node *x, OPT_Node y); +import void OPB_StFct (OPT_Node *par0, SHORTINT fctno, INTEGER parno); +import void OPB_StPar0 (OPT_Node *par0, INTEGER fctno); +import void OPB_StPar1 (OPT_Node *par0, OPT_Node x, SHORTINT fctno); +import void OPB_StParN (OPT_Node *par0, OPT_Node x, INTEGER fctno, INTEGER n); +import void OPB_StaticLink (SHORTINT dlev); +import void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard); +import void *OPB__init(void); + + +#endif diff --git a/bootstrap/windows-88/OPC.c b/bootstrap/windows-88/OPC.c new file mode 100644 index 00000000..10468b9e --- /dev/null +++ b/bootstrap/windows-88/OPC.c @@ -0,0 +1,2109 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "Configuration.h" +#include "OPM.h" +#include "OPT.h" + + +static INTEGER OPC_indentLevel; +static BOOLEAN OPC_ptrinit, OPC_mainprog, OPC_ansi; +static SHORTINT OPC_hashtab[105]; +static CHAR OPC_keytab[36][9]; +static BOOLEAN OPC_GlbPtrs; +static CHAR OPC_BodyNameExt[13]; + + +export void OPC_Align (LONGINT *adr, LONGINT base); +export void OPC_Andent (OPT_Struct typ); +static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames); +export LONGINT OPC_Base (OPT_Struct typ); +export OPT_Object OPC_BaseTProc (OPT_Object obj); +export void OPC_BegBlk (void); +export void OPC_BegStat (void); +static void OPC_CProcDefs (OPT_Object obj, INTEGER vis); +export void OPC_Case (LONGINT caseVal, INTEGER form); +export void OPC_Cmp (INTEGER rel); +export void OPC_CompleteIdent (OPT_Object obj); +export void OPC_Constant (OPT_Const con, INTEGER form); +static void OPC_DeclareBase (OPT_Object dcl); +static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef); +static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro); +static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty); +static void OPC_DefAnonRecs (OPT_Node n); +export void OPC_DefineInter (OPT_Object proc); +static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty); +static void OPC_DefineTProcTypes (OPT_Object obj); +static void OPC_DefineType (OPT_Struct str); +export void OPC_EndBlk (void); +export void OPC_EndBlk0 (void); +export void OPC_EndStat (void); +export void OPC_EnterBody (void); +export void OPC_EnterProc (OPT_Object proc); +export void OPC_ExitBody (void); +export void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet); +static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *n, LONGINT *curAlign); +static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign); +export void OPC_GenBdy (OPT_Node n); +static void OPC_GenDynTypes (OPT_Node n, INTEGER vis); +export void OPC_GenEnumPtrs (OPT_Object var); +export void OPC_GenHdr (OPT_Node n); +export void OPC_GenHdrIncludes (void); +static void OPC_GenHeaderMsg (void); +export void OPC_Halt (LONGINT n); +export void OPC_Ident (OPT_Object obj); +static void OPC_IdentList (OPT_Object obj, INTEGER vis); +static void OPC_Include (CHAR *name, LONGINT name__len); +static void OPC_IncludeImports (OPT_Object obj, INTEGER vis); +export void OPC_Increment (BOOLEAN decrement); +export void OPC_Indent (INTEGER count); +export void OPC_Init (void); +static void OPC_InitImports (OPT_Object obj); +static void OPC_InitKeywords (void); +export void OPC_InitTDesc (OPT_Struct typ); +static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj); +export void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim); +static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName); +static INTEGER OPC_Length (CHAR *s, LONGINT s__len); +export LONGINT OPC_NofPtrs (OPT_Struct typ); +static INTEGER OPC_PerfectHash (CHAR *s, LONGINT s__len); +static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len); +static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define); +static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis); +static void OPC_PutBase (OPT_Struct typ); +static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt); +static void OPC_RegCmds (OPT_Object obj); +export void OPC_SetInclude (BOOLEAN exclude); +static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause); +static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x); +export void OPC_TDescDecl (OPT_Struct typ); +export void OPC_TypeDefs (OPT_Object obj, INTEGER vis); +export void OPC_TypeOf (OPT_Object ap); +static BOOLEAN OPC_Undefined (OPT_Object obj); + + +void OPC_Init (void) +{ + OPC_indentLevel = 0; + OPC_ptrinit = __IN(5, OPM_opt); + OPC_mainprog = OPM_mainProg || OPM_mainLinkStat; + OPC_ansi = __IN(6, OPM_opt); + if (OPC_ansi) { + __MOVE("__init(void)", OPC_BodyNameExt, 13); + } else { + __MOVE("__init()", OPC_BodyNameExt, 9); + } +} + +void OPC_Indent (INTEGER count) +{ + OPC_indentLevel += count; +} + +void OPC_BegStat (void) +{ + INTEGER i; + i = OPC_indentLevel; + while (i > 0) { + OPM_Write(0x09); + i -= 1; + } +} + +void OPC_EndStat (void) +{ + OPM_Write(';'); + OPM_WriteLn(); +} + +void OPC_BegBlk (void) +{ + OPM_Write('{'); + OPM_WriteLn(); + OPC_indentLevel += 1; +} + +void OPC_EndBlk (void) +{ + OPC_indentLevel -= 1; + OPC_BegStat(); + OPM_Write('}'); + OPM_WriteLn(); +} + +void OPC_EndBlk0 (void) +{ + OPC_indentLevel -= 1; + OPC_BegStat(); + OPM_Write('}'); +} + +static void OPC_Str1 (CHAR *s, LONGINT s__len, LONGINT x) +{ + CHAR ch; + INTEGER i; + __DUP(s, s__len, CHAR); + ch = s[0]; + i = 0; + while (ch != 0x00) { + if (ch == '#') { + OPM_WriteInt(x); + } else { + OPM_Write(ch); + } + i += 1; + ch = s[__X(i, s__len)]; + } + __DEL(s); +} + +static INTEGER OPC_Length (CHAR *s, LONGINT s__len) +{ + INTEGER _o_result; + INTEGER i; + i = 0; + while (s[__X(i, s__len)] != 0x00) { + i += 1; + } + _o_result = i; + return _o_result; +} + +static INTEGER OPC_PerfectHash (CHAR *s, LONGINT s__len) +{ + INTEGER _o_result; + INTEGER i, h; + i = 0; + h = 0; + while ((s[__X(i, s__len)] != 0x00 && i < 5)) { + h = 3 * h + (int)s[__X(i, s__len)]; + i += 1; + } + _o_result = (int)__MOD(h, 105); + return _o_result; +} + +void OPC_Ident (OPT_Object obj) +{ + INTEGER mode, level, h; + mode = obj->mode; + level = obj->mnolev; + if ((__IN(mode, 0x62) && level > 0) || __IN(mode, 0x14)) { + OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256))); + h = OPC_PerfectHash((void*)obj->name, ((LONGINT)(256))); + if (OPC_hashtab[__X(h, ((LONGINT)(105)))] >= 0) { + if (__STRCMP(OPC_keytab[__X(OPC_hashtab[__X(h, ((LONGINT)(105)))], ((LONGINT)(36)))], obj->name) == 0) { + OPM_Write('_'); + } + } + } else { + if (mode != 5 || obj->linkadr != 2) { + if (mode == 13) { + OPC_Ident(obj->link->typ->strobj); + } else if (level < 0) { + OPM_WriteStringVar((void*)OPT_GlbMod[__X(-level, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + if (OPM_currFile == 0) { + OPT_GlbMod[__X(-level, ((LONGINT)(64)))]->vis = 1; + } + } else { + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + } + OPM_Write('_'); + } else if (obj == OPT_sysptrtyp->strobj || obj == OPT_bytetyp->strobj) { + OPM_WriteString((CHAR*)"SYSTEM_", (LONGINT)8); + } + OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256))); + } +} + +static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause) +{ + INTEGER pointers; + *openClause = 0; + if (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->comp != 4)) { + if (__IN(typ->comp, 0x0c)) { + OPC_Stars(typ->BaseTyp, &*openClause); + *openClause = typ->comp == 2; + } else if (typ->form == 14) { + OPM_Write('('); + OPM_Write('*'); + } else { + pointers = 0; + while (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->form == 13)) { + pointers += 1; + typ = typ->BaseTyp; + } + if (pointers > 0) { + if (typ->comp != 3) { + OPC_Stars(typ, &*openClause); + } + if (*openClause) { + OPM_Write('('); + *openClause = 0; + } + while (pointers > 0) { + OPM_Write('*'); + pointers -= 1; + } + } + } + } +} + +static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef) +{ + OPT_Struct typ = NIL; + BOOLEAN varPar, openClause; + INTEGER form, comp; + typ = dcl->typ; + varPar = ((dcl->mode == 2 && typ->comp != 2) || typ->comp == 3) || scopeDef; + OPC_Stars(typ, &openClause); + if (varPar) { + if (openClause) { + OPM_Write('('); + } + OPM_Write('*'); + } + if (dcl->name[0] != 0x00) { + OPC_Ident(dcl); + } + if ((varPar && openClause)) { + OPM_Write(')'); + } + openClause = 0; + for (;;) { + form = typ->form; + comp = typ->comp; + if (((typ->strobj != NIL && typ->strobj->name[0] != 0x00) || form == 12) || comp == 4) { + break; + } else if ((form == 13 && typ->BaseTyp->comp != 3)) { + openClause = 1; + } else if (form == 14 || __IN(comp, 0x0c)) { + if (openClause) { + OPM_Write(')'); + openClause = 0; + } + if (form == 14) { + if (OPC_ansi) { + OPM_Write(')'); + OPC_AnsiParamList(typ->link, 0); + } else { + OPM_WriteString((CHAR*)")()", (LONGINT)4); + } + break; + } else if (comp == 2) { + OPM_Write('['); + OPM_WriteInt(typ->n); + OPM_Write(']'); + } + } else { + break; + } + typ = typ->BaseTyp; + } +} + +void OPC_Andent (OPT_Struct typ) +{ + if (typ->strobj == NIL || typ->align >= 65536) { + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + OPC_Str1((CHAR*)"__#", (LONGINT)4, __ASHR(typ->align, 16)); + } else { + OPC_Ident(typ->strobj); + } +} + +static BOOLEAN OPC_Undefined (OPT_Object obj) +{ + BOOLEAN _o_result; + _o_result = (((obj->mnolev >= 0 && obj->linkadr != (LONGINT)(3 + OPM_currFile))) && obj->linkadr != 2) || obj->name[0] == 0x00; + return _o_result; +} + +static void OPC_DeclareBase (OPT_Object dcl) +{ + OPT_Struct typ = NIL, prev = NIL; + OPT_Object obj = NIL; + INTEGER nofdims; + LONGINT off, n, dummy; + typ = dcl->typ; + prev = typ; + while ((((((((typ->strobj == NIL || typ->comp == 3) || OPC_Undefined(typ->strobj)) && typ->comp != 4)) && typ->form != 12)) && !((typ->form == 13 && typ->BaseTyp->comp == 3)))) { + prev = typ; + typ = typ->BaseTyp; + } + obj = typ->strobj; + if (typ->form == 12) { + OPM_WriteString((CHAR*)"void", (LONGINT)5); + } else if ((obj != NIL && !OPC_Undefined(obj))) { + OPC_Ident(obj); + } else if (typ->comp == 4) { + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPC_Andent(typ); + if ((prev->form != 13 && (obj != NIL || dcl->name[0] == 0x00))) { + if ((typ->BaseTyp != NIL && typ->BaseTyp->strobj->vis != 0)) { + OPM_WriteString((CHAR*)" { /* ", (LONGINT)7); + OPC_Ident(typ->BaseTyp->strobj); + OPM_WriteString((CHAR*)" */", (LONGINT)4); + OPM_WriteLn(); + OPC_Indent(1); + } else { + OPM_Write(' '); + OPC_BegBlk(); + } + OPC_FieldList(typ, 1, &off, &n, &dummy); + OPC_EndBlk0(); + } + } else if ((typ->form == 13 && typ->BaseTyp->comp == 3)) { + typ = typ->BaseTyp->BaseTyp; + nofdims = 1; + while (typ->comp == 3) { + nofdims += 1; + typ = typ->BaseTyp; + } + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPC_BegBlk(); + OPC_BegStat(); + OPC_Str1((CHAR*)"LONGINT len[#]", (LONGINT)15, nofdims); + OPC_EndStat(); + OPC_BegStat(); + __NEW(obj, OPT_ObjDesc); + __NEW(obj->typ, OPT_StrDesc); + obj->typ->form = 15; + obj->typ->comp = 2; + obj->typ->n = 1; + obj->typ->BaseTyp = typ; + obj->mode = 4; + __MOVE("data", obj->name, 5); + obj->linkadr = 0; + OPC_DeclareBase(obj); + OPM_Write(' '); + OPC_DeclareObj(obj, 0); + OPC_EndStat(); + OPC_EndBlk0(); + } +} + +LONGINT OPC_NofPtrs (OPT_Struct typ) +{ + LONGINT _o_result; + OPT_Object fld = NIL; + OPT_Struct btyp = NIL; + LONGINT n; + if ((typ->form == 13 && typ->sysflag == 0)) { + _o_result = 1; + return _o_result; + } else if ((typ->comp == 4 && __MASK(typ->sysflag, -256) == 0)) { + btyp = typ->BaseTyp; + if (btyp != NIL) { + n = OPC_NofPtrs(btyp); + } else { + n = 0; + } + fld = typ->link; + while ((fld != NIL && fld->mode == 4)) { + if (__STRCMP(fld->name, "@ptr") != 0) { + n = n + OPC_NofPtrs(fld->typ); + } else { + n += 1; + } + fld = fld->link; + } + _o_result = n; + return _o_result; + } else if (typ->comp == 2) { + btyp = typ->BaseTyp; + n = typ->n; + while (btyp->comp == 2) { + n = btyp->n * n; + btyp = btyp->BaseTyp; + } + _o_result = OPC_NofPtrs(btyp) * n; + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +static void OPC_PutPtrOffsets (OPT_Struct typ, LONGINT adr, LONGINT *cnt) +{ + OPT_Object fld = NIL; + OPT_Struct btyp = NIL; + LONGINT n, i; + if ((typ->form == 13 && typ->sysflag == 0)) { + OPM_WriteInt(adr); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + *cnt += 1; + if (__MASK(*cnt, -16) == 0) { + OPM_WriteLn(); + OPM_Write(0x09); + } + } else if ((typ->comp == 4 && __MASK(typ->sysflag, -256) == 0)) { + btyp = typ->BaseTyp; + if (btyp != NIL) { + OPC_PutPtrOffsets(btyp, adr, &*cnt); + } + fld = typ->link; + while ((fld != NIL && fld->mode == 4)) { + if (__STRCMP(fld->name, "@ptr") != 0) { + OPC_PutPtrOffsets(fld->typ, adr + fld->adr, &*cnt); + } else { + OPM_WriteInt(adr + fld->adr); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + *cnt += 1; + if (__MASK(*cnt, -16) == 0) { + OPM_WriteLn(); + OPM_Write(0x09); + } + } + fld = fld->link; + } + } else if (typ->comp == 2) { + btyp = typ->BaseTyp; + n = typ->n; + while (btyp->comp == 2) { + n = btyp->n * n; + btyp = btyp->BaseTyp; + } + if (OPC_NofPtrs(btyp) > 0) { + i = 0; + while (i < n) { + OPC_PutPtrOffsets(btyp, adr + i * btyp->size, &*cnt); + i += 1; + } + } + } +} + +static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj) +{ + if (obj != NIL) { + OPC_InitTProcs(typ, obj->left); + if (obj->mode == 13) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"__INITBP(", (LONGINT)10); + OPC_Ident(typ); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(obj); + OPC_Str1((CHAR*)", #)", (LONGINT)5, __ASHR(obj->adr, 16)); + OPC_EndStat(); + } + OPC_InitTProcs(typ, obj->right); + } +} + +static void OPC_PutBase (OPT_Struct typ) +{ + if (typ != NIL) { + OPC_PutBase(typ->BaseTyp); + OPC_Ident(typ->strobj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + } +} + +static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName) +{ + OPT_Struct typ = NIL; + INTEGER dim; + if (showParamName) { + OPC_Ident(par); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + } + dim = 1; + typ = par->typ->BaseTyp; + while (typ->comp == 3) { + if (ansiDefine) { + OPM_WriteString((CHAR*)", LONGINT ", (LONGINT)11); + } else { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + } + if (showParamName) { + OPC_Ident(par); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + OPM_WriteInt(dim); + } + typ = typ->BaseTyp; + dim += 1; + } +} + +static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro) +{ + OPM_Write('('); + while (par != NIL) { + if (macro) { + OPM_WriteStringVar((void*)par->name, ((LONGINT)(256))); + } else { + if ((par->mode == 1 && par->typ->form == 7)) { + OPM_Write('_'); + } + OPC_Ident(par); + } + if (par->typ->comp == 3) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_LenList(par, 0, 1); + } else if ((par->mode == 2 && par->typ->comp == 4)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteStringVar((void*)par->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } + par = par->link; + if (par != NIL) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + } + } + OPM_Write(')'); +} + +static void OPC_DefineTProcTypes (OPT_Object obj) +{ + OPT_Object par = NIL; + if (obj->typ != OPT_notyp) { + OPC_DefineType(obj->typ); + } + if (OPC_ansi) { + par = obj->link; + while (par != NIL) { + OPC_DefineType(par->typ); + par = par->link; + } + } +} + +static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty) +{ + if (obj != NIL) { + OPC_DeclareTProcs(obj->left, &*empty); + if (obj->mode == 13) { + if (obj->typ != OPT_notyp) { + OPC_DefineType(obj->typ); + } + if (OPM_currFile == 0) { + if (obj->vis == 1) { + OPC_DefineTProcTypes(obj); + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + *empty = 0; + OPC_ProcHeader(obj, 0); + } + } else { + *empty = 0; + OPC_DefineTProcTypes(obj); + if (obj->vis == 0) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + } + OPC_ProcHeader(obj, 0); + } + } + OPC_DeclareTProcs(obj->right, &*empty); + } +} + +OPT_Object OPC_BaseTProc (OPT_Object obj) +{ + OPT_Object _o_result; + OPT_Struct typ = NIL, base = NIL; + LONGINT mno; + typ = obj->link->typ; + if (typ->form == 13) { + typ = typ->BaseTyp; + } + base = typ->BaseTyp; + mno = __ASHR(obj->adr, 16); + while ((base != NIL && mno < base->n)) { + typ = base; + base = typ->BaseTyp; + } + OPT_FindField(obj->name, typ, &obj); + _o_result = obj; + return _o_result; +} + +static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty) +{ + if (obj != NIL) { + OPC_DefineTProcMacros(obj->left, &*empty); + if ((((obj->mode == 13 && obj == OPC_BaseTProc(obj))) && (OPM_currFile != 0 || obj->vis == 1))) { + OPM_WriteString((CHAR*)"#define __", (LONGINT)11); + OPC_Ident(obj); + OPC_DeclareParams(obj->link, 1); + OPM_WriteString((CHAR*)" __SEND(", (LONGINT)9); + if (obj->link->typ->form == 13) { + OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10); + OPC_Ident(obj->link); + OPM_Write(')'); + } else { + OPC_Ident(obj->link); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } + OPC_Str1((CHAR*)", #, ", (LONGINT)6, __ASHR(obj->adr, 16)); + if (obj->typ == OPT_notyp) { + OPM_WriteString((CHAR*)"void", (LONGINT)5); + } else { + OPC_Ident(obj->typ->strobj); + } + OPM_WriteString((CHAR*)"(*)", (LONGINT)4); + if (OPC_ansi) { + OPC_AnsiParamList(obj->link, 0); + } else { + OPM_WriteString((CHAR*)"()", (LONGINT)3); + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_DeclareParams(obj->link, 1); + OPM_Write(')'); + OPM_WriteLn(); + } + OPC_DefineTProcMacros(obj->right, &*empty); + } +} + +static void OPC_DefineType (OPT_Struct str) +{ + OPT_Object obj = NIL, field = NIL, par = NIL; + BOOLEAN empty; + if (OPM_currFile == 1 || str->ref < 255) { + obj = str->strobj; + if (obj == NIL || OPC_Undefined(obj)) { + if (obj != NIL) { + if (obj->linkadr == 1) { + if (str->form != 13) { + OPM_Mark(244, str->txtpos); + obj->linkadr = 2; + } + } else { + obj->linkadr = 1; + } + } + if (str->comp == 4) { + if (str->BaseTyp != NIL) { + OPC_DefineType(str->BaseTyp); + } + field = str->link; + while ((field != NIL && field->mode == 4)) { + if (field->vis != 0 || OPM_currFile == 1) { + OPC_DefineType(field->typ); + } + field = field->link; + } + } else if (str->form == 13) { + if (str->BaseTyp->comp != 4) { + OPC_DefineType(str->BaseTyp); + } + } else if (__IN(str->comp, 0x0c)) { + OPC_DefineType(str->BaseTyp); + } else if (str->form == 14) { + if (str->BaseTyp != OPT_notyp) { + OPC_DefineType(str->BaseTyp); + } + field = str->link; + while (field != NIL) { + OPC_DefineType(field->typ); + field = field->link; + } + } + } + if ((obj != NIL && OPC_Undefined(obj))) { + OPM_WriteString((CHAR*)"typedef", (LONGINT)8); + OPM_WriteLn(); + OPM_Write(0x09); + OPC_Indent(1); + obj->linkadr = 1; + OPC_DeclareBase(obj); + OPM_Write(' '); + obj->typ->strobj = NIL; + OPC_DeclareObj(obj, 0); + obj->typ->strobj = obj; + obj->linkadr = 3 + OPM_currFile; + OPC_EndStat(); + OPC_Indent(-1); + OPM_WriteLn(); + if (obj->typ->comp == 4) { + empty = 1; + OPC_DeclareTProcs(str->link, &empty); + OPC_DefineTProcMacros(str->link, &empty); + if (!empty) { + OPM_WriteLn(); + } + } + } + } +} + +static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len) +{ + BOOLEAN _o_result; + INTEGER i; + BOOLEAN r; + __DUP(y, y__len, CHAR); + i = 0; + while ((*x)[__X(i + 1, ((LONGINT)(256)))] == y[__X(i, y__len)]) { + i += 1; + } + r = y[__X(i, y__len)] == 0x00; + _o_result = r; + __DEL(y); + return _o_result; +} + +static void OPC_CProcDefs (OPT_Object obj, INTEGER vis) +{ + INTEGER i; + OPT_ConstExt ext = NIL; + INTEGER _for__9; + if (obj != NIL) { + OPC_CProcDefs(obj->left, vis); + if ((((obj->mode == 9 && (int)obj->vis >= vis)) && obj->adr == 1)) { + ext = obj->conval->ext; + i = 1; + if (((*ext)[1] != '#' && !(OPC_Prefixed(ext, (CHAR*)"extern ", (LONGINT)8) || OPC_Prefixed(ext, (CHAR*)"import ", (LONGINT)8)))) { + OPM_WriteString((CHAR*)"#define ", (LONGINT)9); + OPC_Ident(obj); + OPC_DeclareParams(obj->link, 1); + OPM_Write(0x09); + } + _for__9 = (int)(*obj->conval->ext)[0]; + i = i; + while (i <= _for__9) { + OPM_Write((*obj->conval->ext)[__X(i, ((LONGINT)(256)))]); + i += 1; + } + OPM_WriteLn(); + } + OPC_CProcDefs(obj->right, vis); + } +} + +void OPC_TypeDefs (OPT_Object obj, INTEGER vis) +{ + if (obj != NIL) { + OPC_TypeDefs(obj->left, vis); + if ((obj->mode == 5 && obj->typ->txtpos > 0)) { + OPC_DefineType(obj->typ); + } + OPC_TypeDefs(obj->right, vis); + } +} + +static void OPC_DefAnonRecs (OPT_Node n) +{ + OPT_Object o = NIL; + OPT_Struct typ = NIL; + while ((n != NIL && n->class == 14)) { + typ = n->typ; + if ((typ->strobj == NIL && (OPM_currFile == 1 || typ->ref < 255))) { + OPC_DefineType(typ); + __NEW(o, OPT_ObjDesc); + o->typ = typ; + o->name[0] = 0x00; + OPC_DeclareBase(o); + OPC_EndStat(); + OPM_WriteLn(); + } + n = n->link; + } +} + +void OPC_TDescDecl (OPT_Struct typ) +{ + LONGINT nofptrs; + OPT_Object o = NIL; + OPC_BegStat(); + OPM_WriteString((CHAR*)"__TDESC(", (LONGINT)9); + OPC_Andent(typ); + OPC_Str1((CHAR*)", #", (LONGINT)4, typ->n + 1); + OPC_Str1((CHAR*)", #) = {__TDFLDS(", (LONGINT)18, OPC_NofPtrs(typ)); + OPM_Write('\"'); + if (typ->strobj != NIL) { + OPM_WriteStringVar((void*)typ->strobj->name, ((LONGINT)(256))); + } + OPC_Str1((CHAR*)"\", #), {", (LONGINT)9, typ->size); + nofptrs = 0; + OPC_PutPtrOffsets(typ, ((LONGINT)(0)), &nofptrs); + OPC_Str1((CHAR*)"#}}", (LONGINT)4, -((nofptrs + 1) * (LONGINT)OPM_LIntSize)); + OPC_EndStat(); +} + +void OPC_InitTDesc (OPT_Struct typ) +{ + OPC_BegStat(); + OPM_WriteString((CHAR*)"__INITYP(", (LONGINT)10); + OPC_Andent(typ); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (typ->BaseTyp != NIL) { + OPC_Andent(typ->BaseTyp); + } else { + OPC_Andent(typ); + } + OPC_Str1((CHAR*)", #)", (LONGINT)5, typ->extlev); + OPC_EndStat(); + if (typ->strobj != NIL) { + OPC_InitTProcs(typ->strobj, typ->link); + } +} + +void OPC_Align (LONGINT *adr, LONGINT base) +{ + switch (base) { + case 2: + *adr += __MASK(*adr, -2); + break; + case 4: + *adr += __MASK(-*adr, -4); + break; + case 8: + *adr += __MASK(-*adr, -8); + break; + case 16: + *adr += __MASK(-*adr, -16); + break; + default: + break; + } +} + +LONGINT OPC_Base (OPT_Struct typ) +{ + LONGINT _o_result; + switch (typ->form) { + case 1: + _o_result = 1; + return _o_result; + break; + case 3: + _o_result = OPM_CharAlign; + return _o_result; + break; + case 2: + _o_result = OPM_BoolAlign; + return _o_result; + break; + case 4: + _o_result = OPM_SIntAlign; + return _o_result; + break; + case 5: + _o_result = OPM_IntAlign; + return _o_result; + break; + case 6: + _o_result = OPM_LIntAlign; + return _o_result; + break; + case 7: + _o_result = OPM_RealAlign; + return _o_result; + break; + case 8: + _o_result = OPM_LRealAlign; + return _o_result; + break; + case 9: + _o_result = OPM_SetAlign; + return _o_result; + break; + case 13: + _o_result = OPM_PointerAlign; + return _o_result; + break; + case 14: + _o_result = OPM_ProcAlign; + return _o_result; + break; + case 15: + if (typ->comp == 4) { + _o_result = __MASK(typ->align, -65536); + return _o_result; + } else { + _o_result = OPC_Base(typ->BaseTyp); + return _o_result; + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPC.Base, typ^form = ", (LONGINT)40); + OPM_LogWNum(typ->form, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + __RETCHK; +} + +static void OPC_FillGap (LONGINT gap, LONGINT off, LONGINT align, LONGINT *n, LONGINT *curAlign) +{ + LONGINT adr; + adr = off; + OPC_Align(&adr, align); + if ((*curAlign < align && gap - (adr - off) >= align)) { + gap -= (adr - off) + align; + OPC_BegStat(); + if (align == (LONGINT)OPM_IntSize) { + OPM_WriteString((CHAR*)"INTEGER", (LONGINT)8); + } else if (align == (LONGINT)OPM_LIntSize) { + OPM_WriteString((CHAR*)"LONGINT", (LONGINT)8); + } else if (align == (LONGINT)OPM_LRealSize) { + OPM_WriteString((CHAR*)"LONGREAL", (LONGINT)9); + } + OPC_Str1((CHAR*)" _prvt#", (LONGINT)8, *n); + *n += 1; + OPC_EndStat(); + *curAlign = align; + } + if (gap > 0) { + OPC_BegStat(); + OPC_Str1((CHAR*)"char _prvt#", (LONGINT)12, *n); + *n += 1; + OPC_Str1((CHAR*)"[#]", (LONGINT)4, gap); + OPC_EndStat(); + } +} + +static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, LONGINT *off, LONGINT *n, LONGINT *curAlign) +{ + OPT_Object fld = NIL; + OPT_Struct base = NIL; + LONGINT gap, adr, align, fldAlign; + fld = typ->link; + align = __MASK(typ->align, -65536); + if (typ->BaseTyp != NIL) { + OPC_FieldList(typ->BaseTyp, 0, &*off, &*n, &*curAlign); + } else { + *off = 0; + *n = 0; + *curAlign = 1; + } + while ((fld != NIL && fld->mode == 4)) { + if ((OPM_currFile == 0 && fld->vis == 0) || (((OPM_currFile == 1 && fld->vis == 0)) && typ->mno != 0)) { + fld = fld->link; + while ((((fld != NIL && fld->mode == 4)) && fld->vis == 0)) { + fld = fld->link; + } + } else { + adr = *off; + fldAlign = OPC_Base(fld->typ); + OPC_Align(&adr, fldAlign); + gap = fld->adr - adr; + if (fldAlign > *curAlign) { + *curAlign = fldAlign; + } + if (gap > 0) { + OPC_FillGap(gap, *off, align, &*n, &*curAlign); + } + OPC_BegStat(); + OPC_DeclareBase(fld); + OPM_Write(' '); + OPC_DeclareObj(fld, 0); + *off = fld->adr + fld->typ->size; + base = fld->typ; + fld = fld->link; + while ((((((((fld != NIL && fld->mode == 4)) && fld->typ == base)) && fld->adr == *off)) && ((OPM_currFile == 1 || fld->vis != 0) || fld->typ->strobj == NIL))) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_DeclareObj(fld, 0); + *off = fld->adr + fld->typ->size; + fld = fld->link; + } + OPC_EndStat(); + } + } + if (last) { + adr = typ->size - (LONGINT)__ASHR(typ->sysflag, 8); + if (adr == 0) { + gap = 1; + } else { + gap = adr - *off; + } + if (gap > 0) { + OPC_FillGap(gap, *off, align, &*n, &*curAlign); + } + } +} + +static void OPC_IdentList (OPT_Object obj, INTEGER vis) +{ + OPT_Struct base = NIL; + BOOLEAN first; + INTEGER lastvis; + base = NIL; + first = 1; + while ((obj != NIL && obj->mode != 13)) { + if ((__IN(vis, 0x05) || (vis == 1 && obj->vis != 0)) || (vis == 3 && !obj->leaf)) { + if (obj->typ != base || (int)obj->vis != lastvis) { + if (!first) { + OPC_EndStat(); + } + first = 0; + base = obj->typ; + lastvis = obj->vis; + OPC_BegStat(); + if ((vis == 1 && obj->vis != 0)) { + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + } else if ((obj->mnolev == 0 && vis == 0)) { + if (obj->vis == 0) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + } + } + if ((((vis == 2 && obj->mode == 1)) && base->form == 7)) { + OPM_WriteString((CHAR*)"double", (LONGINT)7); + } else { + OPC_DeclareBase(obj); + } + } else { + OPM_Write(','); + } + OPM_Write(' '); + if ((((vis == 2 && obj->mode == 1)) && base->form == 7)) { + OPM_Write('_'); + } + OPC_DeclareObj(obj, vis == 3); + if (obj->typ->comp == 3) { + OPC_EndStat(); + OPC_BegStat(); + base = OPT_linttyp; + OPM_WriteString((CHAR*)"LONGINT ", (LONGINT)9); + OPC_LenList(obj, 0, 1); + } else if ((obj->mode == 2 && obj->typ->comp == 4)) { + OPC_EndStat(); + OPC_BegStat(); + OPM_WriteString((CHAR*)"LONGINT *", (LONGINT)10); + OPC_Ident(obj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + base = NIL; + } else if ((((((OPC_ptrinit && vis == 0)) && obj->mnolev > 0)) && obj->typ->form == 13)) { + OPM_WriteString((CHAR*)" = NIL", (LONGINT)7); + } + } + obj = obj->link; + } + if (!first) { + OPC_EndStat(); + } +} + +static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames) +{ + CHAR name[32]; + OPM_Write('('); + if (obj == NIL || obj->mode == 13) { + OPM_WriteString((CHAR*)"void", (LONGINT)5); + } else { + for (;;) { + OPC_DeclareBase(obj); + if (showParamNames) { + OPM_Write(' '); + OPC_DeclareObj(obj, 0); + } else { + __COPY(obj->name, name, ((LONGINT)(32))); + obj->name[0] = 0x00; + OPC_DeclareObj(obj, 0); + __COPY(name, obj->name, ((LONGINT)(256))); + } + if (obj->typ->comp == 3) { + OPM_WriteString((CHAR*)", LONGINT ", (LONGINT)11); + OPC_LenList(obj, 1, showParamNames); + } else if ((obj->mode == 2 && obj->typ->comp == 4)) { + OPM_WriteString((CHAR*)", LONGINT *", (LONGINT)12); + if (showParamNames) { + OPC_Ident(obj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } + } + if (obj->link == NIL || obj->link->mode == 13) { + break; + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + obj = obj->link; + } + } + OPM_Write(')'); +} + +static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define) +{ + if (proc->typ == OPT_notyp) { + OPM_WriteString((CHAR*)"void", (LONGINT)5); + } else { + OPC_Ident(proc->typ->strobj); + } + OPM_Write(' '); + OPC_Ident(proc); + OPM_Write(' '); + if (OPC_ansi) { + OPC_AnsiParamList(proc->link, 1); + if (!define) { + OPM_Write(';'); + } + OPM_WriteLn(); + } else if (define) { + OPC_DeclareParams(proc->link, 0); + OPM_WriteLn(); + OPC_Indent(1); + OPC_IdentList(proc->link, 2); + OPC_Indent(-1); + } else { + OPM_WriteString((CHAR*)"();", (LONGINT)4); + OPM_WriteLn(); + } +} + +static void OPC_ProcPredefs (OPT_Object obj, SHORTINT vis) +{ + if (obj != NIL) { + OPC_ProcPredefs(obj->left, vis); + if ((((__IN(obj->mode, 0xc0) && obj->vis >= vis)) && (obj->history != 4 || obj->mode == 6))) { + if (vis == 1) { + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + } else if (obj->vis == 0) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + } + OPC_ProcHeader(obj, 0); + } + OPC_ProcPredefs(obj->right, vis); + } +} + +static void OPC_Include (CHAR *name, LONGINT name__len) +{ + __DUP(name, name__len, CHAR); + OPM_WriteString((CHAR*)"#include ", (LONGINT)10); + OPM_Write('\"'); + OPM_WriteStringVar((void*)name, name__len); + OPM_WriteString((CHAR*)".h", (LONGINT)3); + OPM_Write('\"'); + OPM_WriteLn(); + __DEL(name); +} + +static void OPC_IncludeImports (OPT_Object obj, INTEGER vis) +{ + if (obj != NIL) { + OPC_IncludeImports(obj->left, vis); + if ((((obj->mode == 11 && obj->mnolev != 0)) && (int)OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->vis >= vis)) { + OPC_Include(OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + } + OPC_IncludeImports(obj->right, vis); + } +} + +static void OPC_GenDynTypes (OPT_Node n, INTEGER vis) +{ + OPT_Struct typ = NIL; + while ((n != NIL && n->class == 14)) { + typ = n->typ; + if (vis == 0 || typ->ref < 255) { + OPC_BegStat(); + if (vis == 1) { + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + } else if ((typ->strobj != NIL && typ->strobj->mnolev > 0)) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + } + OPM_WriteString((CHAR*)"LONGINT *", (LONGINT)10); + OPC_Andent(typ); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPC_EndStat(); + } + n = n->link; + } +} + +void OPC_GenHdr (OPT_Node n) +{ + OPM_currFile = 0; + OPC_DefAnonRecs(n); + OPC_TypeDefs(OPT_topScope->right, 1); + OPM_WriteLn(); + OPC_IdentList(OPT_topScope->scope, 1); + OPM_WriteLn(); + OPC_GenDynTypes(n, 1); + OPM_WriteLn(); + OPC_ProcPredefs(OPT_topScope->right, 1); + OPM_WriteString((CHAR*)"import ", (LONGINT)8); + OPM_WriteString((CHAR*)"void *", (LONGINT)7); + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + OPM_WriteString(OPC_BodyNameExt, ((LONGINT)(13))); + OPC_EndStat(); + OPM_WriteLn(); + OPC_CProcDefs(OPT_topScope->right, 1); + OPM_WriteLn(); + OPM_WriteString((CHAR*)"#endif", (LONGINT)7); + OPM_WriteLn(); +} + +static void OPC_GenHeaderMsg (void) +{ + INTEGER i; + OPM_WriteString((CHAR*)"/*", (LONGINT)3); + OPM_WriteString((CHAR*)" voc ", (LONGINT)6); + OPM_Write(' '); + OPM_WriteString((CHAR*)"1.2 [2016/06/15] for gcc LP64 on cygwin", (LONGINT)40); + OPM_Write(' '); + i = 0; + while (i <= 63) { + if (__IN(i, OPM_glbopt)) { + switch (i) { + case 0: + OPM_Write('x'); + break; + case 2: + OPM_Write('r'); + break; + case 3: + OPM_Write('t'); + break; + case 4: + OPM_Write('s'); + break; + case 5: + OPM_Write('p'); + break; + case 6: + OPM_Write('k'); + break; + case 7: + OPM_Write('a'); + break; + case 9: + OPM_Write('e'); + break; + case 10: + OPM_Write('m'); + break; + case 13: + OPM_Write('S'); + break; + case 14: + OPM_Write('c'); + break; + case 15: + OPM_Write('M'); + break; + case 16: + OPM_Write('f'); + break; + case 17: + OPM_Write('F'); + break; + case 18: + OPM_Write('v'); + break; + default: + OPM_LogWStr((CHAR*)"( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg", (LONGINT)126); + OPM_LogWLn(); + break; + } + } + i += 1; + } + OPM_WriteString((CHAR*)" */", (LONGINT)4); + OPM_WriteLn(); +} + +void OPC_GenHdrIncludes (void) +{ + OPM_currFile = 2; + OPC_GenHeaderMsg(); + OPM_WriteLn(); + OPM_WriteString((CHAR*)"#ifndef ", (LONGINT)9); + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + OPM_WriteString((CHAR*)"__h", (LONGINT)4); + OPM_WriteLn(); + OPM_WriteString((CHAR*)"#define ", (LONGINT)9); + OPM_WriteStringVar((void*)OPM_modName, ((LONGINT)(32))); + OPM_WriteString((CHAR*)"__h", (LONGINT)4); + OPM_WriteLn(); + OPM_WriteLn(); + if (OPM_LIntSize == 8) { + OPM_WriteString((CHAR*)"#define LARGE", (LONGINT)14); + OPM_WriteLn(); + } + OPC_Include((CHAR*)"SYSTEM", (LONGINT)7); + OPC_IncludeImports(OPT_topScope->right, 1); + OPM_WriteLn(); +} + +void OPC_GenBdy (OPT_Node n) +{ + OPM_currFile = 1; + OPC_GenHeaderMsg(); + if (OPM_LIntSize == 8) { + OPM_WriteString((CHAR*)"#define LARGE", (LONGINT)14); + OPM_WriteLn(); + } + OPC_Include((CHAR*)"SYSTEM", (LONGINT)7); + OPC_IncludeImports(OPT_topScope->right, 0); + OPM_WriteLn(); + OPC_DefAnonRecs(n); + OPC_TypeDefs(OPT_topScope->right, 0); + OPM_WriteLn(); + OPC_IdentList(OPT_topScope->scope, 0); + OPM_WriteLn(); + OPC_GenDynTypes(n, 0); + OPM_WriteLn(); + OPC_ProcPredefs(OPT_topScope->right, 0); + OPM_WriteLn(); + OPC_CProcDefs(OPT_topScope->right, 0); + OPM_WriteLn(); +} + +static void OPC_RegCmds (OPT_Object obj) +{ + if (obj != NIL) { + OPC_RegCmds(obj->left); + if ((obj->mode == 7 && obj->history != 4)) { + if ((((obj->vis != 0 && obj->link == NIL)) && obj->typ == OPT_notyp)) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"__REGCMD(\"", (LONGINT)11); + OPM_WriteStringVar((void*)obj->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"\", ", (LONGINT)4); + OPC_Ident(obj); + OPM_Write(')'); + OPC_EndStat(); + } + } + OPC_RegCmds(obj->right); + } +} + +static void OPC_InitImports (OPT_Object obj) +{ + if (obj != NIL) { + OPC_InitImports(obj->left); + if ((obj->mode == 11 && obj->mnolev != 0)) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"__MODULE_IMPORT(", (LONGINT)17); + OPM_WriteStringVar((void*)OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + OPM_Write(')'); + OPC_EndStat(); + } + OPC_InitImports(obj->right); + } +} + +void OPC_GenEnumPtrs (OPT_Object var) +{ + OPT_Struct typ = NIL; + LONGINT n; + OPC_GlbPtrs = 0; + while (var != NIL) { + typ = var->typ; + if (OPC_NofPtrs(typ) > 0) { + if (!OPC_GlbPtrs) { + OPC_GlbPtrs = 1; + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + if (OPC_ansi) { + OPM_WriteString((CHAR*)"void EnumPtrs(void (*P)(void*))", (LONGINT)32); + } else { + OPM_WriteString((CHAR*)"void EnumPtrs(P)", (LONGINT)17); + OPM_WriteLn(); + OPM_Write(0x09); + OPM_WriteString((CHAR*)"void (*P)();", (LONGINT)13); + } + OPM_WriteLn(); + OPC_BegBlk(); + } + OPC_BegStat(); + if (typ->form == 13) { + OPM_WriteString((CHAR*)"P(", (LONGINT)3); + OPC_Ident(var); + OPM_Write(')'); + } else if (typ->comp == 4) { + OPM_WriteString((CHAR*)"__ENUMR(&", (LONGINT)10); + OPC_Ident(var); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(typ); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPC_Str1((CHAR*)", #", (LONGINT)4, typ->size); + OPM_WriteString((CHAR*)", 1, P)", (LONGINT)8); + } else if (typ->comp == 2) { + n = typ->n; + typ = typ->BaseTyp; + while (typ->comp == 2) { + n = n * typ->n; + typ = typ->BaseTyp; + } + if (typ->form == 13) { + OPM_WriteString((CHAR*)"__ENUMP(", (LONGINT)9); + OPC_Ident(var); + OPC_Str1((CHAR*)", #, P)", (LONGINT)8, n); + } else if (typ->comp == 4) { + OPM_WriteString((CHAR*)"__ENUMR(", (LONGINT)9); + OPC_Ident(var); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(typ); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPC_Str1((CHAR*)", #", (LONGINT)4, typ->size); + OPC_Str1((CHAR*)", #, P)", (LONGINT)8, n); + } + } + OPC_EndStat(); + } + var = var->link; + } + if (OPC_GlbPtrs) { + OPC_EndBlk(); + OPM_WriteLn(); + } +} + +void OPC_EnterBody (void) +{ + OPM_WriteLn(); + OPM_WriteString((CHAR*)"export ", (LONGINT)8); + if (OPC_mainprog) { + if (OPC_ansi) { + OPM_WriteString((CHAR*)"int main(int argc, char **argv)", (LONGINT)32); + OPM_WriteLn(); + } else { + OPM_WriteString((CHAR*)"main(argc, argv)", (LONGINT)17); + OPM_WriteLn(); + OPM_Write(0x09); + OPM_WriteString((CHAR*)"int argc; char **argv;", (LONGINT)23); + OPM_WriteLn(); + } + } else { + OPM_WriteString((CHAR*)"void *", (LONGINT)7); + OPM_WriteString(OPM_modName, ((LONGINT)(32))); + OPM_WriteString(OPC_BodyNameExt, ((LONGINT)(13))); + OPM_WriteLn(); + } + OPC_BegBlk(); + OPC_BegStat(); + if (OPC_mainprog) { + OPM_WriteString((CHAR*)"__INIT(argc, argv)", (LONGINT)19); + } else { + OPM_WriteString((CHAR*)"__DEFMOD", (LONGINT)9); + } + OPC_EndStat(); + if ((OPC_mainprog && 0)) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"/*don`t do it!*/ printf(\"DEMO VERSION: DO NOT USE THIS PROGRAM FOR ANY COMMERCIAL PURPOSE\\n\")", (LONGINT)94); + OPC_EndStat(); + } + OPC_InitImports(OPT_topScope->right); + OPC_BegStat(); + if (OPC_mainprog) { + OPM_WriteString((CHAR*)"__REGMAIN(\"", (LONGINT)12); + } else { + OPM_WriteString((CHAR*)"__REGMOD(\"", (LONGINT)11); + } + OPM_WriteString(OPM_modName, ((LONGINT)(32))); + if (OPC_GlbPtrs) { + OPM_WriteString((CHAR*)"\", EnumPtrs)", (LONGINT)13); + } else { + OPM_WriteString((CHAR*)"\", 0)", (LONGINT)6); + } + OPC_EndStat(); + if (__STRCMP(OPM_modName, "SYSTEM") != 0) { + OPC_RegCmds(OPT_topScope); + } +} + +void OPC_ExitBody (void) +{ + OPC_BegStat(); + if (OPC_mainprog) { + OPM_WriteString((CHAR*)"__FINI;", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ENDMOD;", (LONGINT)10); + } + OPM_WriteLn(); + OPC_EndBlk(); +} + +void OPC_DefineInter (OPT_Object proc) +{ + OPT_Object scope = NIL; + scope = proc->scope; + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_Write(' '); + OPC_BegBlk(); + OPC_IdentList(proc->link, 3); + OPC_IdentList(scope->scope, 3); + OPC_BegStat(); + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_Write(' '); + OPM_Write('*'); + OPM_WriteString((CHAR*)"lnk", (LONGINT)4); + OPC_EndStat(); + OPC_EndBlk0(); + OPM_Write(' '); + OPM_Write('*'); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPC_EndStat(); + OPM_WriteLn(); + OPC_ProcPredefs(scope->right, 0); + OPM_WriteLn(); +} + +void OPC_EnterProc (OPT_Object proc) +{ + OPT_Object var = NIL, scope = NIL; + OPT_Struct typ = NIL; + INTEGER dim; + if (proc->vis != 1) { + OPM_WriteString((CHAR*)"static ", (LONGINT)8); + } + OPC_ProcHeader(proc, 1); + OPC_BegBlk(); + if (proc->typ != OPT_notyp) { + OPC_BegStat(); + OPC_Ident(proc->typ->strobj); + OPM_WriteString((CHAR*)" _o_result;", (LONGINT)12); + OPM_WriteLn(); + } + scope = proc->scope; + OPC_IdentList(scope->scope, 0); + if (!scope->leaf) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"struct ", (LONGINT)8); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_Write(' '); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPC_EndStat(); + } + var = proc->link; + while (var != NIL) { + if ((var->typ->comp == 2 && var->mode == 1)) { + OPC_BegStat(); + if (var->typ->strobj == NIL) { + OPM_Mark(200, var->typ->txtpos); + } else { + OPC_Ident(var->typ->strobj); + } + OPM_Write(' '); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__copy", (LONGINT)7); + OPC_EndStat(); + } + var = var->link; + } + if (!OPC_ansi) { + var = proc->link; + while (var != NIL) { + if ((var->typ->form == 7 && var->mode == 1)) { + OPC_BegStat(); + OPC_Ident(var->typ->strobj); + OPM_Write(' '); + OPC_Ident(var); + OPM_WriteString((CHAR*)" = _", (LONGINT)5); + OPC_Ident(var); + OPC_EndStat(); + } + var = var->link; + } + } + var = proc->link; + while (var != NIL) { + if ((((__IN(var->typ->comp, 0x0c) && var->mode == 1)) && var->typ->sysflag == 0)) { + OPC_BegStat(); + if (var->typ->comp == 2) { + OPM_WriteString((CHAR*)"__DUPARR(", (LONGINT)10); + OPC_Ident(var); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (var->typ->strobj == NIL) { + OPM_Mark(200, var->typ->txtpos); + } else { + OPC_Ident(var->typ->strobj); + } + } else { + OPM_WriteString((CHAR*)"__DUP(", (LONGINT)7); + OPC_Ident(var); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + typ = var->typ->BaseTyp; + dim = 1; + while (typ->comp == 3) { + OPM_WriteString((CHAR*)" * ", (LONGINT)4); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + OPM_WriteInt(dim); + typ = typ->BaseTyp; + dim += 1; + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (typ->strobj == NIL) { + OPM_Mark(200, typ->txtpos); + } else { + OPC_Ident(typ->strobj); + } + } + OPM_Write(')'); + OPC_EndStat(); + } + var = var->link; + } + if (!scope->leaf) { + var = proc->link; + while (var != NIL) { + if (!var->leaf) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPC_Ident(var); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + if (__IN(var->typ->comp, 0x0c)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } else if (var->mode != 2) { + OPM_Write('&'); + } + OPC_Ident(var); + if (var->typ->comp == 3) { + typ = var->typ; + dim = 0; + do { + OPM_WriteString((CHAR*)"; ", (LONGINT)3); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + if (dim != 0) { + OPM_WriteInt(dim); + } + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + if (dim != 0) { + OPM_WriteInt(dim); + } + typ = typ->BaseTyp; + } while (!(typ->comp != 3)); + } else if ((var->mode == 2 && var->typ->comp == 4)) { + OPM_WriteString((CHAR*)"; ", (LONGINT)3); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPC_Ident(var); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } + OPC_EndStat(); + } + var = var->link; + } + var = scope->scope; + while (var != NIL) { + if (!var->leaf) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPC_Ident(var); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + if (var->typ->comp != 2) { + OPM_Write('&'); + } else { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } + OPC_Ident(var); + OPC_EndStat(); + } + var = var->link; + } + OPC_BegStat(); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPM_WriteString((CHAR*)"lnk", (LONGINT)4); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPC_EndStat(); + OPC_BegStat(); + OPM_WriteStringVar((void*)scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPM_Write('&'); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPC_EndStat(); + } +} + +void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet) +{ + OPT_Object var = NIL; + BOOLEAN indent; + indent = eoBlock; + if ((implicitRet && proc->typ != OPT_notyp)) { + OPM_Write(0x09); + OPM_WriteString((CHAR*)"__RETCHK;", (LONGINT)10); + OPM_WriteLn(); + } else if (!eoBlock || implicitRet) { + if (!proc->scope->leaf) { + if (indent) { + OPC_BegStat(); + } else { + indent = 1; + } + OPM_WriteStringVar((void*)proc->scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_Write('.'); + OPM_WriteString((CHAR*)"lnk", (LONGINT)4); + OPC_EndStat(); + } + var = proc->link; + while (var != NIL) { + if ((((var->typ->comp == 3 && var->mode == 1)) && var->typ->sysflag == 0)) { + if (indent) { + OPC_BegStat(); + } else { + indent = 1; + } + OPM_WriteString((CHAR*)"__DEL(", (LONGINT)7); + OPC_Ident(var); + OPM_Write(')'); + OPC_EndStat(); + } + var = var->link; + } + } + if (eoBlock) { + OPC_EndBlk(); + OPM_WriteLn(); + } else if (indent) { + OPC_BegStat(); + } +} + +void OPC_CompleteIdent (OPT_Object obj) +{ + INTEGER comp, level; + level = obj->mnolev; + if (obj->adr == 1) { + if (obj->typ->comp == 4) { + OPC_Ident(obj); + OPM_WriteString((CHAR*)"__", (LONGINT)3); + } else { + OPM_WriteString((CHAR*)"((", (LONGINT)3); + OPC_Ident(obj->typ->strobj); + OPM_Write(')'); + OPC_Ident(obj); + OPM_Write(')'); + } + } else if ((level != OPM_level && level > 0)) { + comp = obj->typ->comp; + if ((obj->mode != 2 && comp != 3)) { + OPM_Write('*'); + } + OPM_WriteStringVar((void*)obj->scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s", (LONGINT)3); + OPM_WriteString((CHAR*)"->", (LONGINT)3); + OPC_Ident(obj); + } else { + OPC_Ident(obj); + } +} + +void OPC_TypeOf (OPT_Object ap) +{ + INTEGER i; + __ASSERT(ap->typ->comp == 4, 0); + if (ap->mode == 2) { + if ((int)ap->mnolev != OPM_level) { + OPM_WriteStringVar((void*)ap->scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"_s->", (LONGINT)5); + OPC_Ident(ap); + } else { + OPC_Ident(ap); + } + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } else if (ap->typ->strobj != NIL) { + OPC_Ident(ap->typ->strobj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } else { + OPC_Andent(ap->typ); + } +} + +void OPC_Cmp (INTEGER rel) +{ + switch (rel) { + case 9: + OPM_WriteString((CHAR*)" == ", (LONGINT)5); + break; + case 10: + OPM_WriteString((CHAR*)" != ", (LONGINT)5); + break; + case 11: + OPM_WriteString((CHAR*)" < ", (LONGINT)4); + break; + case 12: + OPM_WriteString((CHAR*)" <= ", (LONGINT)5); + break; + case 13: + OPM_WriteString((CHAR*)" > ", (LONGINT)4); + break; + case 14: + OPM_WriteString((CHAR*)" >= ", (LONGINT)5); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPC.Cmp, rel = ", (LONGINT)34); + OPM_LogWNum(rel, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } +} + +void OPC_Case (LONGINT caseVal, INTEGER form) +{ + CHAR ch; + OPM_WriteString((CHAR*)"case ", (LONGINT)6); + switch (form) { + case 3: + ch = (CHAR)caseVal; + if ((ch >= ' ' && ch <= '~')) { + OPM_Write('\''); + if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') { + OPM_Write('\\'); + OPM_Write(ch); + } else { + OPM_Write(ch); + } + OPM_Write('\''); + } else { + OPM_WriteString((CHAR*)"0x", (LONGINT)3); + OPM_WriteHex(caseVal); + } + break; + case 4: case 5: case 6: + OPM_WriteInt(caseVal); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPC.Case, form = ", (LONGINT)36); + OPM_LogWNum(form, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + OPM_WriteString((CHAR*)": ", (LONGINT)3); +} + +void OPC_SetInclude (BOOLEAN exclude) +{ + if (exclude) { + OPM_WriteString((CHAR*)" &= ~", (LONGINT)6); + } else { + OPM_WriteString((CHAR*)" |= ", (LONGINT)5); + } +} + +void OPC_Increment (BOOLEAN decrement) +{ + if (decrement) { + OPM_WriteString((CHAR*)" -= ", (LONGINT)5); + } else { + OPM_WriteString((CHAR*)" += ", (LONGINT)5); + } +} + +void OPC_Halt (LONGINT n) +{ + OPC_Str1((CHAR*)"__HALT(#)", (LONGINT)10, n); +} + +void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim) +{ + if (array->comp == 3) { + OPC_CompleteIdent(obj); + OPM_WriteString((CHAR*)"__len", (LONGINT)6); + if (dim != 0) { + OPM_WriteInt(dim); + } + } else { + while (dim > 0) { + array = array->BaseTyp; + dim -= 1; + } + OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12); + OPM_WriteInt(array->n); + OPM_WriteString((CHAR*)"))", (LONGINT)3); + } +} + +void OPC_Constant (OPT_Const con, INTEGER form) +{ + INTEGER i, len; + CHAR ch; + SET s; + LONGINT hex; + BOOLEAN skipLeading; + switch (form) { + case 1: + OPM_WriteInt(con->intval); + break; + case 2: + OPM_WriteInt(con->intval); + break; + case 3: + ch = (CHAR)con->intval; + if ((ch >= ' ' && ch <= '~')) { + OPM_Write('\''); + if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') { + OPM_Write('\\'); + } + OPM_Write(ch); + OPM_Write('\''); + } else { + OPM_WriteString((CHAR*)"0x", (LONGINT)3); + OPM_WriteHex(con->intval); + } + break; + case 4: case 5: case 6: + OPM_WriteInt(con->intval); + break; + case 7: + OPM_WriteReal(con->realval, 'f'); + break; + case 8: + OPM_WriteReal(con->realval, 0x00); + break; + case 9: + OPM_WriteString((CHAR*)"0x", (LONGINT)3); + skipLeading = 1; + s = con->setval; + i = 64; + do { + hex = 0; + do { + i -= 1; + hex = __ASHL(hex, 1); + if (__IN(i, s)) { + hex += 1; + } + } while (!(__MASK(i, -8) == 0)); + if (hex != 0 || !skipLeading) { + OPM_WriteHex(hex); + skipLeading = 0; + } + } while (!(i == 0)); + if (skipLeading) { + OPM_Write('0'); + } + break; + case 10: + OPM_Write('\"'); + len = (int)con->intval2 - 1; + i = 0; + while (i < len) { + ch = (*con->ext)[__X(i, ((LONGINT)(256)))]; + if (((ch == '\\' || ch == '\?') || ch == '\'') || ch == '\"') { + OPM_Write('\\'); + } + OPM_Write(ch); + i += 1; + } + OPM_Write('\"'); + break; + case 11: + OPM_WriteString((CHAR*)"NIL", (LONGINT)4); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPC.Constant, form = ", (LONGINT)40); + OPM_LogWNum(form, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } +} + +static struct InitKeywords__47 { + SHORTINT *n; + struct InitKeywords__47 *lnk; +} *InitKeywords__47_s; + +static void Enter__48 (CHAR *s, LONGINT s__len); + +static void Enter__48 (CHAR *s, LONGINT s__len) +{ + INTEGER h; + __DUP(s, s__len, CHAR); + h = OPC_PerfectHash((void*)s, s__len); + OPC_hashtab[__X(h, ((LONGINT)(105)))] = *InitKeywords__47_s->n; + __COPY(s, OPC_keytab[__X(*InitKeywords__47_s->n, ((LONGINT)(36)))], ((LONGINT)(9))); + *InitKeywords__47_s->n += 1; + __DEL(s); +} + +static void OPC_InitKeywords (void) +{ + SHORTINT n, i; + struct InitKeywords__47 _s; + _s.n = &n; + _s.lnk = InitKeywords__47_s; + InitKeywords__47_s = &_s; + n = 0; + i = 0; + while (i <= 104) { + OPC_hashtab[__X(i, ((LONGINT)(105)))] = -1; + i += 1; + } + Enter__48((CHAR*)"asm", (LONGINT)4); + Enter__48((CHAR*)"auto", (LONGINT)5); + Enter__48((CHAR*)"break", (LONGINT)6); + Enter__48((CHAR*)"case", (LONGINT)5); + Enter__48((CHAR*)"char", (LONGINT)5); + Enter__48((CHAR*)"const", (LONGINT)6); + Enter__48((CHAR*)"continue", (LONGINT)9); + Enter__48((CHAR*)"default", (LONGINT)8); + Enter__48((CHAR*)"do", (LONGINT)3); + Enter__48((CHAR*)"double", (LONGINT)7); + Enter__48((CHAR*)"else", (LONGINT)5); + Enter__48((CHAR*)"enum", (LONGINT)5); + Enter__48((CHAR*)"extern", (LONGINT)7); + Enter__48((CHAR*)"export", (LONGINT)7); + Enter__48((CHAR*)"float", (LONGINT)6); + Enter__48((CHAR*)"for", (LONGINT)4); + Enter__48((CHAR*)"fortran", (LONGINT)8); + Enter__48((CHAR*)"goto", (LONGINT)5); + Enter__48((CHAR*)"if", (LONGINT)3); + Enter__48((CHAR*)"import", (LONGINT)7); + Enter__48((CHAR*)"int", (LONGINT)4); + Enter__48((CHAR*)"long", (LONGINT)5); + Enter__48((CHAR*)"register", (LONGINT)9); + Enter__48((CHAR*)"return", (LONGINT)7); + Enter__48((CHAR*)"short", (LONGINT)6); + Enter__48((CHAR*)"signed", (LONGINT)7); + Enter__48((CHAR*)"sizeof", (LONGINT)7); + Enter__48((CHAR*)"static", (LONGINT)7); + Enter__48((CHAR*)"struct", (LONGINT)7); + Enter__48((CHAR*)"switch", (LONGINT)7); + Enter__48((CHAR*)"typedef", (LONGINT)8); + Enter__48((CHAR*)"union", (LONGINT)6); + Enter__48((CHAR*)"unsigned", (LONGINT)9); + Enter__48((CHAR*)"void", (LONGINT)5); + Enter__48((CHAR*)"volatile", (LONGINT)9); + Enter__48((CHAR*)"while", (LONGINT)6); + InitKeywords__47_s = _s.lnk; +} + + +export void *OPC__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPT); + __REGMOD("OPC", 0); + __REGCMD("BegBlk", OPC_BegBlk); + __REGCMD("BegStat", OPC_BegStat); + __REGCMD("EndBlk", OPC_EndBlk); + __REGCMD("EndBlk0", OPC_EndBlk0); + __REGCMD("EndStat", OPC_EndStat); + __REGCMD("EnterBody", OPC_EnterBody); + __REGCMD("ExitBody", OPC_ExitBody); + __REGCMD("GenHdrIncludes", OPC_GenHdrIncludes); + __REGCMD("Init", OPC_Init); +/* BEGIN */ + OPC_InitKeywords(); + __ENDMOD; +} diff --git a/bootstrap/windows-88/OPC.h b/bootstrap/windows-88/OPC.h new file mode 100644 index 00000000..a91a3810 --- /dev/null +++ b/bootstrap/windows-88/OPC.h @@ -0,0 +1,50 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPC__h +#define OPC__h + +#define LARGE +#include "SYSTEM.h" +#include "OPT.h" + + + + +import void OPC_Align (LONGINT *adr, LONGINT base); +import void OPC_Andent (OPT_Struct typ); +import LONGINT OPC_Base (OPT_Struct typ); +import OPT_Object OPC_BaseTProc (OPT_Object obj); +import void OPC_BegBlk (void); +import void OPC_BegStat (void); +import void OPC_Case (LONGINT caseVal, INTEGER form); +import void OPC_Cmp (INTEGER rel); +import void OPC_CompleteIdent (OPT_Object obj); +import void OPC_Constant (OPT_Const con, INTEGER form); +import void OPC_DefineInter (OPT_Object proc); +import void OPC_EndBlk (void); +import void OPC_EndBlk0 (void); +import void OPC_EndStat (void); +import void OPC_EnterBody (void); +import void OPC_EnterProc (OPT_Object proc); +import void OPC_ExitBody (void); +import void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet); +import void OPC_GenBdy (OPT_Node n); +import void OPC_GenEnumPtrs (OPT_Object var); +import void OPC_GenHdr (OPT_Node n); +import void OPC_GenHdrIncludes (void); +import void OPC_Halt (LONGINT n); +import void OPC_Ident (OPT_Object obj); +import void OPC_Increment (BOOLEAN decrement); +import void OPC_Indent (INTEGER count); +import void OPC_Init (void); +import void OPC_InitTDesc (OPT_Struct typ); +import void OPC_Len (OPT_Object obj, OPT_Struct array, LONGINT dim); +import LONGINT OPC_NofPtrs (OPT_Struct typ); +import void OPC_SetInclude (BOOLEAN exclude); +import void OPC_TDescDecl (OPT_Struct typ); +import void OPC_TypeDefs (OPT_Object obj, INTEGER vis); +import void OPC_TypeOf (OPT_Object ap); +import void *OPC__init(void); + + +#endif diff --git a/bootstrap/windows-88/OPM.c b/bootstrap/windows-88/OPM.c new file mode 100644 index 00000000..798fb492 --- /dev/null +++ b/bootstrap/windows-88/OPM.c @@ -0,0 +1,1092 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "Configuration.h" +#include "Console.h" +#include "Files.h" +#include "Platform.h" +#include "Strings.h" +#include "Texts.h" +#include "errors.h" +#include "vt100.h" + +typedef + CHAR OPM_FileName[32]; + + +static CHAR OPM_SourceFileName[256]; +export INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_CharAlign, OPM_BoolAlign, OPM_SIntAlign, OPM_IntAlign, OPM_LIntAlign, OPM_SetAlign, OPM_RealAlign, OPM_LRealAlign, OPM_PointerAlign, OPM_ProcAlign, OPM_RecAlign, OPM_MaxSet; +export LONGINT OPM_MinSInt, OPM_MinInt, OPM_MinLInt, OPM_MaxSInt, OPM_MaxInt, OPM_MaxLInt, OPM_MaxIndex; +export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; +export BOOLEAN OPM_noerr; +export LONGINT OPM_curpos, OPM_errpos, OPM_breakpc; +export INTEGER OPM_currFile, OPM_level, OPM_pc, OPM_entno; +export CHAR OPM_modName[32]; +export CHAR OPM_objname[64]; +export SET OPM_opt, OPM_glbopt; +static LONGINT OPM_ErrorLineStartPos, OPM_ErrorLineLimitPos, OPM_ErrorLineNumber, OPM_lasterrpos; +static Texts_Reader OPM_inR; +static Texts_Text OPM_Log; +static Texts_Writer OPM_W; +static Files_Rider OPM_oldSF, OPM_newSF; +static Files_Rider OPM_R[3]; +static Files_File OPM_oldSFile, OPM_newSFile, OPM_HFile, OPM_BFile, OPM_HIFile; +static INTEGER OPM_S; +export BOOLEAN OPM_dontAsm, OPM_dontLink, OPM_mainProg, OPM_mainLinkStat, OPM_notColorOutput, OPM_forceNewSym, OPM_Verbose; +static CHAR OPM_OBERON[1024]; +static CHAR OPM_MODULES[1024]; + + +static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F); +export void OPM_CloseFiles (void); +export void OPM_CloseOldSym (void); +export void OPM_DeleteNewSym (void); +export void OPM_FPrint (LONGINT *fp, LONGINT val); +export void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr); +export void OPM_FPrintReal (LONGINT *fp, REAL real); +export void OPM_FPrintSet (LONGINT *fp, SET set); +static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT pos); +export void OPM_Get (CHAR *ch); +static void OPM_GetProperties (void); +static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align); +export void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len); +export void OPM_InitOptions (void); +static void OPM_LogErrMsg (INTEGER n); +export void OPM_LogW (CHAR ch); +export void OPM_LogWLn (void); +export void OPM_LogWNum (LONGINT i, LONGINT len); +export void OPM_LogWStr (CHAR *s, LONGINT s__len); +static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len); +export void OPM_Mark (INTEGER n, LONGINT pos); +static INTEGER OPM_Min (INTEGER a, INTEGER b); +export void OPM_NewSym (CHAR *modName, LONGINT modName__len); +export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done); +export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len); +export BOOLEAN OPM_OpenPar (void); +export void OPM_RegisterNewSym (void); +static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt); +static void OPM_ShowLine (LONGINT pos); +export void OPM_SymRCh (CHAR *ch); +export LONGINT OPM_SymRInt (void); +export void OPM_SymRLReal (LONGREAL *lr); +export void OPM_SymRReal (REAL *r); +export void OPM_SymRSet (SET *s); +export void OPM_SymWCh (CHAR ch); +export void OPM_SymWInt (LONGINT i); +export void OPM_SymWLReal (LONGREAL lr); +export void OPM_SymWReal (REAL r); +export void OPM_SymWSet (SET s); +static void OPM_VerboseListSizes (void); +export void OPM_Write (CHAR ch); +export void OPM_WriteHex (LONGINT i); +export void OPM_WriteInt (LONGINT i); +export void OPM_WriteLn (void); +export void OPM_WriteReal (LONGREAL r, CHAR suffx); +export void OPM_WriteString (CHAR *s, LONGINT s__len); +export void OPM_WriteStringVar (CHAR *s, LONGINT s__len); +export BOOLEAN OPM_eofSF (void); +export void OPM_err (INTEGER n); +static LONGINT OPM_minus (LONGINT i); +static LONGINT OPM_power0 (LONGINT i, LONGINT j); + + +void OPM_LogW (CHAR ch) +{ + Console_Char(ch); +} + +void OPM_LogWStr (CHAR *s, LONGINT s__len) +{ + __DUP(s, s__len, CHAR); + Console_String(s, s__len); + __DEL(s); +} + +void OPM_LogWNum (LONGINT i, LONGINT len) +{ + Console_Int(i, len); +} + +void OPM_LogWLn (void) +{ + Console_Ln(); +} + +static void OPM_ScanOptions (CHAR *s, LONGINT s__len, SET *opt) +{ + INTEGER i; + i = 1; + while (s[__X(i, s__len)] != 0x00) { + switch (s[__X(i, s__len)]) { + case 'e': + *opt = *opt ^ 0x0200; + break; + case 's': + *opt = *opt ^ 0x10; + break; + case 'm': + *opt = *opt ^ 0x0400; + break; + case 'x': + *opt = *opt ^ 0x01; + break; + case 'r': + *opt = *opt ^ 0x04; + break; + case 't': + *opt = *opt ^ 0x08; + break; + case 'a': + *opt = *opt ^ 0x80; + break; + case 'k': + *opt = *opt ^ 0x40; + break; + case 'p': + *opt = *opt ^ 0x20; + break; + case 'S': + *opt = *opt ^ 0x2000; + break; + case 'c': + *opt = *opt ^ 0x4000; + break; + case 'M': + *opt = *opt ^ 0x8000; + break; + case 'f': + *opt = *opt ^ 0x010000; + break; + case 'F': + *opt = *opt ^ 0x020000; + break; + case 'V': + *opt = *opt ^ 0x040000; + break; + case 'B': + if (s[__X(i + 1, s__len)] != 0x00) { + i += 1; + OPM_IntSize = (int)s[__X(i, s__len)] - 48; + } + if (s[__X(i + 1, s__len)] != 0x00) { + i += 1; + OPM_PointerSize = (int)s[__X(i, s__len)] - 48; + } + if (s[__X(i + 1, s__len)] != 0x00) { + i += 1; + OPM_Alignment = (int)s[__X(i, s__len)] - 48; + } + __ASSERT(OPM_IntSize == 2 || OPM_IntSize == 4, 0); + __ASSERT(OPM_PointerSize == 4 || OPM_PointerSize == 8, 0); + __ASSERT(OPM_Alignment == 4 || OPM_Alignment == 8, 0); + break; + default: + OPM_LogWStr((CHAR*)" warning: option ", (LONGINT)19); + OPM_LogW('-'); + OPM_LogW(s[__X(i, s__len)]); + OPM_LogWStr((CHAR*)" ignored", (LONGINT)9); + OPM_LogWLn(); + break; + } + i += 1; + } +} + +BOOLEAN OPM_OpenPar (void) +{ + BOOLEAN _o_result; + CHAR s[256]; + if (Platform_ArgCount == 1) { + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Vishap Oberon-2 compiler v", (LONGINT)27); + OPM_LogWStr((CHAR*)"1.2 [2016/06/15] for gcc LP64 on cygwin", (LONGINT)40); + OPM_LogW('.'); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Based on Ofront by Software Templ OEG, continued by Norayr Chilingarian and others.", (LONGINT)84); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Usage:", (LONGINT)7); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + OPM_LogWStr((CHAR*)"voc", (LONGINT)4); + OPM_LogWStr((CHAR*)" options {files {options}}.", (LONGINT)28); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Where options = [\"-\" {option} ].", (LONGINT)33); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" m - generate code for main module", (LONGINT)36); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" M - generate code for main module and link object statically", (LONGINT)63); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" s - generate new symbol file", (LONGINT)31); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" e - allow extending the module interface", (LONGINT)43); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" r - check value ranges", (LONGINT)25); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" x - turn off array indices check", (LONGINT)35); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" a - don\'t check ASSERTs at runtime, use this option in tested production code", (LONGINT)80); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" p - turn off automatic pointer initialization", (LONGINT)48); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" t - don\'t check type guards (use in rare cases such as low-level modules where every cycle counts)", (LONGINT)101); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" S - don\'t call external assembler/compiler, only generate C code", (LONGINT)67); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" c - don\'t call linker", (LONGINT)24); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" f - don\'t use color output", (LONGINT)29); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" F - force writing new symbol file in current directory", (LONGINT)57); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" V - verbose output", (LONGINT)21); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Initial options specify defaults for all files.", (LONGINT)48); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Options following a filename are specific to that file.", (LONGINT)56); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Repeating an option toggles its value.", (LONGINT)39); + OPM_LogWLn(); + _o_result = 0; + return _o_result; + } else { + OPM_S = 1; + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + OPM_glbopt = 0xe9; + while (s[0] == '-') { + OPM_ScanOptions((void*)s, ((LONGINT)(256)), &OPM_glbopt); + OPM_S += 1; + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + } + _o_result = 1; + return _o_result; + } + __RETCHK; +} + +void OPM_InitOptions (void) +{ + CHAR s[256]; + OPM_opt = OPM_glbopt; + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + while (s[0] == '-') { + OPM_ScanOptions((void*)s, ((LONGINT)(256)), &OPM_opt); + OPM_S += 1; + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + } + OPM_dontAsm = __IN(13, OPM_opt); + OPM_dontLink = __IN(14, OPM_opt); + OPM_mainProg = __IN(10, OPM_opt); + OPM_mainLinkStat = __IN(15, OPM_opt); + OPM_notColorOutput = __IN(16, OPM_opt); + OPM_forceNewSym = __IN(17, OPM_opt); + OPM_Verbose = __IN(18, OPM_opt); + if (OPM_mainLinkStat) { + OPM_glbopt |= __SETOF(10); + } + OPM_GetProperties(); +} + +void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len) +{ + Texts_Text T = NIL; + LONGINT beg, end, time; + CHAR s[256]; + *done = 0; + OPM_curpos = 0; + if (OPM_S >= Platform_ArgCount) { + return; + } + s[0] = 0x00; + Platform_GetArg(OPM_S, (void*)s, ((LONGINT)(256))); + __NEW(T, Texts_TextDesc); + Texts_Open(T, s, ((LONGINT)(256))); + OPM_LogWStr(s, ((LONGINT)(256))); + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + __COPY(s, mname, mname__len); + __COPY(s, OPM_SourceFileName, ((LONGINT)(256))); + if (T->len == 0) { + OPM_LogWStr(s, ((LONGINT)(256))); + OPM_LogWStr((CHAR*)" not found.", (LONGINT)12); + OPM_LogWLn(); + } else { + Texts_OpenReader(&OPM_inR, Texts_Reader__typ, T, ((LONGINT)(0))); + *done = 1; + } + OPM_S += 1; + OPM_level = 0; + OPM_noerr = 1; + OPM_errpos = OPM_curpos; + OPM_lasterrpos = OPM_curpos - 10; + OPM_ErrorLineStartPos = 0; + OPM_ErrorLineLimitPos = 0; + OPM_ErrorLineNumber = 0; +} + +void OPM_Get (CHAR *ch) +{ + Texts_Read(&OPM_inR, Texts_Reader__typ, &*ch); + if (*ch == 0x0d) { + OPM_curpos = Texts_Pos(&OPM_inR, Texts_Reader__typ); + } else { + OPM_curpos += 1; + } + if ((*ch < 0x09 && !OPM_inR.eot)) { + *ch = ' '; + } +} + +static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len) +{ + INTEGER i, j; + CHAR ch; + __DUP(ext, ext__len, CHAR); + i = 0; + for (;;) { + ch = name[__X(i, name__len)]; + if (ch == 0x00) { + break; + } + FName[__X(i, FName__len)] = ch; + i += 1; + } + j = 0; + do { + ch = ext[__X(j, ext__len)]; + FName[__X(i, FName__len)] = ch; + i += 1; + j += 1; + } while (!(ch == 0x00)); + __DEL(ext); +} + +static void OPM_LogErrMsg (INTEGER n) +{ + Texts_Scanner S; + Texts_Text T = NIL; + CHAR ch; + INTEGER i; + CHAR buf[1024]; + if (n >= 0) { + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"31m", (LONGINT)4); + } + OPM_LogWStr((CHAR*)" err ", (LONGINT)7); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + } else { + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"35m", (LONGINT)4); + } + OPM_LogWStr((CHAR*)" warning ", (LONGINT)11); + n = -n; + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + } + OPM_LogWNum(n, ((LONGINT)(1))); + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + OPM_LogWStr(errors_errors[__X(n, ((LONGINT)(350)))], ((LONGINT)(128))); +} + +static void OPM_FindLine (Files_File f, Files_Rider *r, LONGINT *r__typ, LONGINT pos) +{ + CHAR ch, cheol; + if (pos < OPM_ErrorLineStartPos) { + OPM_ErrorLineStartPos = 0; + OPM_ErrorLineLimitPos = 0; + OPM_ErrorLineNumber = 0; + } + if (pos < OPM_ErrorLineLimitPos) { + Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos); + return; + } + Files_Set(&*r, r__typ, f, OPM_ErrorLineLimitPos); + Files_Read(&*r, r__typ, (void*)&ch); + while ((OPM_ErrorLineLimitPos < pos && !(*r).eof)) { + OPM_ErrorLineStartPos = OPM_ErrorLineLimitPos; + OPM_ErrorLineNumber += 1; + while ((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) { + Files_Read(&*r, r__typ, (void*)&ch); + OPM_ErrorLineLimitPos += 1; + } + cheol = ch; + Files_Read(&*r, r__typ, (void*)&ch); + OPM_ErrorLineLimitPos += 1; + if ((cheol == 0x0d && ch == 0x0a)) { + OPM_ErrorLineLimitPos += 1; + Files_Read(&*r, r__typ, (void*)&ch); + } + } + Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos); +} + +static void OPM_ShowLine (LONGINT pos) +{ + Files_File f = NIL; + Files_Rider r; + CHAR line[1023]; + INTEGER i; + CHAR ch; + f = Files_Old(OPM_SourceFileName, ((LONGINT)(256))); + OPM_FindLine(f, &r, Files_Rider__typ, pos); + i = 0; + Files_Read(&r, Files_Rider__typ, (void*)&ch); + while ((((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) && i < 1022)) { + line[__X(i, ((LONGINT)(1023)))] = ch; + i += 1; + Files_Read(&r, Files_Rider__typ, (void*)&ch); + } + line[__X(i, ((LONGINT)(1023)))] = 0x00; + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWNum(OPM_ErrorLineNumber, ((LONGINT)(4))); + OPM_LogWStr((CHAR*)": ", (LONGINT)3); + OPM_LogWStr(line, ((LONGINT)(1023))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" ", (LONGINT)7); + if (pos >= OPM_ErrorLineLimitPos) { + pos = OPM_ErrorLineLimitPos - 1; + } + i = (int)(pos - OPM_ErrorLineStartPos); + while (i > 0) { + OPM_LogW(' '); + i -= 1; + } + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"32m", (LONGINT)4); + } + OPM_LogW('^'); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + Files_Close(f); +} + +void OPM_Mark (INTEGER n, LONGINT pos) +{ + if (pos == -1) { + pos = 0; + } + if (n >= 0) { + OPM_noerr = 0; + if (pos < OPM_lasterrpos || OPM_lasterrpos + 9 < pos) { + OPM_lasterrpos = pos; + OPM_ShowLine(pos); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + if (n < 249) { + OPM_LogWStr((CHAR*)" pos", (LONGINT)6); + OPM_LogWNum(pos, ((LONGINT)(6))); + OPM_LogErrMsg(n); + } else if (n == 255) { + OPM_LogWStr((CHAR*)"pos", (LONGINT)4); + OPM_LogWNum(pos, ((LONGINT)(6))); + OPM_LogWStr((CHAR*)" pc ", (LONGINT)6); + OPM_LogWNum(OPM_breakpc, ((LONGINT)(1))); + } else if (n == 254) { + OPM_LogWStr((CHAR*)"pc not found", (LONGINT)13); + } else { + OPM_LogWStr(OPM_objname, ((LONGINT)(64))); + if (n == 253) { + OPM_LogWStr((CHAR*)" is new, compile with option e", (LONGINT)31); + } else if (n == 252) { + OPM_LogWStr((CHAR*)" is redefined, compile with option s", (LONGINT)37); + } else if (n == 251) { + OPM_LogWStr((CHAR*)" is redefined (private part only), compile with option s", (LONGINT)57); + } else if (n == 250) { + OPM_LogWStr((CHAR*)" is no longer visible, compile with option s", (LONGINT)45); + } else if (n == 249) { + OPM_LogWStr((CHAR*)" is not consistently imported, recompile imports", (LONGINT)49); + } + } + } + } else { + if (pos >= 0) { + OPM_ShowLine(pos); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)" pos", (LONGINT)6); + OPM_LogWNum(pos, ((LONGINT)(6))); + } + OPM_LogErrMsg(n); + if (pos < 0) { + OPM_LogWLn(); + } + } +} + +void OPM_err (INTEGER n) +{ + OPM_Mark(n, OPM_errpos); +} + +void OPM_FPrint (LONGINT *fp, LONGINT val) +{ + *fp = __ROTL((LONGINT)((SET)*fp ^ (SET)val), 1, LONGINT); +} + +void OPM_FPrintSet (LONGINT *fp, SET set) +{ + OPM_FPrint(&*fp, (LONGINT)set); +} + +void OPM_FPrintReal (LONGINT *fp, REAL real) +{ + OPM_FPrint(&*fp, __VAL(LONGINT, real)); +} + +void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr) +{ + LONGINT l, h; + __GET((LONGINT)(uintptr_t)&lr, l, LONGINT); + __GET((LONGINT)(uintptr_t)&lr + 4, h, LONGINT); + OPM_FPrint(&*fp, l); + OPM_FPrint(&*fp, h); +} + +static void OPM_GetProperty (Texts_Scanner *S, LONGINT *S__typ, CHAR *name, LONGINT name__len, INTEGER *size, INTEGER *align) +{ + __DUP(name, name__len, CHAR); + if (((*S).class == 1 && __STRCMP((*S).s, name) == 0)) { + Texts_Scan(&*S, S__typ); + if ((*S).class == 3) { + *size = (int)(*S).i; + Texts_Scan(&*S, S__typ); + } else { + OPM_Mark(-157, ((LONGINT)(-1))); + } + if ((*S).class == 3) { + *align = (int)(*S).i; + Texts_Scan(&*S, S__typ); + } else { + OPM_Mark(-157, ((LONGINT)(-1))); + } + } else { + OPM_Mark(-157, ((LONGINT)(-1))); + } + __DEL(name); +} + +static LONGINT OPM_minus (LONGINT i) +{ + LONGINT _o_result; + _o_result = -i; + return _o_result; +} + +static LONGINT OPM_power0 (LONGINT i, LONGINT j) +{ + LONGINT _o_result; + LONGINT k, p; + k = 1; + p = i; + do { + p = p * i; + k += 1; + } while (!(k == j)); + _o_result = p; + return _o_result; +} + +static void OPM_VerboseListSizes (void) +{ + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Type Size Alignement", (LONGINT)29); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"CHAR ", (LONGINT)14); + OPM_LogWNum(OPM_CharSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_CharAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"BOOLEAN ", (LONGINT)14); + OPM_LogWNum(OPM_BoolSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_BoolAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"SHORTINT ", (LONGINT)14); + OPM_LogWNum(OPM_SIntSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_SIntAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"INTEGER ", (LONGINT)14); + OPM_LogWNum(OPM_IntSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_IntAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"LONGINT ", (LONGINT)14); + OPM_LogWNum(OPM_LIntSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_LIntAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"SET ", (LONGINT)14); + OPM_LogWNum(OPM_SetSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_SetAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"REAL ", (LONGINT)14); + OPM_LogWNum(OPM_RealSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_RealAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"LONGREAL ", (LONGINT)14); + OPM_LogWNum(OPM_LRealSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_LRealAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"PTR ", (LONGINT)14); + OPM_LogWNum(OPM_PointerSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_PointerAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"PROC ", (LONGINT)14); + OPM_LogWNum(OPM_ProcSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_ProcAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"RECORD ", (LONGINT)14); + OPM_LogWNum(OPM_RecSize, ((LONGINT)(4))); + OPM_LogWNum(OPM_RecAlign, ((LONGINT)(5))); + OPM_LogWLn(); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Min shortint ", (LONGINT)14); + OPM_LogWNum(OPM_MinSInt, ((LONGINT)(4))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Max shortint ", (LONGINT)14); + OPM_LogWNum(OPM_MaxSInt, ((LONGINT)(4))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Min integer ", (LONGINT)14); + OPM_LogWNum(OPM_MinInt, ((LONGINT)(4))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Max integer ", (LONGINT)14); + OPM_LogWNum(OPM_MaxInt, ((LONGINT)(4))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Min longint ", (LONGINT)14); + OPM_LogWNum(OPM_MinLInt, ((LONGINT)(4))); + OPM_LogWLn(); +} + +static INTEGER OPM_Min (INTEGER a, INTEGER b) +{ + INTEGER _o_result; + if (a < b) { + _o_result = a; + return _o_result; + } else { + _o_result = b; + return _o_result; + } + __RETCHK; +} + +static void OPM_GetProperties (void) +{ + LONGINT base; + OPM_ProcSize = OPM_PointerSize; + OPM_LIntSize = __ASHL(OPM_IntSize, 1); + OPM_SetSize = OPM_LIntSize; + OPM_CharAlign = OPM_Min(OPM_Alignment, OPM_CharSize); + OPM_BoolAlign = OPM_Min(OPM_Alignment, OPM_BoolSize); + OPM_SIntAlign = OPM_Min(OPM_Alignment, OPM_SIntSize); + OPM_RecAlign = OPM_Min(OPM_Alignment, OPM_RecSize); + OPM_RealAlign = OPM_Min(OPM_Alignment, OPM_RealSize); + OPM_LRealAlign = OPM_Min(OPM_Alignment, OPM_LRealSize); + OPM_PointerAlign = OPM_Min(OPM_Alignment, OPM_PointerSize); + OPM_ProcAlign = OPM_Min(OPM_Alignment, OPM_ProcSize); + OPM_IntAlign = OPM_Min(OPM_Alignment, OPM_IntSize); + OPM_LIntAlign = OPM_Min(OPM_Alignment, OPM_LIntSize); + OPM_SetAlign = OPM_Min(OPM_Alignment, OPM_SetSize); + base = -2; + OPM_MinSInt = __ASH(base, __ASHL(OPM_SIntSize, 3) - 2); + OPM_MaxSInt = OPM_minus(OPM_MinSInt + 1); + OPM_MinInt = __ASH(base, __ASHL(OPM_IntSize, 3) - 2); + OPM_MaxInt = OPM_minus(OPM_MinInt + 1); + OPM_MinLInt = __ASH(base, __ASHL(OPM_LIntSize, 3) - 2); + OPM_MaxLInt = OPM_minus(OPM_MinLInt + 1); + if (OPM_RealSize == 4) { + OPM_MaxReal = 3.40282346000000e+038; + } else if (OPM_RealSize == 8) { + OPM_MaxReal = 1.79769296342094e+308; + } + if (OPM_LRealSize == 4) { + OPM_MaxLReal = 3.40282346000000e+038; + } else if (OPM_LRealSize == 8) { + OPM_MaxLReal = 1.79769296342094e+308; + } + OPM_MinReal = -OPM_MaxReal; + OPM_MinLReal = -OPM_MaxLReal; + OPM_MaxSet = __ASHL(OPM_SetSize, 3) - 1; + OPM_MaxIndex = OPM_MaxLInt; + if (OPM_Verbose) { + OPM_VerboseListSizes(); + } +} + +void OPM_SymRCh (CHAR *ch) +{ + Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&*ch); +} + +LONGINT OPM_SymRInt (void) +{ + LONGINT _o_result; + LONGINT k; + Files_ReadNum(&OPM_oldSF, Files_Rider__typ, &k); + _o_result = k; + return _o_result; +} + +void OPM_SymRSet (SET *s) +{ + Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (LONGINT*)&*s); +} + +void OPM_SymRReal (REAL *r) +{ + Files_ReadReal(&OPM_oldSF, Files_Rider__typ, &*r); +} + +void OPM_SymRLReal (LONGREAL *lr) +{ + Files_ReadLReal(&OPM_oldSF, Files_Rider__typ, &*lr); +} + +void OPM_CloseOldSym (void) +{ +} + +void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done) +{ + CHAR ch; + OPM_FileName fileName; + OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5); + OPM_oldSFile = Files_Old(fileName, ((LONGINT)(32))); + *done = OPM_oldSFile != NIL; + if (*done) { + Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, ((LONGINT)(0))); + Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ch); + if (ch != 0xf7) { + OPM_err(-306); + OPM_CloseOldSym(); + *done = 0; + } + } +} + +BOOLEAN OPM_eofSF (void) +{ + BOOLEAN _o_result; + _o_result = OPM_oldSF.eof; + return _o_result; +} + +void OPM_SymWCh (CHAR ch) +{ + Files_Write(&OPM_newSF, Files_Rider__typ, ch); +} + +void OPM_SymWInt (LONGINT i) +{ + Files_WriteNum(&OPM_newSF, Files_Rider__typ, i); +} + +void OPM_SymWSet (SET s) +{ + Files_WriteNum(&OPM_newSF, Files_Rider__typ, (LONGINT)s); +} + +void OPM_SymWReal (REAL r) +{ + Files_WriteReal(&OPM_newSF, Files_Rider__typ, r); +} + +void OPM_SymWLReal (LONGREAL lr) +{ + Files_WriteLReal(&OPM_newSF, Files_Rider__typ, lr); +} + +void OPM_RegisterNewSym (void) +{ + if (__STRCMP(OPM_modName, "SYSTEM") != 0 || __IN(10, OPM_opt)) { + Files_Register(OPM_newSFile); + } +} + +void OPM_DeleteNewSym (void) +{ +} + +void OPM_NewSym (CHAR *modName, LONGINT modName__len) +{ + OPM_FileName fileName; + OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5); + OPM_newSFile = Files_New(fileName, ((LONGINT)(32))); + if (OPM_newSFile != NIL) { + Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, ((LONGINT)(0))); + Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7); + } else { + OPM_err(153); + } +} + +void OPM_Write (CHAR ch) +{ + Files_Write(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, ch); +} + +void OPM_WriteString (CHAR *s, LONGINT s__len) +{ + INTEGER i; + i = 0; + while (s[__X(i, s__len)] != 0x00) { + i += 1; + } + Files_WriteBytes(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, (void*)s, s__len * ((LONGINT)(1)), i); +} + +void OPM_WriteStringVar (CHAR *s, LONGINT s__len) +{ + INTEGER i; + i = 0; + while (s[__X(i, s__len)] != 0x00) { + i += 1; + } + Files_WriteBytes(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, (void*)s, s__len * ((LONGINT)(1)), i); +} + +void OPM_WriteHex (LONGINT i) +{ + CHAR s[3]; + INTEGER digit; + digit = __ASHR((int)i, 4); + if (digit < 10) { + s[0] = (CHAR)(48 + digit); + } else { + s[0] = (CHAR)(87 + digit); + } + digit = __MASK((int)i, -16); + if (digit < 10) { + s[1] = (CHAR)(48 + digit); + } else { + s[1] = (CHAR)(87 + digit); + } + s[2] = 0x00; + OPM_WriteString(s, ((LONGINT)(3))); +} + +void OPM_WriteInt (LONGINT i) +{ + CHAR s[20]; + LONGINT i1, k; + if (i == OPM_MinInt || i == OPM_MinLInt) { + OPM_Write('('); + OPM_WriteInt(i + 1); + OPM_WriteString((CHAR*)"-1)", (LONGINT)4); + } else { + i1 = __ABS(i); + s[0] = (CHAR)(__MOD(i1, 10) + 48); + i1 = __DIV(i1, 10); + k = 1; + while (i1 > 0) { + s[__X(k, ((LONGINT)(20)))] = (CHAR)(__MOD(i1, 10) + 48); + i1 = __DIV(i1, 10); + k += 1; + } + if (i < 0) { + s[__X(k, ((LONGINT)(20)))] = '-'; + k += 1; + } + while (k > 0) { + k -= 1; + OPM_Write(s[__X(k, ((LONGINT)(20)))]); + } + } +} + +void OPM_WriteReal (LONGREAL r, CHAR suffx) +{ + Texts_Writer W; + Texts_Text T = NIL; + Texts_Reader R; + CHAR s[32]; + CHAR ch; + INTEGER i; + if ((((r < OPM_MaxLInt && r > OPM_MinLInt)) && r == (__ENTIER(r)))) { + if (suffx == 'f') { + OPM_WriteString((CHAR*)"(REAL)", (LONGINT)7); + } else { + OPM_WriteString((CHAR*)"(LONGREAL)", (LONGINT)11); + } + OPM_WriteInt(__ENTIER(r)); + } else { + Texts_OpenWriter(&W, Texts_Writer__typ); + if (suffx == 'f') { + Texts_WriteLongReal(&W, Texts_Writer__typ, r, 16); + } else { + Texts_WriteLongReal(&W, Texts_Writer__typ, r, 23); + } + __NEW(T, Texts_TextDesc); + Texts_Open(T, (CHAR*)"", (LONGINT)1); + Texts_Append(T, W.buf); + Texts_OpenReader(&R, Texts_Reader__typ, T, ((LONGINT)(0))); + i = 0; + Texts_Read(&R, Texts_Reader__typ, &ch); + while (ch != 0x00) { + s[__X(i, ((LONGINT)(32)))] = ch; + i += 1; + Texts_Read(&R, Texts_Reader__typ, &ch); + } + s[__X(i, ((LONGINT)(32)))] = 0x00; + i = 0; + ch = s[0]; + while ((ch != 'D' && ch != 0x00)) { + i += 1; + ch = s[__X(i, ((LONGINT)(32)))]; + } + if (ch == 'D') { + s[__X(i, ((LONGINT)(32)))] = 'e'; + } + OPM_WriteString(s, ((LONGINT)(32))); + } +} + +void OPM_WriteLn (void) +{ + Files_Write(&OPM_R[__X(OPM_currFile, ((LONGINT)(3)))], Files_Rider__typ, 0x0a); +} + +static void OPM_Append (Files_Rider *R, LONGINT *R__typ, Files_File F) +{ + Files_Rider R1; + CHAR buffer[4096]; + if (F != NIL) { + Files_Set(&R1, Files_Rider__typ, F, ((LONGINT)(0))); + Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, ((LONGINT)(4096)), ((LONGINT)(4096))); + while (4096 - R1.res > 0) { + Files_WriteBytes(&*R, R__typ, (void*)buffer, ((LONGINT)(4096)), 4096 - R1.res); + Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, ((LONGINT)(4096)), ((LONGINT)(4096))); + } + } +} + +void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len) +{ + CHAR FName[32]; + __COPY(moduleName, OPM_modName, ((LONGINT)(32))); + OPM_HFile = Files_New((CHAR*)"", (LONGINT)1); + if (OPM_HFile != NIL) { + Files_Set(&OPM_R[0], Files_Rider__typ, OPM_HFile, ((LONGINT)(0))); + } else { + OPM_err(153); + } + OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, ((LONGINT)(32)), (CHAR*)".c", (LONGINT)3); + OPM_BFile = Files_New(FName, ((LONGINT)(32))); + if (OPM_BFile != NIL) { + Files_Set(&OPM_R[1], Files_Rider__typ, OPM_BFile, ((LONGINT)(0))); + } else { + OPM_err(153); + } + OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, ((LONGINT)(32)), (CHAR*)".h", (LONGINT)3); + OPM_HIFile = Files_New(FName, ((LONGINT)(32))); + if (OPM_HIFile != NIL) { + Files_Set(&OPM_R[2], Files_Rider__typ, OPM_HIFile, ((LONGINT)(0))); + } else { + OPM_err(153); + } +} + +void OPM_CloseFiles (void) +{ + CHAR FName[32]; + INTEGER res; + if (OPM_noerr) { + OPM_LogWStr((CHAR*)" ", (LONGINT)3); + OPM_LogWNum(Files_Pos(&OPM_R[1], Files_Rider__typ), ((LONGINT)(0))); + OPM_LogWStr((CHAR*)" chars.", (LONGINT)8); + } + if (OPM_noerr) { + if (__STRCMP(OPM_modName, "SYSTEM") == 0) { + if (!__IN(10, OPM_opt)) { + Files_Register(OPM_BFile); + } + } else if (!__IN(10, OPM_opt)) { + OPM_Append(&OPM_R[2], Files_Rider__typ, OPM_HFile); + Files_Register(OPM_HIFile); + Files_Register(OPM_BFile); + } else { + OPM_MakeFileName((void*)OPM_modName, ((LONGINT)(32)), (void*)FName, ((LONGINT)(32)), (CHAR*)".h", (LONGINT)3); + Files_Delete(FName, ((LONGINT)(32)), &res); + OPM_MakeFileName((void*)OPM_modName, ((LONGINT)(32)), (void*)FName, ((LONGINT)(32)), (CHAR*)".sym", (LONGINT)5); + Files_Delete(FName, ((LONGINT)(32)), &res); + Files_Register(OPM_BFile); + } + } + OPM_HFile = NIL; + OPM_BFile = NIL; + OPM_HIFile = NIL; + OPM_newSFile = NIL; + OPM_oldSFile = NIL; + Files_Set(&OPM_R[0], Files_Rider__typ, NIL, ((LONGINT)(0))); + Files_Set(&OPM_R[1], Files_Rider__typ, NIL, ((LONGINT)(0))); + Files_Set(&OPM_R[2], Files_Rider__typ, NIL, ((LONGINT)(0))); + Files_Set(&OPM_newSF, Files_Rider__typ, NIL, ((LONGINT)(0))); + Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, ((LONGINT)(0))); +} + +static void EnumPtrs(void (*P)(void*)) +{ + __ENUMR(&OPM_inR, Texts_Reader__typ, 96, 1, P); + P(OPM_Log); + __ENUMR(&OPM_W, Texts_Writer__typ, 72, 1, P); + __ENUMR(&OPM_oldSF, Files_Rider__typ, 40, 1, P); + __ENUMR(&OPM_newSF, Files_Rider__typ, 40, 1, P); + __ENUMR(OPM_R, Files_Rider__typ, 40, 3, P); + P(OPM_oldSFile); + P(OPM_newSFile); + P(OPM_HFile); + P(OPM_BFile); + P(OPM_HIFile); +} + + +export void *OPM__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Console); + __MODULE_IMPORT(Files); + __MODULE_IMPORT(Platform); + __MODULE_IMPORT(Strings); + __MODULE_IMPORT(Texts); + __MODULE_IMPORT(errors); + __MODULE_IMPORT(vt100); + __REGMOD("OPM", EnumPtrs); + __REGCMD("CloseFiles", OPM_CloseFiles); + __REGCMD("CloseOldSym", OPM_CloseOldSym); + __REGCMD("DeleteNewSym", OPM_DeleteNewSym); + __REGCMD("InitOptions", OPM_InitOptions); + __REGCMD("LogWLn", OPM_LogWLn); + __REGCMD("RegisterNewSym", OPM_RegisterNewSym); + __REGCMD("WriteLn", OPM_WriteLn); +/* BEGIN */ + Texts_OpenWriter(&OPM_W, Texts_Writer__typ); + OPM_MODULES[0] = 0x00; + Platform_GetEnv((CHAR*)"MODULES", (LONGINT)8, (void*)OPM_MODULES, ((LONGINT)(1024))); + __MOVE(".", OPM_OBERON, 2); + Platform_GetEnv((CHAR*)"OBERON", (LONGINT)7, (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append((CHAR*)";.;", (LONGINT)4, (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append(OPM_MODULES, ((LONGINT)(1024)), (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append((CHAR*)";", (LONGINT)2, (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)OPM_OBERON, ((LONGINT)(1024))); + Strings_Append((CHAR*)"/sym;", (LONGINT)6, (void*)OPM_OBERON, ((LONGINT)(1024))); + Files_SetSearchPath(OPM_OBERON, ((LONGINT)(1024))); + OPM_CharSize = 1; + OPM_BoolSize = 1; + OPM_SIntSize = 1; + OPM_RecSize = 1; + OPM_ByteSize = 1; + OPM_RealSize = 4; + OPM_LRealSize = 8; + OPM_PointerSize = 8; + OPM_Alignment = 8; + OPM_IntSize = 4; + __ENDMOD; +} diff --git a/bootstrap/windows-88/OPM.h b/bootstrap/windows-88/OPM.h new file mode 100644 index 00000000..e09dbf82 --- /dev/null +++ b/bootstrap/windows-88/OPM.h @@ -0,0 +1,64 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPM__h +#define OPM__h + +#define LARGE +#include "SYSTEM.h" + + +import INTEGER OPM_Alignment, OPM_ByteSize, OPM_CharSize, OPM_BoolSize, OPM_SIntSize, OPM_IntSize, OPM_LIntSize, OPM_SetSize, OPM_RealSize, OPM_LRealSize, OPM_PointerSize, OPM_ProcSize, OPM_RecSize, OPM_CharAlign, OPM_BoolAlign, OPM_SIntAlign, OPM_IntAlign, OPM_LIntAlign, OPM_SetAlign, OPM_RealAlign, OPM_LRealAlign, OPM_PointerAlign, OPM_ProcAlign, OPM_RecAlign, OPM_MaxSet; +import LONGINT OPM_MinSInt, OPM_MinInt, OPM_MinLInt, OPM_MaxSInt, OPM_MaxInt, OPM_MaxLInt, OPM_MaxIndex; +import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; +import BOOLEAN OPM_noerr; +import LONGINT OPM_curpos, OPM_errpos, OPM_breakpc; +import INTEGER OPM_currFile, OPM_level, OPM_pc, OPM_entno; +import CHAR OPM_modName[32]; +import CHAR OPM_objname[64]; +import SET OPM_opt, OPM_glbopt; +import BOOLEAN OPM_dontAsm, OPM_dontLink, OPM_mainProg, OPM_mainLinkStat, OPM_notColorOutput, OPM_forceNewSym, OPM_Verbose; + + +import void OPM_CloseFiles (void); +import void OPM_CloseOldSym (void); +import void OPM_DeleteNewSym (void); +import void OPM_FPrint (LONGINT *fp, LONGINT val); +import void OPM_FPrintLReal (LONGINT *fp, LONGREAL lr); +import void OPM_FPrintReal (LONGINT *fp, REAL real); +import void OPM_FPrintSet (LONGINT *fp, SET set); +import void OPM_Get (CHAR *ch); +import void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len); +import void OPM_InitOptions (void); +import void OPM_LogW (CHAR ch); +import void OPM_LogWLn (void); +import void OPM_LogWNum (LONGINT i, LONGINT len); +import void OPM_LogWStr (CHAR *s, LONGINT s__len); +import void OPM_Mark (INTEGER n, LONGINT pos); +import void OPM_NewSym (CHAR *modName, LONGINT modName__len); +import void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done); +import void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len); +import BOOLEAN OPM_OpenPar (void); +import void OPM_RegisterNewSym (void); +import void OPM_SymRCh (CHAR *ch); +import LONGINT OPM_SymRInt (void); +import void OPM_SymRLReal (LONGREAL *lr); +import void OPM_SymRReal (REAL *r); +import void OPM_SymRSet (SET *s); +import void OPM_SymWCh (CHAR ch); +import void OPM_SymWInt (LONGINT i); +import void OPM_SymWLReal (LONGREAL lr); +import void OPM_SymWReal (REAL r); +import void OPM_SymWSet (SET s); +import void OPM_Write (CHAR ch); +import void OPM_WriteHex (LONGINT i); +import void OPM_WriteInt (LONGINT i); +import void OPM_WriteLn (void); +import void OPM_WriteReal (LONGREAL r, CHAR suffx); +import void OPM_WriteString (CHAR *s, LONGINT s__len); +import void OPM_WriteStringVar (CHAR *s, LONGINT s__len); +import BOOLEAN OPM_eofSF (void); +import void OPM_err (INTEGER n); +import void *OPM__init(void); + + +#endif diff --git a/bootstrap/windows-88/OPP.c b/bootstrap/windows-88/OPP.c new file mode 100644 index 00000000..3bc74ce6 --- /dev/null +++ b/bootstrap/windows-88/OPP.c @@ -0,0 +1,1874 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "OPB.h" +#include "OPM.h" +#include "OPS.h" +#include "OPT.h" + +struct OPP__1 { + LONGINT low, high; +}; + +typedef + struct OPP__1 OPP_CaseTable[128]; + + +static SHORTINT OPP_sym, OPP_level; +static INTEGER OPP_LoopLevel; +static OPT_Node OPP_TDinit, OPP_lastTDinit; +static INTEGER OPP_nofFwdPtr; +static OPT_Struct OPP_FwdPtr[64]; + +export LONGINT *OPP__1__typ; + +static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar); +static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned); +static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq); +static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab); +static void OPP_CheckMark (SHORTINT *vis); +static void OPP_CheckSym (INTEGER s); +static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_); +static void OPP_ConstExpression (OPT_Node *x); +static void OPP_Element (OPT_Node *x); +static void OPP_Expression (OPT_Node *x); +static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b); +static void OPP_Factor (OPT_Node *x); +static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp); +export void OPP_Module (OPT_Node *prog, SET opt); +static void OPP_PointerType (OPT_Struct *typ); +static void OPP_ProcedureDeclaration (OPT_Node *x); +static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec); +static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned); +static void OPP_Sets (OPT_Node *x); +static void OPP_SimpleExpression (OPT_Node *x); +static void OPP_StandProcCall (OPT_Node *x); +static void OPP_StatSeq (OPT_Node *stat); +static void OPP_Term (OPT_Node *x); +static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned); +static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned); +static void OPP_err (INTEGER n); +static void OPP_qualident (OPT_Object *id); +static void OPP_selector (OPT_Node *x); + + +static void OPP_err (INTEGER n) +{ + OPM_err(n); +} + +static void OPP_CheckSym (INTEGER s) +{ + if ((int)OPP_sym == s) { + OPS_Get(&OPP_sym); + } else { + OPM_err(s); + } +} + +static void OPP_qualident (OPT_Object *id) +{ + OPT_Object obj = NIL; + SHORTINT lev; + OPT_Find(&obj); + OPS_Get(&OPP_sym); + if ((((OPP_sym == 18 && obj != NIL)) && obj->mode == 11)) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPT_FindImport(obj, &obj); + OPS_Get(&OPP_sym); + } else { + OPP_err(38); + obj = NIL; + } + } + if (obj == NIL) { + OPP_err(0); + obj = OPT_NewObj(); + obj->mode = 1; + obj->typ = OPT_undftyp; + obj->adr = 0; + } else { + lev = obj->mnolev; + if ((__IN(obj->mode, 0x06) && lev != OPP_level)) { + obj->leaf = 0; + if (lev > 0) { + OPB_StaticLink(OPP_level - lev); + } + } + } + *id = obj; +} + +static void OPP_ConstExpression (OPT_Node *x) +{ + OPP_Expression(&*x); + if ((*x)->class != 7) { + OPP_err(50); + *x = OPB_NewIntConst(((LONGINT)(1))); + } +} + +static void OPP_CheckMark (SHORTINT *vis) +{ + OPS_Get(&OPP_sym); + if (OPP_sym == 1 || OPP_sym == 7) { + if (OPP_level > 0) { + OPP_err(47); + } + if (OPP_sym == 1) { + *vis = 1; + } else { + *vis = 2; + } + OPS_Get(&OPP_sym); + } else { + *vis = 0; + } +} + +static void OPP_CheckSysFlag (INTEGER *sysflag, INTEGER default_) +{ + OPT_Node x = NIL; + LONGINT sf; + if (OPP_sym == 31) { + OPS_Get(&OPP_sym); + if (!OPT_SYSimported) { + OPP_err(135); + } + OPP_ConstExpression(&x); + if (__IN(x->typ->form, 0x70)) { + sf = x->conval->intval; + if (sf < 0 || sf > 1) { + OPP_err(220); + sf = 0; + } + } else { + OPP_err(51); + sf = 0; + } + *sysflag = (int)sf; + OPP_CheckSym(23); + } else { + *sysflag = default_; + } +} + +static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned) +{ + OPT_Object fld = NIL, first = NIL, last = NIL, base = NIL; + OPT_Struct ftyp = NIL; + INTEGER sysflag; + *typ = OPT_NewStr(15, 4); + (*typ)->BaseTyp = NIL; + OPP_CheckSysFlag(&sysflag, -1); + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPP_qualident(&base); + if ((base->mode == 5 && base->typ->comp == 4)) { + if (base->typ == *banned) { + OPP_err(58); + } else { + base->typ->pvused = 1; + (*typ)->BaseTyp = base->typ; + (*typ)->extlev = base->typ->extlev + 1; + (*typ)->sysflag = base->typ->sysflag; + } + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + OPP_CheckSym(22); + } + if (sysflag >= 0) { + (*typ)->sysflag = sysflag; + } + OPT_OpenScope(0, NIL); + first = NIL; + last = NIL; + for (;;) { + if (OPP_sym == 38) { + for (;;) { + if (OPP_sym == 38) { + if ((*typ)->BaseTyp != NIL) { + OPT_FindField(OPS_name, (*typ)->BaseTyp, &fld); + if (fld != NIL) { + OPP_err(1); + } + } + OPT_Insert(OPS_name, &fld); + OPP_CheckMark(&fld->vis); + fld->mode = 4; + fld->link = NIL; + fld->typ = OPT_undftyp; + if (first == NIL) { + first = fld; + } + if (last == NIL) { + (*typ)->link = fld; + } else { + last->link = fld; + } + last = fld; + } else { + OPP_err(38); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(19); + } else { + break; + } + } + OPP_CheckSym(20); + OPP_Type(&ftyp, &*banned); + ftyp->pvused = 1; + if (ftyp->comp == 3) { + ftyp = OPT_undftyp; + OPP_err(88); + } + while (first != NIL) { + first->typ = ftyp; + first = first->link; + } + } + if (OPP_sym == 39) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(39); + } else { + break; + } + } + OPT_CloseScope(); +} + +static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned) +{ + OPT_Node x = NIL; + LONGINT n; + INTEGER sysflag; + OPP_CheckSysFlag(&sysflag, 0); + if (OPP_sym == 25) { + *typ = OPT_NewStr(15, 3); + (*typ)->mno = 0; + (*typ)->sysflag = sysflag; + OPS_Get(&OPP_sym); + OPP_Type(&(*typ)->BaseTyp, &*banned); + (*typ)->BaseTyp->pvused = 1; + if ((*typ)->BaseTyp->comp == 3) { + (*typ)->n = (*typ)->BaseTyp->n + 1; + } else { + (*typ)->n = 0; + } + } else { + *typ = OPT_NewStr(15, 2); + (*typ)->sysflag = sysflag; + OPP_ConstExpression(&x); + if (__IN(x->typ->form, 0x70)) { + n = x->conval->intval; + if (n <= 0 || n > OPM_MaxIndex) { + OPP_err(63); + n = 1; + } + } else { + OPP_err(51); + n = 1; + } + (*typ)->n = n; + if (OPP_sym == 25) { + OPS_Get(&OPP_sym); + OPP_Type(&(*typ)->BaseTyp, &*banned); + (*typ)->BaseTyp->pvused = 1; + } else if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + if (OPP_sym != 25) { + OPP_ArrayType(&(*typ)->BaseTyp, &*banned); + } + } else { + OPP_err(35); + } + if ((*typ)->BaseTyp->comp == 3) { + (*typ)->BaseTyp = OPT_undftyp; + OPP_err(88); + } + } +} + +static void OPP_PointerType (OPT_Struct *typ) +{ + OPT_Object id = NIL; + *typ = OPT_NewStr(13, 1); + OPP_CheckSysFlag(&(*typ)->sysflag, 0); + OPP_CheckSym(28); + if (OPP_sym == 38) { + OPT_Find(&id); + if (id == NIL) { + if (OPP_nofFwdPtr < 64) { + OPP_FwdPtr[__X(OPP_nofFwdPtr, ((LONGINT)(64)))] = *typ; + OPP_nofFwdPtr += 1; + } else { + OPP_err(224); + } + (*typ)->link = OPT_NewObj(); + __COPY(OPS_name, (*typ)->link->name, ((LONGINT)(256))); + (*typ)->BaseTyp = OPT_undftyp; + OPS_Get(&OPP_sym); + } else { + OPP_qualident(&id); + if (id->mode == 5) { + if (__IN(id->typ->comp, 0x1c)) { + (*typ)->BaseTyp = id->typ; + } else { + (*typ)->BaseTyp = OPT_undftyp; + OPP_err(57); + } + } else { + (*typ)->BaseTyp = OPT_undftyp; + OPP_err(52); + } + } + } else { + OPP_Type(&(*typ)->BaseTyp, &OPT_notyp); + if (!__IN((*typ)->BaseTyp->comp, 0x1c)) { + (*typ)->BaseTyp = OPT_undftyp; + OPP_err(57); + } + } +} + +static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp) +{ + SHORTINT mode; + OPT_Object par = NIL, first = NIL, last = NIL, res = NIL; + OPT_Struct typ = NIL; + first = NIL; + last = *firstPar; + if (OPP_sym == 38 || OPP_sym == 60) { + for (;;) { + if (OPP_sym == 60) { + OPS_Get(&OPP_sym); + mode = 2; + } else { + mode = 1; + } + for (;;) { + if (OPP_sym == 38) { + OPT_Insert(OPS_name, &par); + OPS_Get(&OPP_sym); + par->mode = mode; + par->link = NIL; + if (first == NIL) { + first = par; + } + if (*firstPar == NIL) { + *firstPar = par; + } else { + last->link = par; + } + last = par; + } else { + OPP_err(38); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(19); + } else if (OPP_sym == 60) { + OPP_err(19); + OPS_Get(&OPP_sym); + } else { + break; + } + } + OPP_CheckSym(20); + OPP_Type(&typ, &OPT_notyp); + if (mode == 1) { + typ->pvused = 1; + } + while (first != NIL) { + first->typ = typ; + first = first->link; + } + if (OPP_sym == 39) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(39); + } else { + break; + } + } + } + OPP_CheckSym(22); + if (OPP_sym == 20) { + OPS_Get(&OPP_sym); + *resTyp = OPT_undftyp; + if (OPP_sym == 38) { + OPP_qualident(&res); + if (res->mode == 5) { + if (res->typ->form < 15) { + *resTyp = res->typ; + } else { + OPP_err(54); + } + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + } else { + *resTyp = OPT_notyp; + } +} + +static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned) +{ + OPT_Object id = NIL; + *typ = OPT_undftyp; + if (OPP_sym < 30) { + OPP_err(12); + do { + OPS_Get(&OPP_sym); + } while (!(OPP_sym >= 30)); + } + if (OPP_sym == 38) { + OPP_qualident(&id); + if (id->mode == 5) { + if (id->typ != *banned) { + *typ = id->typ; + } else { + OPP_err(58); + } + } else { + OPP_err(52); + } + } else if (OPP_sym == 54) { + OPS_Get(&OPP_sym); + OPP_ArrayType(&*typ, &*banned); + } else if (OPP_sym == 55) { + OPS_Get(&OPP_sym); + OPP_RecordType(&*typ, &*banned); + OPB_Inittd(&OPP_TDinit, &OPP_lastTDinit, *typ); + OPP_CheckSym(41); + } else if (OPP_sym == 56) { + OPS_Get(&OPP_sym); + OPP_PointerType(&*typ); + } else if (OPP_sym == 61) { + OPS_Get(&OPP_sym); + *typ = OPT_NewStr(14, 1); + OPP_CheckSysFlag(&(*typ)->sysflag, 0); + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPT_OpenScope(OPP_level, NIL); + OPP_FormalParameters(&(*typ)->link, &(*typ)->BaseTyp); + OPT_CloseScope(); + } else { + (*typ)->BaseTyp = OPT_notyp; + (*typ)->link = NIL; + } + } else { + OPP_err(12); + } + for (;;) { + if (((OPP_sym >= 39 && OPP_sym <= 42) || OPP_sym == 22) || OPP_sym == 64) { + break; + } + OPP_err(15); + if (OPP_sym == 38) { + break; + } + OPS_Get(&OPP_sym); + } +} + +static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned) +{ + OPP_TypeDecl(&*typ, &*banned); + if (((((*typ)->form == 13 && (*typ)->BaseTyp == OPT_undftyp)) && (*typ)->strobj == NIL)) { + OPP_err(0); + } +} + +static void OPP_selector (OPT_Node *x) +{ + OPT_Object obj = NIL, proc = NIL; + OPT_Node y = NIL; + OPT_Struct typ = NIL; + OPS_Name name; + for (;;) { + if (OPP_sym == 31) { + OPS_Get(&OPP_sym); + for (;;) { + if (((*x)->typ != NIL && (*x)->typ->form == 13)) { + OPB_DeRef(&*x); + } + OPP_Expression(&y); + OPB_Index(&*x, y); + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else { + break; + } + } + OPP_CheckSym(23); + } else if (OPP_sym == 18) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + __COPY(OPS_name, name, ((LONGINT)(256))); + OPS_Get(&OPP_sym); + if ((*x)->typ != NIL) { + if ((*x)->typ->form == 13) { + OPB_DeRef(&*x); + } + if ((*x)->typ->comp == 4) { + OPT_FindField(name, (*x)->typ, &obj); + OPB_Field(&*x, obj); + if ((obj != NIL && obj->mode == 13)) { + if (OPP_sym == 17) { + OPS_Get(&OPP_sym); + y = (*x)->left; + if (y->class == 3) { + y = y->left; + } + if (y->obj != NIL) { + proc = OPT_topScope; + while ((proc->link != NIL && proc->link->mode != 13)) { + proc = proc->left; + } + if (proc->link == NIL || proc->link->link != y->obj) { + OPP_err(75); + } + typ = y->obj->typ; + if (typ->form == 13) { + typ = typ->BaseTyp; + } + OPT_FindField((*x)->obj->name, typ->BaseTyp, &proc); + if (proc != NIL) { + (*x)->subcl = 1; + } else { + OPP_err(74); + } + } else { + OPP_err(75); + } + } + if ((obj->typ != OPT_notyp && OPP_sym != 30)) { + OPP_err(30); + } + } + } else { + OPP_err(53); + } + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + } else if (OPP_sym == 17) { + OPS_Get(&OPP_sym); + OPB_DeRef(&*x); + } else if ((((((OPP_sym == 30 && (*x)->class < 7)) && (*x)->typ->form != 14)) && ((*x)->obj == NIL || (*x)->obj->mode != 13))) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPP_qualident(&obj); + if (obj->mode == 5) { + OPB_TypTest(&*x, obj, 1); + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + OPP_CheckSym(22); + } else { + break; + } + } +} + +static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar) +{ + OPT_Node apar = NIL, last = NIL; + *aparlist = NIL; + last = NIL; + if (OPP_sym != 22) { + for (;;) { + OPP_Expression(&apar); + if (fpar != NIL) { + OPB_Param(apar, fpar); + OPB_Link(&*aparlist, &last, apar); + fpar = fpar->link; + } else { + OPP_err(64); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if ((30 <= OPP_sym && OPP_sym <= 38)) { + OPP_err(19); + } else { + break; + } + } + } + if (fpar != NIL) { + OPP_err(65); + } +} + +static void OPP_StandProcCall (OPT_Node *x) +{ + OPT_Node y = NIL; + SHORTINT m; + INTEGER n; + m = (int)(*x)->obj->adr; + n = 0; + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + if (OPP_sym != 22) { + for (;;) { + if (n == 0) { + OPP_Expression(&*x); + OPB_StPar0(&*x, m); + n = 1; + } else if (n == 1) { + OPP_Expression(&y); + OPB_StPar1(&*x, y, m); + n = 2; + } else { + OPP_Expression(&y); + OPB_StParN(&*x, y, m, n); + n += 1; + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if ((30 <= OPP_sym && OPP_sym <= 38)) { + OPP_err(19); + } else { + break; + } + } + OPP_CheckSym(22); + } else { + OPS_Get(&OPP_sym); + } + OPB_StFct(&*x, m, n); + } else { + OPP_err(30); + } + if ((OPP_level > 0 && (m == 1 || m == 30))) { + OPT_topScope->link->leaf = 0; + } +} + +static void OPP_Element (OPT_Node *x) +{ + OPT_Node y = NIL; + OPP_Expression(&*x); + if (OPP_sym == 21) { + OPS_Get(&OPP_sym); + OPP_Expression(&y); + OPB_SetRange(&*x, y); + } else { + OPB_SetElem(&*x); + } +} + +static void OPP_Sets (OPT_Node *x) +{ + OPT_Node y = NIL; + if (OPP_sym != 24) { + OPP_Element(&*x); + for (;;) { + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if ((30 <= OPP_sym && OPP_sym <= 38)) { + OPP_err(19); + } else { + break; + } + OPP_Element(&y); + OPB_Op(6, &*x, y); + } + } else { + *x = OPB_EmptySet(); + } + OPP_CheckSym(24); +} + +static void OPP_Factor (OPT_Node *x) +{ + OPT_Object fpar = NIL, id = NIL; + OPT_Node apar = NIL; + if (OPP_sym < 30) { + OPP_err(13); + do { + OPS_Get(&OPP_sym); + } while (!(OPP_sym >= 30)); + } + if (OPP_sym == 38) { + OPP_qualident(&id); + *x = OPB_NewLeaf(id); + OPP_selector(&*x); + if (((*x)->class == 9 && (*x)->obj->mode == 8)) { + OPP_StandProcCall(&*x); + } else if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPB_PrepCall(&*x, &fpar); + OPP_ActualParameters(&apar, fpar); + OPB_Call(&*x, apar, fpar); + OPP_CheckSym(22); + if (OPP_level > 0) { + OPT_topScope->link->leaf = 0; + } + } + } else if (OPP_sym == 35) { + switch (OPS_numtyp) { + case 1: + *x = OPB_NewIntConst(OPS_intval); + (*x)->typ = OPT_chartyp; + break; + case 2: + *x = OPB_NewIntConst(OPS_intval); + break; + case 3: + *x = OPB_NewRealConst(OPS_realval, OPT_realtyp); + break; + case 4: + *x = OPB_NewRealConst(OPS_lrlval, OPT_lrltyp); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPP.Factor, OPS.numtyp = ", (LONGINT)44); + OPM_LogWNum(OPS_numtyp, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + OPS_Get(&OPP_sym); + } else if (OPP_sym == 37) { + *x = OPB_NewString(OPS_str, OPS_intval); + OPS_Get(&OPP_sym); + } else if (OPP_sym == 36) { + *x = OPB_Nil(); + OPS_Get(&OPP_sym); + } else if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPP_Expression(&*x); + OPP_CheckSym(22); + } else if (OPP_sym == 31) { + OPS_Get(&OPP_sym); + OPP_err(30); + OPP_Expression(&*x); + OPP_CheckSym(22); + } else if (OPP_sym == 32) { + OPS_Get(&OPP_sym); + OPP_Sets(&*x); + } else if (OPP_sym == 33) { + OPS_Get(&OPP_sym); + OPP_Factor(&*x); + OPB_MOp(33, &*x); + } else { + OPP_err(13); + OPS_Get(&OPP_sym); + *x = NIL; + } + if (*x == NIL) { + *x = OPB_NewIntConst(((LONGINT)(1))); + (*x)->typ = OPT_undftyp; + } +} + +static void OPP_Term (OPT_Node *x) +{ + OPT_Node y = NIL; + SHORTINT mulop; + OPP_Factor(&*x); + while ((1 <= OPP_sym && OPP_sym <= 5)) { + mulop = OPP_sym; + OPS_Get(&OPP_sym); + OPP_Factor(&y); + OPB_Op(mulop, &*x, y); + } +} + +static void OPP_SimpleExpression (OPT_Node *x) +{ + OPT_Node y = NIL; + SHORTINT addop; + if (OPP_sym == 7) { + OPS_Get(&OPP_sym); + OPP_Term(&*x); + OPB_MOp(7, &*x); + } else if (OPP_sym == 6) { + OPS_Get(&OPP_sym); + OPP_Term(&*x); + OPB_MOp(6, &*x); + } else { + OPP_Term(&*x); + } + while ((6 <= OPP_sym && OPP_sym <= 8)) { + addop = OPP_sym; + OPS_Get(&OPP_sym); + OPP_Term(&y); + OPB_Op(addop, &*x, y); + } +} + +static void OPP_Expression (OPT_Node *x) +{ + OPT_Node y = NIL; + OPT_Object obj = NIL; + SHORTINT relation; + OPP_SimpleExpression(&*x); + if ((9 <= OPP_sym && OPP_sym <= 14)) { + relation = OPP_sym; + OPS_Get(&OPP_sym); + OPP_SimpleExpression(&y); + OPB_Op(relation, &*x, y); + } else if (OPP_sym == 15) { + OPS_Get(&OPP_sym); + OPP_SimpleExpression(&y); + OPB_In(&*x, y); + } else if (OPP_sym == 16) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPP_qualident(&obj); + if (obj->mode == 5) { + OPB_TypTest(&*x, obj, 0); + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + } +} + +static void OPP_Receiver (SHORTINT *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec) +{ + OPT_Object obj = NIL; + *typ = OPT_undftyp; + *rec = NIL; + if (OPP_sym == 60) { + OPS_Get(&OPP_sym); + *mode = 2; + } else { + *mode = 1; + } + __COPY(OPS_name, name, ((LONGINT)(256))); + OPP_CheckSym(38); + OPP_CheckSym(20); + if (OPP_sym == 38) { + OPT_Find(&obj); + OPS_Get(&OPP_sym); + if (obj == NIL) { + OPP_err(0); + } else if (obj->mode != 5) { + OPP_err(72); + } else { + *typ = obj->typ; + *rec = *typ; + if ((*rec)->form == 13) { + *rec = (*rec)->BaseTyp; + } + if (!((((*mode == 1 && (*typ)->form == 13)) && (*rec)->comp == 4) || (*mode == 2 && (*typ)->comp == 4))) { + OPP_err(70); + *rec = NIL; + } + if ((*rec != NIL && (*rec)->mno != OPP_level)) { + OPP_err(72); + *rec = NIL; + } + } + } else { + OPP_err(38); + } + OPP_CheckSym(22); + if (*rec == NIL) { + *rec = OPT_NewStr(15, 4); + (*rec)->BaseTyp = NIL; + } +} + +static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b) +{ + BOOLEAN _o_result; + if ((b->form == 13 && x->form == 13)) { + b = b->BaseTyp; + x = x->BaseTyp; + } + if ((b->comp == 4 && x->comp == 4)) { + do { + x = x->BaseTyp; + } while (!(x == NIL || x == b)); + } + _o_result = x == b; + return _o_result; +} + +static struct ProcedureDeclaration__16 { + OPT_Node *x; + OPT_Object *proc, *fwd; + OPS_Name *name; + SHORTINT *mode, *vis; + BOOLEAN *forward; + struct ProcedureDeclaration__16 *lnk; +} *ProcedureDeclaration__16_s; + +static void Body__17 (void); +static void GetCode__19 (void); +static void GetParams__21 (void); +static void TProcDecl__23 (void); + +static void GetCode__19 (void) +{ + OPT_ConstExt ext = NIL; + INTEGER n; + LONGINT c; + ext = OPT_NewExt(); + (*ProcedureDeclaration__16_s->proc)->conval->ext = ext; + n = 0; + if (OPP_sym == 37) { + while (OPS_str[__X(n, ((LONGINT)(256)))] != 0x00) { + (*ext)[__X(n + 1, ((LONGINT)(256)))] = OPS_str[__X(n, ((LONGINT)(256)))]; + n += 1; + } + (*ext)[0] = (CHAR)n; + OPS_Get(&OPP_sym); + } else { + for (;;) { + if (OPP_sym == 35) { + c = OPS_intval; + n += 1; + if ((c < 0 || c > 255) || n == 256) { + OPP_err(64); + c = 1; + n = 1; + } + OPS_Get(&OPP_sym); + (*ext)[__X(n, ((LONGINT)(256)))] = (CHAR)c; + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 35) { + OPP_err(19); + } else { + (*ext)[0] = (CHAR)n; + break; + } + } + } + (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1); +} + +static void GetParams__21 (void) +{ + (*ProcedureDeclaration__16_s->proc)->vis = *ProcedureDeclaration__16_s->vis; + (*ProcedureDeclaration__16_s->proc)->mode = *ProcedureDeclaration__16_s->mode; + (*ProcedureDeclaration__16_s->proc)->typ = OPT_notyp; + (*ProcedureDeclaration__16_s->proc)->conval = OPT_NewConst(); + (*ProcedureDeclaration__16_s->proc)->conval->setval = 0x0; + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPP_FormalParameters(&(*ProcedureDeclaration__16_s->proc)->link, &(*ProcedureDeclaration__16_s->proc)->typ); + } + if (*ProcedureDeclaration__16_s->fwd != NIL) { + OPB_CheckParameters((*ProcedureDeclaration__16_s->proc)->link, (*ProcedureDeclaration__16_s->fwd)->link, 1); + if ((*ProcedureDeclaration__16_s->proc)->typ != (*ProcedureDeclaration__16_s->fwd)->typ) { + OPP_err(117); + } + *ProcedureDeclaration__16_s->proc = *ProcedureDeclaration__16_s->fwd; + OPT_topScope = (*ProcedureDeclaration__16_s->proc)->scope; + if (*ProcedureDeclaration__16_s->mode == 10) { + (*ProcedureDeclaration__16_s->proc)->mode = 10; + } + } +} + +static void Body__17 (void) +{ + OPT_Node procdec = NIL, statseq = NIL; + LONGINT c; + c = OPM_errpos; + (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1); + OPP_CheckSym(39); + OPP_Block(&procdec, &statseq); + OPB_Enter(&procdec, statseq, *ProcedureDeclaration__16_s->proc); + *ProcedureDeclaration__16_s->x = procdec; + (*ProcedureDeclaration__16_s->x)->conval = OPT_NewConst(); + (*ProcedureDeclaration__16_s->x)->conval->intval = c; + if (OPP_sym == 38) { + if (__STRCMP(OPS_name, (*ProcedureDeclaration__16_s->proc)->name) != 0) { + OPP_err(4); + } + OPS_Get(&OPP_sym); + } else { + OPP_err(38); + } +} + +static void TProcDecl__23 (void) +{ + OPT_Object baseProc = NIL; + OPT_Struct objTyp = NIL, recTyp = NIL; + SHORTINT objMode; + OPS_Name objName; + OPS_Get(&OPP_sym); + *ProcedureDeclaration__16_s->mode = 13; + if (OPP_level > 0) { + OPP_err(73); + } + OPP_Receiver(&objMode, objName, &objTyp, &recTyp); + if (OPP_sym == 38) { + __COPY(OPS_name, *ProcedureDeclaration__16_s->name, ((LONGINT)(256))); + OPP_CheckMark(&*ProcedureDeclaration__16_s->vis); + OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp, &*ProcedureDeclaration__16_s->fwd); + OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp->BaseTyp, &baseProc); + if ((baseProc != NIL && baseProc->mode != 13)) { + baseProc = NIL; + } + if (*ProcedureDeclaration__16_s->fwd == baseProc) { + *ProcedureDeclaration__16_s->fwd = NIL; + } + if ((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mnolev != OPP_level)) { + *ProcedureDeclaration__16_s->fwd = NIL; + } + if ((((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mode == 13)) && !__IN(1, (*ProcedureDeclaration__16_s->fwd)->conval->setval))) { + *ProcedureDeclaration__16_s->proc = OPT_NewObj(); + (*ProcedureDeclaration__16_s->proc)->leaf = 1; + if ((*ProcedureDeclaration__16_s->fwd)->vis != *ProcedureDeclaration__16_s->vis) { + OPP_err(118); + } + } else { + if (*ProcedureDeclaration__16_s->fwd != NIL) { + OPP_err(1); + *ProcedureDeclaration__16_s->fwd = NIL; + } + OPT_OpenScope(0, NIL); + OPT_topScope->right = recTyp->link; + OPT_Insert(*ProcedureDeclaration__16_s->name, &*ProcedureDeclaration__16_s->proc); + recTyp->link = OPT_topScope->right; + OPT_CloseScope(); + } + OPP_level += 1; + OPT_OpenScope(OPP_level, *ProcedureDeclaration__16_s->proc); + OPT_Insert(objName, &(*ProcedureDeclaration__16_s->proc)->link); + (*ProcedureDeclaration__16_s->proc)->link->mode = objMode; + (*ProcedureDeclaration__16_s->proc)->link->typ = objTyp; + GetParams__21(); + if (baseProc != NIL) { + if (objMode != baseProc->link->mode || !OPP_Extends(objTyp, baseProc->link->typ)) { + OPP_err(115); + } + OPB_CheckParameters((*ProcedureDeclaration__16_s->proc)->link->link, baseProc->link->link, 0); + if ((*ProcedureDeclaration__16_s->proc)->typ != baseProc->typ) { + OPP_err(117); + } + if ((((((baseProc->vis == 1 && (*ProcedureDeclaration__16_s->proc)->vis == 0)) && recTyp->strobj != NIL)) && recTyp->strobj->vis == 1)) { + OPP_err(109); + } + (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(2); + } + if (!*ProcedureDeclaration__16_s->forward) { + Body__17(); + } + OPP_level -= 1; + OPT_CloseScope(); + } else { + OPP_err(38); + } +} + +static void OPP_ProcedureDeclaration (OPT_Node *x) +{ + OPT_Object proc = NIL, fwd = NIL; + OPS_Name name; + SHORTINT mode, vis; + BOOLEAN forward; + struct ProcedureDeclaration__16 _s; + _s.x = x; + _s.proc = &proc; + _s.fwd = &fwd; + _s.name = (void*)name; + _s.mode = &mode; + _s.vis = &vis; + _s.forward = &forward; + _s.lnk = ProcedureDeclaration__16_s; + ProcedureDeclaration__16_s = &_s; + proc = NIL; + forward = 0; + *x = NIL; + mode = 6; + if ((OPP_sym != 38 && OPP_sym != 30)) { + if (OPP_sym == 1) { + } else if (OPP_sym == 17) { + forward = 1; + } else if (OPP_sym == 6) { + mode = 10; + } else if (OPP_sym == 7) { + mode = 9; + } else { + OPP_err(38); + } + if ((__IN(mode, 0x0600) && !OPT_SYSimported)) { + OPP_err(135); + } + OPS_Get(&OPP_sym); + } + if (OPP_sym == 30) { + TProcDecl__23(); + } else if (OPP_sym == 38) { + OPT_Find(&fwd); + __COPY(OPS_name, name, ((LONGINT)(256))); + OPP_CheckMark(&vis); + if ((vis != 0 && mode == 6)) { + mode = 7; + } + if ((fwd != NIL && (fwd->mnolev != OPP_level || fwd->mode == 8))) { + fwd = NIL; + } + if ((((fwd != NIL && __IN(fwd->mode, 0xc0))) && !__IN(1, fwd->conval->setval))) { + proc = OPT_NewObj(); + proc->leaf = 1; + if (fwd->vis != vis) { + OPP_err(118); + } + } else { + if (fwd != NIL) { + OPP_err(1); + fwd = NIL; + } + OPT_Insert(name, &proc); + } + if ((mode != 6 && OPP_level > 0)) { + OPP_err(73); + } + OPP_level += 1; + OPT_OpenScope(OPP_level, proc); + proc->link = NIL; + GetParams__21(); + if (mode == 9) { + GetCode__19(); + } else if (!forward) { + Body__17(); + } + OPP_level -= 1; + OPT_CloseScope(); + } else { + OPP_err(38); + } + ProcedureDeclaration__16_s = _s.lnk; +} + +static void OPP_CaseLabelList (OPT_Node *lab, INTEGER LabelForm, INTEGER *n, OPP_CaseTable tab) +{ + OPT_Node x = NIL, y = NIL, lastlab = NIL; + INTEGER i, f; + LONGINT xval, yval; + *lab = NIL; + lastlab = NIL; + for (;;) { + OPP_ConstExpression(&x); + f = x->typ->form; + if (__IN(f, 0x78)) { + xval = x->conval->intval; + } else { + OPP_err(61); + xval = 1; + } + if (__IN(f, 0x70)) { + if (LabelForm < f) { + OPP_err(60); + } + } else if (LabelForm != f) { + OPP_err(60); + } + if (OPP_sym == 21) { + OPS_Get(&OPP_sym); + OPP_ConstExpression(&y); + yval = y->conval->intval; + if (((int)y->typ->form != f && !((__IN(f, 0x70) && __IN(y->typ->form, 0x70))))) { + OPP_err(60); + } + if (yval < xval) { + OPP_err(63); + yval = xval; + } + } else { + yval = xval; + } + x->conval->intval2 = yval; + i = *n; + if (i < 128) { + for (;;) { + if (i == 0) { + break; + } + if (tab[__X(i - 1, ((LONGINT)(128)))].low <= yval) { + if (tab[__X(i - 1, ((LONGINT)(128)))].high >= xval) { + OPP_err(62); + } + break; + } + tab[__X(i, ((LONGINT)(128)))] = tab[__X(i - 1, ((LONGINT)(128)))]; + i -= 1; + } + tab[__X(i, ((LONGINT)(128)))].low = xval; + tab[__X(i, ((LONGINT)(128)))].high = yval; + *n += 1; + } else { + OPP_err(213); + } + OPB_Link(&*lab, &lastlab, x); + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 35 || OPP_sym == 38) { + OPP_err(19); + } else { + break; + } + } +} + +static struct StatSeq__30 { + LONGINT *pos; + struct StatSeq__30 *lnk; +} *StatSeq__30_s; + +static void CasePart__31 (OPT_Node *x); +static void CheckBool__33 (OPT_Node *x); +static void SetPos__35 (OPT_Node x); + +static void CasePart__31 (OPT_Node *x) +{ + INTEGER n; + LONGINT low, high; + BOOLEAN e; + OPP_CaseTable tab; + OPT_Node cases = NIL, lab = NIL, y = NIL, lastcase = NIL; + OPP_Expression(&*x); + *StatSeq__30_s->pos = OPM_errpos; + if ((*x)->class == 8 || (*x)->class == 9) { + OPP_err(126); + } else if (!__IN((*x)->typ->form, 0x78)) { + OPP_err(125); + } + OPP_CheckSym(25); + cases = NIL; + lastcase = NIL; + n = 0; + for (;;) { + if (OPP_sym < 40) { + OPP_CaseLabelList(&lab, (*x)->typ->form, &n, tab); + OPP_CheckSym(20); + OPP_StatSeq(&y); + OPB_Construct(17, &lab, y); + OPB_Link(&cases, &lastcase, lab); + } + if (OPP_sym == 40) { + OPS_Get(&OPP_sym); + } else { + break; + } + } + if (n > 0) { + low = tab[0].low; + high = tab[__X(n - 1, ((LONGINT)(128)))].high; + if (high - low > 512) { + OPP_err(209); + } + } else { + low = 1; + high = 0; + } + e = OPP_sym == 42; + if (e) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&y); + } else { + y = NIL; + OPM_Mark(-307, OPM_curpos); + } + OPB_Construct(16, &cases, y); + OPB_Construct(21, &*x, cases); + cases->conval = OPT_NewConst(); + cases->conval->intval = low; + cases->conval->intval2 = high; + if (e) { + cases->conval->setval = 0x02; + } else { + cases->conval->setval = 0x0; + } +} + +static void SetPos__35 (OPT_Node x) +{ + x->conval = OPT_NewConst(); + x->conval->intval = *StatSeq__30_s->pos; +} + +static void CheckBool__33 (OPT_Node *x) +{ + if ((*x)->class == 8 || (*x)->class == 9) { + OPP_err(126); + *x = OPB_NewBoolConst(0); + } else if ((*x)->typ->form != 2) { + OPP_err(120); + *x = OPB_NewBoolConst(0); + } + *StatSeq__30_s->pos = OPM_errpos; +} + +static void OPP_StatSeq (OPT_Node *stat) +{ + OPT_Object fpar = NIL, id = NIL, t = NIL, obj = NIL; + OPT_Struct idtyp = NIL; + BOOLEAN e; + OPT_Node s = NIL, x = NIL, y = NIL, z = NIL, apar = NIL, last = NIL, lastif = NIL; + LONGINT pos; + OPS_Name name; + struct StatSeq__30 _s; + _s.pos = &pos; + _s.lnk = StatSeq__30_s; + StatSeq__30_s = &_s; + *stat = NIL; + last = NIL; + for (;;) { + x = NIL; + if (OPP_sym < 38) { + OPP_err(14); + do { + OPS_Get(&OPP_sym); + } while (!(OPP_sym >= 38)); + } + if (OPP_sym == 38) { + OPP_qualident(&id); + x = OPB_NewLeaf(id); + OPP_selector(&x); + if (OPP_sym == 34) { + OPS_Get(&OPP_sym); + OPP_Expression(&y); + OPB_Assign(&x, y); + } else if (OPP_sym == 9) { + OPP_err(34); + OPS_Get(&OPP_sym); + OPP_Expression(&y); + OPB_Assign(&x, y); + } else if ((x->class == 9 && x->obj->mode == 8)) { + OPP_StandProcCall(&x); + if ((x != NIL && x->typ != OPT_notyp)) { + OPP_err(55); + } + } else { + OPB_PrepCall(&x, &fpar); + if (OPP_sym == 30) { + OPS_Get(&OPP_sym); + OPP_ActualParameters(&apar, fpar); + OPP_CheckSym(22); + } else { + apar = NIL; + if (fpar != NIL) { + OPP_err(65); + } + } + OPB_Call(&x, apar, fpar); + if (x->typ != OPT_notyp) { + OPP_err(55); + } + if (OPP_level > 0) { + OPT_topScope->link->leaf = 0; + } + } + pos = OPM_errpos; + } else if (OPP_sym == 45) { + OPS_Get(&OPP_sym); + OPP_Expression(&x); + CheckBool__33(&x); + OPP_CheckSym(26); + OPP_StatSeq(&y); + OPB_Construct(15, &x, y); + SetPos__35(x); + lastif = x; + while (OPP_sym == 43) { + OPS_Get(&OPP_sym); + OPP_Expression(&y); + CheckBool__33(&y); + OPP_CheckSym(26); + OPP_StatSeq(&z); + OPB_Construct(15, &y, z); + SetPos__35(y); + OPB_Link(&x, &lastif, y); + } + if (OPP_sym == 42) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&y); + } else { + y = NIL; + } + OPB_Construct(20, &x, y); + OPP_CheckSym(41); + OPB_OptIf(&x); + pos = OPM_errpos; + } else if (OPP_sym == 46) { + OPS_Get(&OPP_sym); + CasePart__31(&x); + OPP_CheckSym(41); + } else if (OPP_sym == 47) { + OPS_Get(&OPP_sym); + OPP_Expression(&x); + CheckBool__33(&x); + OPP_CheckSym(27); + OPP_StatSeq(&y); + OPB_Construct(22, &x, y); + OPP_CheckSym(41); + } else if (OPP_sym == 48) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&x); + if (OPP_sym == 44) { + OPS_Get(&OPP_sym); + OPP_Expression(&y); + CheckBool__33(&y); + } else { + OPP_err(44); + } + OPB_Construct(23, &x, y); + } else if (OPP_sym == 49) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + OPP_qualident(&id); + if (!__IN(id->typ->form, 0x70)) { + OPP_err(68); + } + OPP_CheckSym(34); + OPP_Expression(&y); + pos = OPM_errpos; + x = OPB_NewLeaf(id); + OPB_Assign(&x, y); + SetPos__35(x); + OPP_CheckSym(28); + OPP_Expression(&y); + pos = OPM_errpos; + if (y->class != 7) { + __MOVE("@@", name, 3); + OPT_Insert(name, &t); + __MOVE("@for", t->name, 5); + t->mode = 1; + t->typ = x->left->typ; + obj = OPT_topScope->scope; + if (obj == NIL) { + OPT_topScope->scope = t; + } else { + while (obj->link != NIL) { + obj = obj->link; + } + obj->link = t; + } + z = OPB_NewLeaf(t); + OPB_Assign(&z, y); + SetPos__35(z); + OPB_Link(&*stat, &last, z); + y = OPB_NewLeaf(t); + } else if (y->typ->form < 4 || y->typ->form > x->left->typ->form) { + OPP_err(113); + } + OPB_Link(&*stat, &last, x); + if (OPP_sym == 29) { + OPS_Get(&OPP_sym); + OPP_ConstExpression(&z); + } else { + z = OPB_NewIntConst(((LONGINT)(1))); + } + pos = OPM_errpos; + x = OPB_NewLeaf(id); + if (z->conval->intval > 0) { + OPB_Op(12, &x, y); + } else if (z->conval->intval < 0) { + OPB_Op(14, &x, y); + } else { + OPP_err(63); + OPB_Op(14, &x, y); + } + OPP_CheckSym(27); + OPP_StatSeq(&s); + y = OPB_NewLeaf(id); + OPB_StPar1(&y, z, 13); + SetPos__35(y); + if (s == NIL) { + s = y; + } else { + z = s; + while (z->link != NIL) { + z = z->link; + } + z->link = y; + } + OPP_CheckSym(41); + OPB_Construct(22, &x, s); + } else { + OPP_err(38); + } + } else if (OPP_sym == 50) { + OPS_Get(&OPP_sym); + OPP_LoopLevel += 1; + OPP_StatSeq(&x); + OPP_LoopLevel -= 1; + OPB_Construct(24, &x, NIL); + OPP_CheckSym(41); + pos = OPM_errpos; + } else if (OPP_sym == 51) { + OPS_Get(&OPP_sym); + idtyp = NIL; + x = NIL; + for (;;) { + if (OPP_sym == 38) { + OPP_qualident(&id); + y = OPB_NewLeaf(id); + if ((((id != NIL && id->typ->form == 13)) && (id->mode == 2 || !id->leaf))) { + OPP_err(245); + } + OPP_CheckSym(20); + if (OPP_sym == 38) { + OPP_qualident(&t); + if (t->mode == 5) { + if (id != NIL) { + idtyp = id->typ; + OPB_TypTest(&y, t, 0); + id->typ = t->typ; + } else { + OPP_err(130); + } + } else { + OPP_err(52); + } + } else { + OPP_err(38); + } + } else { + OPP_err(38); + } + pos = OPM_errpos; + OPP_CheckSym(27); + OPP_StatSeq(&s); + OPB_Construct(15, &y, s); + SetPos__35(y); + if (idtyp != NIL) { + id->typ = idtyp; + idtyp = NIL; + } + if (x == NIL) { + x = y; + lastif = x; + } else { + OPB_Link(&x, &lastif, y); + } + if (OPP_sym == 40) { + OPS_Get(&OPP_sym); + } else { + break; + } + } + e = OPP_sym == 42; + if (e) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&s); + } else { + s = NIL; + } + OPB_Construct(27, &x, s); + OPP_CheckSym(41); + if (e) { + x->subcl = 1; + } + } else if (OPP_sym == 52) { + OPS_Get(&OPP_sym); + if (OPP_LoopLevel == 0) { + OPP_err(46); + } + OPB_Construct(25, &x, NIL); + pos = OPM_errpos; + } else if (OPP_sym == 53) { + OPS_Get(&OPP_sym); + if (OPP_sym < 39) { + OPP_Expression(&x); + } + if (OPP_level > 0) { + OPB_Return(&x, OPT_topScope->link); + } else { + OPB_Return(&x, NIL); + } + pos = OPM_errpos; + } + if (x != NIL) { + SetPos__35(x); + OPB_Link(&*stat, &last, x); + } + if (OPP_sym == 39) { + OPS_Get(&OPP_sym); + } else if (OPP_sym <= 38 || (45 <= OPP_sym && OPP_sym <= 53)) { + OPP_err(39); + } else { + break; + } + } + StatSeq__30_s = _s.lnk; +} + +static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq) +{ + OPT_Struct typ = NIL; + OPT_Object obj = NIL, first = NIL, last = NIL; + OPT_Node x = NIL, lastdec = NIL; + INTEGER i; + first = NIL; + last = NIL; + OPP_nofFwdPtr = 0; + for (;;) { + if (OPP_sym == 58) { + OPS_Get(&OPP_sym); + while (OPP_sym == 38) { + OPT_Insert(OPS_name, &obj); + OPP_CheckMark(&obj->vis); + obj->typ = OPT_sinttyp; + obj->mode = 1; + if (OPP_sym == 9) { + OPS_Get(&OPP_sym); + OPP_ConstExpression(&x); + } else if (OPP_sym == 34) { + OPP_err(9); + OPS_Get(&OPP_sym); + OPP_ConstExpression(&x); + } else { + OPP_err(9); + x = OPB_NewIntConst(((LONGINT)(1))); + } + obj->mode = 3; + obj->typ = x->typ; + obj->conval = x->conval; + OPP_CheckSym(39); + } + } + if (OPP_sym == 59) { + OPS_Get(&OPP_sym); + while (OPP_sym == 38) { + OPT_Insert(OPS_name, &obj); + obj->mode = 5; + obj->typ = OPT_undftyp; + OPP_CheckMark(&obj->vis); + if (OPP_sym == 9) { + OPS_Get(&OPP_sym); + OPP_TypeDecl(&obj->typ, &obj->typ); + } else if (OPP_sym == 34 || OPP_sym == 20) { + OPP_err(9); + OPS_Get(&OPP_sym); + OPP_TypeDecl(&obj->typ, &obj->typ); + } else { + OPP_err(9); + } + if (obj->typ->strobj == NIL) { + obj->typ->strobj = obj; + } + if (__IN(obj->typ->comp, 0x1c)) { + i = 0; + while (i < OPP_nofFwdPtr) { + typ = OPP_FwdPtr[__X(i, ((LONGINT)(64)))]; + i += 1; + if (__STRCMP(typ->link->name, obj->name) == 0) { + typ->BaseTyp = obj->typ; + typ->link->name[0] = 0x00; + } + } + } + OPP_CheckSym(39); + } + } + if (OPP_sym == 60) { + OPS_Get(&OPP_sym); + while (OPP_sym == 38) { + for (;;) { + if (OPP_sym == 38) { + OPT_Insert(OPS_name, &obj); + OPP_CheckMark(&obj->vis); + obj->mode = 1; + obj->link = NIL; + obj->leaf = obj->vis == 0; + obj->typ = OPT_undftyp; + if (first == NIL) { + first = obj; + } + if (last == NIL) { + OPT_topScope->scope = obj; + } else { + last->link = obj; + } + last = obj; + } else { + OPP_err(38); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(19); + } else { + break; + } + } + OPP_CheckSym(20); + OPP_Type(&typ, &OPT_notyp); + typ->pvused = 1; + if (typ->comp == 3) { + typ = OPT_undftyp; + OPP_err(88); + } + while (first != NIL) { + first->typ = typ; + first = first->link; + } + OPP_CheckSym(39); + } + } + if (OPP_sym < 58 || OPP_sym > 60) { + break; + } + } + i = 0; + while (i < OPP_nofFwdPtr) { + if (OPP_FwdPtr[__X(i, ((LONGINT)(64)))]->link->name[0] != 0x00) { + OPP_err(128); + } + OPP_FwdPtr[__X(i, ((LONGINT)(64)))] = NIL; + i += 1; + } + OPT_topScope->adr = OPM_errpos; + *procdec = NIL; + lastdec = NIL; + while (OPP_sym == 61) { + OPS_Get(&OPP_sym); + OPP_ProcedureDeclaration(&x); + if (x != NIL) { + if (lastdec == NIL) { + *procdec = x; + } else { + lastdec->link = x; + } + lastdec = x; + } + OPP_CheckSym(39); + } + if (OPP_sym == 57) { + OPS_Get(&OPP_sym); + OPP_StatSeq(&*statseq); + } else { + *statseq = NIL; + } + if ((OPP_level == 0 && OPP_TDinit != NIL)) { + OPP_lastTDinit->link = *statseq; + *statseq = OPP_TDinit; + } + OPP_CheckSym(41); +} + +void OPP_Module (OPT_Node *prog, SET opt) +{ + OPS_Name impName, aliasName; + OPT_Node procdec = NIL, statseq = NIL; + LONGINT c; + BOOLEAN done; + OPS_Init(); + OPP_LoopLevel = 0; + OPP_level = 0; + OPS_Get(&OPP_sym); + if (OPP_sym == 63) { + OPS_Get(&OPP_sym); + } else { + OPP_err(16); + } + if (OPP_sym == 38) { + OPM_LogWStr((CHAR*)"compiling ", (LONGINT)11); + OPM_LogWStr(OPS_name, ((LONGINT)(256))); + OPM_LogW('.'); + OPT_Init(OPS_name, opt); + OPS_Get(&OPP_sym); + OPP_CheckSym(39); + if (OPP_sym == 62) { + OPS_Get(&OPP_sym); + for (;;) { + if (OPP_sym == 38) { + __COPY(OPS_name, aliasName, ((LONGINT)(256))); + __COPY(aliasName, impName, ((LONGINT)(256))); + OPS_Get(&OPP_sym); + if (OPP_sym == 34) { + OPS_Get(&OPP_sym); + if (OPP_sym == 38) { + __COPY(OPS_name, impName, ((LONGINT)(256))); + OPS_Get(&OPP_sym); + } else { + OPP_err(38); + } + } + OPT_Import(aliasName, impName, &done); + } else { + OPP_err(38); + } + if (OPP_sym == 19) { + OPS_Get(&OPP_sym); + } else if (OPP_sym == 38) { + OPP_err(19); + } else { + break; + } + } + OPP_CheckSym(39); + } + if (OPM_noerr) { + OPP_TDinit = NIL; + OPP_lastTDinit = NIL; + c = OPM_errpos; + OPP_Block(&procdec, &statseq); + OPB_Enter(&procdec, statseq, NIL); + *prog = procdec; + (*prog)->conval = OPT_NewConst(); + (*prog)->conval->intval = c; + if (OPP_sym == 38) { + if (__STRCMP(OPS_name, OPT_SelfName) != 0) { + OPP_err(4); + } + OPS_Get(&OPP_sym); + } else { + OPP_err(38); + } + if (OPP_sym != 18) { + OPP_err(18); + } + } + } else { + OPP_err(38); + } + OPP_TDinit = NIL; + OPP_lastTDinit = NIL; +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(OPP_TDinit); + P(OPP_lastTDinit); + __ENUMP(OPP_FwdPtr, 64, P); +} + +__TDESC(OPP__1, 1, 0) = {__TDFLDS("", 16), {-8}}; + +export void *OPP__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPB); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPS); + __MODULE_IMPORT(OPT); + __REGMOD("OPP", EnumPtrs); + __INITYP(OPP__1, OPP__1, 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/windows-88/OPP.h b/bootstrap/windows-88/OPP.h new file mode 100644 index 00000000..30cf0643 --- /dev/null +++ b/bootstrap/windows-88/OPP.h @@ -0,0 +1,17 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPP__h +#define OPP__h + +#define LARGE +#include "SYSTEM.h" +#include "OPT.h" + + + + +import void OPP_Module (OPT_Node *prog, SET opt); +import void *OPP__init(void); + + +#endif diff --git a/bootstrap/windows-88/OPS.c b/bootstrap/windows-88/OPS.c new file mode 100644 index 00000000..bb08e1f5 --- /dev/null +++ b/bootstrap/windows-88/OPS.c @@ -0,0 +1,624 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "OPM.h" + +typedef + CHAR OPS_Name[256]; + +typedef + CHAR OPS_String[256]; + + +export OPS_Name OPS_name; +export OPS_String OPS_str; +export INTEGER OPS_numtyp; +export LONGINT OPS_intval; +export REAL OPS_realval; +export LONGREAL OPS_lrlval; +static CHAR OPS_ch; + + +export void OPS_Get (SHORTINT *sym); +static void OPS_Identifier (SHORTINT *sym); +export void OPS_Init (void); +static void OPS_Number (void); +static void OPS_Str (SHORTINT *sym); +static void OPS_err (INTEGER n); + + +static void OPS_err (INTEGER n) +{ + OPM_err(n); +} + +static void OPS_Str (SHORTINT *sym) +{ + INTEGER i; + CHAR och; + i = 0; + och = OPS_ch; + for (;;) { + OPM_Get(&OPS_ch); + if (OPS_ch == och) { + break; + } + if (OPS_ch < ' ') { + OPS_err(3); + break; + } + if (i == 255) { + OPS_err(241); + break; + } + OPS_str[i] = OPS_ch; + i += 1; + } + OPM_Get(&OPS_ch); + OPS_str[i] = 0x00; + OPS_intval = i + 1; + if (OPS_intval == 2) { + *sym = 35; + OPS_numtyp = 1; + OPS_intval = (int)OPS_str[0]; + } else { + *sym = 37; + } +} + +static void OPS_Identifier (SHORTINT *sym) +{ + INTEGER i; + i = 0; + do { + OPS_name[i] = OPS_ch; + i += 1; + OPM_Get(&OPS_ch); + } while (!(((OPS_ch < '0' || ('9' < OPS_ch && __CAP(OPS_ch) < 'A')) || 'Z' < __CAP(OPS_ch)) || i == 256)); + if (i == 256) { + OPS_err(240); + i -= 1; + } + OPS_name[i] = 0x00; + *sym = 38; +} + +static struct Number__6 { + struct Number__6 *lnk; +} *Number__6_s; + +static INTEGER Ord__7 (CHAR ch, BOOLEAN hex); +static LONGREAL Ten__9 (INTEGER e); + +static LONGREAL Ten__9 (INTEGER e) +{ + LONGREAL _o_result; + LONGREAL x, p; + x = (LONGREAL)1; + p = (LONGREAL)10; + while (e > 0) { + if (__ODD(e)) { + x = x * p; + } + e = __ASHR(e, 1); + if (e > 0) { + p = p * p; + } + } + _o_result = x; + return _o_result; +} + +static INTEGER Ord__7 (CHAR ch, BOOLEAN hex) +{ + INTEGER _o_result; + if (ch <= '9') { + _o_result = (int)ch - 48; + return _o_result; + } else if (hex) { + _o_result = ((int)ch - 65) + 10; + return _o_result; + } else { + OPS_err(2); + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +static void OPS_Number (void) +{ + INTEGER i, m, n, d, e; + CHAR dig[24]; + LONGREAL f; + CHAR expCh; + BOOLEAN neg; + struct Number__6 _s; + _s.lnk = Number__6_s; + Number__6_s = &_s; + i = 0; + m = 0; + n = 0; + d = 0; + for (;;) { + if (('0' <= OPS_ch && OPS_ch <= '9') || (((d == 0 && 'A' <= OPS_ch)) && OPS_ch <= 'F')) { + if (m > 0 || OPS_ch != '0') { + if (n < 24) { + dig[n] = OPS_ch; + n += 1; + } + m += 1; + } + OPM_Get(&OPS_ch); + i += 1; + } else if (OPS_ch == '.') { + OPM_Get(&OPS_ch); + if (OPS_ch == '.') { + OPS_ch = 0x7f; + break; + } else if (d == 0) { + d = i; + } else { + OPS_err(2); + } + } else { + break; + } + } + if (d == 0) { + if (n == m) { + OPS_intval = 0; + i = 0; + if (OPS_ch == 'X') { + OPM_Get(&OPS_ch); + OPS_numtyp = 1; + if (n <= 2) { + while (i < n) { + OPS_intval = __ASHL(OPS_intval, 4) + (LONGINT)Ord__7(dig[i], 1); + i += 1; + } + } else { + OPS_err(203); + } + } else if (OPS_ch == 'H') { + OPM_Get(&OPS_ch); + OPS_numtyp = 2; + if (n <= 8) { + if ((n == 8 && dig[0] > '7')) { + OPS_intval = -1; + } + while (i < n) { + OPS_intval = __ASHL(OPS_intval, 4) + (LONGINT)Ord__7(dig[i], 1); + i += 1; + } + } else { + OPS_err(203); + } + } else { + OPS_numtyp = 2; + while (i < n) { + d = Ord__7(dig[i], 0); + i += 1; + if (OPS_intval <= __DIV(9223372036854775807 - (LONGINT)d, 10)) { + OPS_intval = OPS_intval * 10 + (LONGINT)d; + } else { + OPS_err(203); + } + } + } + } else { + OPS_err(203); + } + } else { + f = (LONGREAL)0; + e = 0; + expCh = 'E'; + while (n > 0) { + n -= 1; + f = (Ord__7(dig[n], 0) + f) / (LONGREAL)(LONGREAL)10; + } + if (OPS_ch == 'E' || OPS_ch == 'D') { + expCh = OPS_ch; + OPM_Get(&OPS_ch); + neg = 0; + if (OPS_ch == '-') { + neg = 1; + OPM_Get(&OPS_ch); + } else if (OPS_ch == '+') { + OPM_Get(&OPS_ch); + } + if (('0' <= OPS_ch && OPS_ch <= '9')) { + do { + n = Ord__7(OPS_ch, 0); + OPM_Get(&OPS_ch); + if (e <= __DIV(2147483647 - n, 10)) { + e = e * 10 + n; + } else { + OPS_err(203); + } + } while (!(OPS_ch < '0' || '9' < OPS_ch)); + if (neg) { + e = -e; + } + } else { + OPS_err(2); + } + } + e -= (i - d) - m; + if (expCh == 'E') { + OPS_numtyp = 3; + if ((-37 < e && e <= 38)) { + if (e < 0) { + OPS_realval = (f / (LONGREAL)Ten__9(-e)); + } else { + OPS_realval = (f * Ten__9(e)); + } + } else { + OPS_err(203); + } + } else { + OPS_numtyp = 4; + if ((-307 < e && e <= 308)) { + if (e < 0) { + OPS_lrlval = f / (LONGREAL)Ten__9(-e); + } else { + OPS_lrlval = f * Ten__9(e); + } + } else { + OPS_err(203); + } + } + } + Number__6_s = _s.lnk; +} + +static struct Get__1 { + struct Get__1 *lnk; +} *Get__1_s; + +static void Comment__2 (void); + +static void Comment__2 (void) +{ + OPM_Get(&OPS_ch); + for (;;) { + for (;;) { + while (OPS_ch == '(') { + OPM_Get(&OPS_ch); + if (OPS_ch == '*') { + Comment__2(); + } + } + if (OPS_ch == '*') { + OPM_Get(&OPS_ch); + break; + } + if (OPS_ch == 0x00) { + break; + } + OPM_Get(&OPS_ch); + } + if (OPS_ch == ')') { + OPM_Get(&OPS_ch); + break; + } + if (OPS_ch == 0x00) { + OPS_err(5); + break; + } + } +} + +void OPS_Get (SHORTINT *sym) +{ + SHORTINT s; + struct Get__1 _s; + _s.lnk = Get__1_s; + Get__1_s = &_s; + OPM_errpos = OPM_curpos - 1; + while (OPS_ch <= ' ') { + if (OPS_ch == 0x00) { + *sym = 64; + return; + } else { + OPM_Get(&OPS_ch); + } + } + switch (OPS_ch) { + case '\"': case '\'': + OPS_Str(&s); + break; + case '#': + s = 10; + OPM_Get(&OPS_ch); + break; + case '&': + s = 5; + OPM_Get(&OPS_ch); + break; + case '(': + OPM_Get(&OPS_ch); + if (OPS_ch == '*') { + Comment__2(); + OPS_Get(&s); + } else { + s = 30; + } + break; + case ')': + s = 22; + OPM_Get(&OPS_ch); + break; + case '*': + s = 1; + OPM_Get(&OPS_ch); + break; + case '+': + s = 6; + OPM_Get(&OPS_ch); + break; + case ',': + s = 19; + OPM_Get(&OPS_ch); + break; + case '-': + s = 7; + OPM_Get(&OPS_ch); + break; + case '.': + OPM_Get(&OPS_ch); + if (OPS_ch == '.') { + OPM_Get(&OPS_ch); + s = 21; + } else { + s = 18; + } + break; + case '/': + s = 2; + OPM_Get(&OPS_ch); + break; + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + OPS_Number(); + s = 35; + break; + case ':': + OPM_Get(&OPS_ch); + if (OPS_ch == '=') { + OPM_Get(&OPS_ch); + s = 34; + } else { + s = 20; + } + break; + case ';': + s = 39; + OPM_Get(&OPS_ch); + break; + case '<': + OPM_Get(&OPS_ch); + if (OPS_ch == '=') { + OPM_Get(&OPS_ch); + s = 12; + } else { + s = 11; + } + break; + case '=': + s = 9; + OPM_Get(&OPS_ch); + break; + case '>': + OPM_Get(&OPS_ch); + if (OPS_ch == '=') { + OPM_Get(&OPS_ch); + s = 14; + } else { + s = 13; + } + break; + case 'A': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "ARRAY") == 0) { + s = 54; + } + break; + case 'B': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "BEGIN") == 0) { + s = 57; + } else if (__STRCMP(OPS_name, "BY") == 0) { + s = 29; + } + break; + case 'C': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "CASE") == 0) { + s = 46; + } else if (__STRCMP(OPS_name, "CONST") == 0) { + s = 58; + } + break; + case 'D': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "DO") == 0) { + s = 27; + } else if (__STRCMP(OPS_name, "DIV") == 0) { + s = 3; + } + break; + case 'E': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "END") == 0) { + s = 41; + } else if (__STRCMP(OPS_name, "ELSE") == 0) { + s = 42; + } else if (__STRCMP(OPS_name, "ELSIF") == 0) { + s = 43; + } else if (__STRCMP(OPS_name, "EXIT") == 0) { + s = 52; + } + break; + case 'F': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "FOR") == 0) { + s = 49; + } + break; + case 'I': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "IF") == 0) { + s = 45; + } else if (__STRCMP(OPS_name, "IN") == 0) { + s = 15; + } else if (__STRCMP(OPS_name, "IS") == 0) { + s = 16; + } else if (__STRCMP(OPS_name, "IMPORT") == 0) { + s = 62; + } + break; + case 'L': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "LOOP") == 0) { + s = 50; + } + break; + case 'M': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "MOD") == 0) { + s = 4; + } else if (__STRCMP(OPS_name, "MODULE") == 0) { + s = 63; + } + break; + case 'N': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "NIL") == 0) { + s = 36; + } + break; + case 'O': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "OR") == 0) { + s = 8; + } else if (__STRCMP(OPS_name, "OF") == 0) { + s = 25; + } + break; + case 'P': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "PROCEDURE") == 0) { + s = 61; + } else if (__STRCMP(OPS_name, "POINTER") == 0) { + s = 56; + } + break; + case 'R': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "RECORD") == 0) { + s = 55; + } else if (__STRCMP(OPS_name, "REPEAT") == 0) { + s = 48; + } else if (__STRCMP(OPS_name, "RETURN") == 0) { + s = 53; + } + break; + case 'T': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "THEN") == 0) { + s = 26; + } else if (__STRCMP(OPS_name, "TO") == 0) { + s = 28; + } else if (__STRCMP(OPS_name, "TYPE") == 0) { + s = 59; + } + break; + case 'U': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "UNTIL") == 0) { + s = 44; + } + break; + case 'V': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "VAR") == 0) { + s = 60; + } + break; + case 'W': + OPS_Identifier(&s); + if (__STRCMP(OPS_name, "WHILE") == 0) { + s = 47; + } else if (__STRCMP(OPS_name, "WITH") == 0) { + s = 51; + } + break; + case 'G': case 'H': case 'J': case 'K': case 'Q': + case 'S': case 'X': case 'Y': case 'Z': + OPS_Identifier(&s); + break; + case '[': + s = 31; + OPM_Get(&OPS_ch); + break; + case ']': + s = 23; + OPM_Get(&OPS_ch); + break; + case '^': + s = 17; + OPM_Get(&OPS_ch); + break; + case 'a': case 'b': case 'c': case 'd': case 'e': + case 'f': case 'g': case 'h': case 'i': case 'j': + case 'k': case 'l': case 'm': case 'n': case 'o': + case 'p': case 'q': case 'r': case 's': case 't': + case 'u': case 'v': case 'w': case 'x': case 'y': + case 'z': + OPS_Identifier(&s); + break; + case '{': + s = 32; + OPM_Get(&OPS_ch); + break; + case '|': + s = 40; + OPM_Get(&OPS_ch); + break; + case '}': + s = 24; + OPM_Get(&OPS_ch); + break; + case '~': + s = 33; + OPM_Get(&OPS_ch); + break; + case 0x7f: + s = 21; + OPM_Get(&OPS_ch); + break; + default: + s = 0; + OPM_Get(&OPS_ch); + break; + } + *sym = s; + Get__1_s = _s.lnk; +} + +void OPS_Init (void) +{ + OPS_ch = ' '; +} + + +export void *OPS__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPM); + __REGMOD("OPS", 0); + __REGCMD("Init", OPS_Init); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/windows-88/OPS.h b/bootstrap/windows-88/OPS.h new file mode 100644 index 00000000..eab85912 --- /dev/null +++ b/bootstrap/windows-88/OPS.h @@ -0,0 +1,29 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin tspkaSfF */ + +#ifndef OPS__h +#define OPS__h + +#define LARGE +#include "SYSTEM.h" + +typedef + CHAR OPS_Name[256]; + +typedef + CHAR OPS_String[256]; + + +import OPS_Name OPS_name; +import OPS_String OPS_str; +import INTEGER OPS_numtyp; +import LONGINT OPS_intval; +import REAL OPS_realval; +import LONGREAL OPS_lrlval; + + +import void OPS_Get (SHORTINT *sym); +import void OPS_Init (void); +import void *OPS__init(void); + + +#endif diff --git a/bootstrap/windows-88/OPT.c b/bootstrap/windows-88/OPT.c new file mode 100644 index 00000000..5f8854a1 --- /dev/null +++ b/bootstrap/windows-88/OPT.c @@ -0,0 +1,1859 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "OPM.h" +#include "OPS.h" + +typedef + struct OPT_ConstDesc *OPT_Const; + +typedef + OPS_String *OPT_ConstExt; + +typedef + struct OPT_ConstDesc { + OPT_ConstExt ext; + LONGINT intval, intval2; + SET setval; + LONGREAL realval; + } OPT_ConstDesc; + +typedef + struct OPT_ExpCtxt { + LONGINT reffp; + INTEGER ref; + SHORTINT nofm; + SHORTINT locmno[64]; + } OPT_ExpCtxt; + +typedef + struct OPT_StrDesc *OPT_Struct; + +typedef + struct OPT_ObjDesc *OPT_Object; + +typedef + struct OPT_ImpCtxt { + LONGINT nextTag, reffp; + INTEGER nofr, minr, nofm; + BOOLEAN self; + OPT_Struct ref[255]; + OPT_Object old[255]; + LONGINT pvfp[255]; + SHORTINT glbmno[64]; + } OPT_ImpCtxt; + +typedef + struct OPT_NodeDesc *OPT_Node; + +typedef + struct OPT_NodeDesc { + OPT_Node left, right, link; + SHORTINT class, subcl; + BOOLEAN readonly; + OPT_Struct typ; + OPT_Object obj; + OPT_Const conval; + } OPT_NodeDesc; + +typedef + struct OPT_ObjDesc { + OPT_Object left, right, link, scope; + OPS_Name name; + BOOLEAN leaf; + SHORTINT mode, mnolev, vis, history; + BOOLEAN used, fpdone; + LONGINT fprint; + OPT_Struct typ; + OPT_Const conval; + LONGINT adr, linkadr; + INTEGER x; + } OPT_ObjDesc; + +typedef + struct OPT_StrDesc { + SHORTINT form, comp, mno, extlev; + INTEGER ref, sysflag; + LONGINT n, size, align, txtpos; + BOOLEAN allocated, pbused, pvused, fpdone, idfpdone; + LONGINT idfp, pbfp, pvfp; + OPT_Struct BaseTyp; + OPT_Object link, strobj; + } OPT_StrDesc; + + +export void (*OPT_typSize)(OPT_Struct); +export OPT_Object OPT_topScope; +export OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp; +export SHORTINT OPT_nofGmod; +export OPT_Object OPT_GlbMod[64]; +export OPS_Name OPT_SelfName; +export BOOLEAN OPT_SYSimported; +static OPT_Object OPT_universe, OPT_syslink; +static OPT_ImpCtxt OPT_impCtxt; +static OPT_ExpCtxt OPT_expCtxt; +static LONGINT OPT_nofhdfld; +static BOOLEAN OPT_newsf, OPT_findpc, OPT_extsf, OPT_sfpresent, OPT_symExtended, OPT_symNew; + +export LONGINT *OPT_ConstDesc__typ; +export LONGINT *OPT_ObjDesc__typ; +export LONGINT *OPT_StrDesc__typ; +export LONGINT *OPT_NodeDesc__typ; +export LONGINT *OPT_ImpCtxt__typ; +export LONGINT *OPT_ExpCtxt__typ; + +export void OPT_Close (void); +export void OPT_CloseScope (void); +static void OPT_DebugStruct (OPT_Struct btyp); +static void OPT_EnterBoolConst (OPS_Name name, LONGINT value); +static void OPT_EnterProc (OPS_Name name, INTEGER num); +static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res); +export void OPT_Export (BOOLEAN *ext, BOOLEAN *new); +export void OPT_FPrintErr (OPT_Object obj, INTEGER errcode); +static void OPT_FPrintName (LONGINT *fp, CHAR *name, LONGINT name__len); +export void OPT_FPrintObj (OPT_Object obj); +static void OPT_FPrintSign (LONGINT *fp, OPT_Struct result, OPT_Object par); +export void OPT_FPrintStr (OPT_Struct typ); +export void OPT_Find (OPT_Object *res); +export void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res); +export void OPT_FindImport (OPT_Object mod, OPT_Object *res); +export void OPT_IdFPrint (OPT_Struct typ); +export void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done); +static void OPT_InConstant (LONGINT f, OPT_Const conval); +static OPT_Object OPT_InFld (void); +static void OPT_InMod (SHORTINT *mno); +static void OPT_InName (CHAR *name, LONGINT name__len); +static OPT_Object OPT_InObj (SHORTINT mno); +static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par); +static void OPT_InStruct (OPT_Struct *typ); +static OPT_Object OPT_InTProc (SHORTINT mno); +export void OPT_Init (OPS_Name name, SET opt); +static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form); +export void OPT_Insert (OPS_Name name, OPT_Object *obj); +export void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old); +export OPT_Const OPT_NewConst (void); +export OPT_ConstExt OPT_NewExt (void); +export OPT_Node OPT_NewNode (SHORTINT class); +export OPT_Object OPT_NewObj (void); +export OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp); +export void OPT_OpenScope (SHORTINT level, OPT_Object owner); +static void OPT_OutConstant (OPT_Object obj); +static void OPT_OutFlds (OPT_Object fld, LONGINT adr, BOOLEAN visible); +static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr); +static void OPT_OutMod (INTEGER mno); +static void OPT_OutName (CHAR *name, LONGINT name__len); +static void OPT_OutObj (OPT_Object obj); +static void OPT_OutSign (OPT_Struct result, OPT_Object par); +static void OPT_OutStr (OPT_Struct typ); +static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj); +static void OPT_err (INTEGER n); + + +static void OPT_err (INTEGER n) +{ + OPM_err(n); +} + +OPT_Const OPT_NewConst (void) +{ + OPT_Const _o_result; + OPT_Const const_ = NIL; + __NEW(const_, OPT_ConstDesc); + _o_result = const_; + return _o_result; +} + +OPT_Object OPT_NewObj (void) +{ + OPT_Object _o_result; + OPT_Object obj = NIL; + __NEW(obj, OPT_ObjDesc); + _o_result = obj; + return _o_result; +} + +OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp) +{ + OPT_Struct _o_result; + OPT_Struct typ = NIL; + __NEW(typ, OPT_StrDesc); + typ->form = form; + typ->comp = comp; + typ->ref = 255; + if (form != 0) { + typ->txtpos = OPM_errpos; + } + typ->size = -1; + typ->BaseTyp = OPT_undftyp; + _o_result = typ; + return _o_result; +} + +OPT_Node OPT_NewNode (SHORTINT class) +{ + OPT_Node _o_result; + OPT_Node node = NIL; + __NEW(node, OPT_NodeDesc); + node->class = class; + _o_result = node; + return _o_result; +} + +OPT_ConstExt OPT_NewExt (void) +{ + OPT_ConstExt _o_result; + OPT_ConstExt ext = NIL; + ext = __NEWARR(NIL, ((LONGINT)(1)), 1, 1, 0, (LONGINT)256); + _o_result = ext; + return _o_result; +} + +void OPT_OpenScope (SHORTINT level, OPT_Object owner) +{ + OPT_Object head = NIL; + head = OPT_NewObj(); + head->mode = 12; + head->mnolev = level; + head->link = owner; + if (owner != NIL) { + owner->scope = head; + } + head->left = OPT_topScope; + head->right = NIL; + head->scope = NIL; + OPT_topScope = head; +} + +void OPT_CloseScope (void) +{ + OPT_topScope = OPT_topScope->left; +} + +void OPT_Init (OPS_Name name, SET opt) +{ + OPT_topScope = OPT_universe; + OPT_OpenScope(0, NIL); + OPT_SYSimported = 0; + __COPY(name, OPT_SelfName, ((LONGINT)(256))); + __COPY(name, OPT_topScope->name, ((LONGINT)(256))); + OPT_GlbMod[0] = OPT_topScope; + OPT_nofGmod = 1; + OPT_newsf = __IN(4, opt); + OPT_findpc = __IN(8, opt); + OPT_extsf = OPT_newsf || __IN(9, opt); + OPT_sfpresent = 1; +} + +void OPT_Close (void) +{ + INTEGER i; + OPT_CloseScope(); + i = 0; + while (i < 64) { + OPT_GlbMod[__X(i, ((LONGINT)(64)))] = NIL; + i += 1; + } + i = 16; + while (i < 255) { + OPT_impCtxt.ref[__X(i, ((LONGINT)(255)))] = NIL; + OPT_impCtxt.old[__X(i, ((LONGINT)(255)))] = NIL; + i += 1; + } +} + +void OPT_FindImport (OPT_Object mod, OPT_Object *res) +{ + OPT_Object obj = NIL; + obj = mod->scope; + for (;;) { + if (obj == NIL) { + break; + } + if (__STRCMP(OPS_name, obj->name) < 0) { + obj = obj->left; + } else if (__STRCMP(OPS_name, obj->name) > 0) { + obj = obj->right; + } else { + if ((obj->mode == 5 && obj->vis == 0)) { + obj = NIL; + } else { + obj->used = 1; + } + break; + } + } + *res = obj; +} + +void OPT_Find (OPT_Object *res) +{ + OPT_Object obj = NIL, head = NIL; + head = OPT_topScope; + for (;;) { + obj = head->right; + for (;;) { + if (obj == NIL) { + break; + } + if (__STRCMP(OPS_name, obj->name) < 0) { + obj = obj->left; + } else if (__STRCMP(OPS_name, obj->name) > 0) { + obj = obj->right; + } else { + break; + } + } + if (obj != NIL) { + break; + } + head = head->left; + if (head == NIL) { + break; + } + } + *res = obj; +} + +void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res) +{ + OPT_Object obj = NIL; + while (typ != NIL) { + obj = typ->link; + while (obj != NIL) { + if (__STRCMP(name, obj->name) < 0) { + obj = obj->left; + } else if (__STRCMP(name, obj->name) > 0) { + obj = obj->right; + } else { + *res = obj; + return; + } + } + typ = typ->BaseTyp; + } + *res = NIL; +} + +void OPT_Insert (OPS_Name name, OPT_Object *obj) +{ + OPT_Object ob0 = NIL, ob1 = NIL; + BOOLEAN left; + SHORTINT mnolev; + ob0 = OPT_topScope; + ob1 = ob0->right; + left = 0; + for (;;) { + if (ob1 != NIL) { + if (__STRCMP(name, ob1->name) < 0) { + ob0 = ob1; + ob1 = ob0->left; + left = 1; + } else if (__STRCMP(name, ob1->name) > 0) { + ob0 = ob1; + ob1 = ob0->right; + left = 0; + } else { + OPT_err(1); + ob0 = ob1; + ob1 = ob0->right; + } + } else { + ob1 = OPT_NewObj(); + ob1->leaf = 1; + if (left) { + ob0->left = ob1; + } else { + ob0->right = ob1; + } + ob1->left = NIL; + ob1->right = NIL; + __COPY(name, ob1->name, ((LONGINT)(256))); + mnolev = OPT_topScope->mnolev; + ob1->mnolev = mnolev; + break; + } + } + *obj = ob1; +} + +static void OPT_FPrintName (LONGINT *fp, CHAR *name, LONGINT name__len) +{ + INTEGER i; + CHAR ch; + i = 0; + do { + ch = name[__X(i, name__len)]; + OPM_FPrint(&*fp, (int)ch); + i += 1; + } while (!(ch == 0x00)); +} + +static void OPT_DebugStruct (OPT_Struct btyp) +{ + OPM_LogWLn(); + if (btyp == NIL) { + OPM_LogWStr((CHAR*)"btyp is nil", (LONGINT)12); + OPM_LogWLn(); + } + OPM_LogWStr((CHAR*)"btyp^.strobji^.name = ", (LONGINT)23); + OPM_LogWStr(btyp->strobj->name, ((LONGINT)(256))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.form = ", (LONGINT)14); + OPM_LogWNum(btyp->form, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.comp = ", (LONGINT)14); + OPM_LogWNum(btyp->comp, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.mno = ", (LONGINT)13); + OPM_LogWNum(btyp->mno, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.extlev = ", (LONGINT)16); + OPM_LogWNum(btyp->extlev, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.size = ", (LONGINT)14); + OPM_LogWNum(btyp->size, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.align = ", (LONGINT)15); + OPM_LogWNum(btyp->align, ((LONGINT)(0))); + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"btyp^.txtpos = ", (LONGINT)16); + OPM_LogWNum(btyp->txtpos, ((LONGINT)(0))); + OPM_LogWLn(); +} + +static void OPT_FPrintSign (LONGINT *fp, OPT_Struct result, OPT_Object par) +{ + OPT_IdFPrint(result); + OPM_FPrint(&*fp, result->idfp); + while (par != NIL) { + OPM_FPrint(&*fp, par->mode); + OPT_IdFPrint(par->typ); + OPM_FPrint(&*fp, par->typ->idfp); + par = par->link; + } +} + +void OPT_IdFPrint (OPT_Struct typ) +{ + OPT_Struct btyp = NIL; + OPT_Object strobj = NIL; + LONGINT idfp; + INTEGER f, c; + if (!typ->idfpdone) { + typ->idfpdone = 1; + idfp = 0; + f = typ->form; + c = typ->comp; + OPM_FPrint(&idfp, f); + OPM_FPrint(&idfp, c); + btyp = typ->BaseTyp; + strobj = typ->strobj; + if ((strobj != NIL && strobj->name[0] != 0x00)) { + OPT_FPrintName(&idfp, (void*)OPT_GlbMod[__X(typ->mno, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + OPT_FPrintName(&idfp, (void*)strobj->name, ((LONGINT)(256))); + } + if ((f == 13 || (c == 4 && btyp != NIL)) || c == 3) { + OPT_IdFPrint(btyp); + OPM_FPrint(&idfp, btyp->idfp); + } else if (c == 2) { + OPT_IdFPrint(btyp); + OPM_FPrint(&idfp, btyp->idfp); + OPM_FPrint(&idfp, typ->n); + } else if (f == 14) { + OPT_FPrintSign(&idfp, btyp, typ->link); + } + typ->idfp = idfp; + } +} + +static struct FPrintStr__12 { + LONGINT *pbfp, *pvfp; + struct FPrintStr__12 *lnk; +} *FPrintStr__12_s; + +static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible); +static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr); +static void FPrintTProcs__17 (OPT_Object obj); + +static void FPrintHdFld__15 (OPT_Struct typ, OPT_Object fld, LONGINT adr) +{ + LONGINT i, j, n; + OPT_Struct btyp = NIL; + if (typ->comp == 4) { + FPrintFlds__13(typ->link, adr, 0); + } else if (typ->comp == 2) { + btyp = typ->BaseTyp; + n = typ->n; + while (btyp->comp == 2) { + n = btyp->n * n; + btyp = btyp->BaseTyp; + } + if (btyp->form == 13 || btyp->comp == 4) { + j = OPT_nofhdfld; + FPrintHdFld__15(btyp, fld, adr); + if (j != OPT_nofhdfld) { + i = 1; + while ((i < n && OPT_nofhdfld <= 2048)) { + adr += btyp->size; + FPrintHdFld__15(btyp, fld, adr); + i += 1; + } + } + } + } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) { + OPM_FPrint(&*FPrintStr__12_s->pvfp, ((LONGINT)(13))); + OPM_FPrint(&*FPrintStr__12_s->pvfp, adr); + OPT_nofhdfld += 1; + } +} + +static void FPrintFlds__13 (OPT_Object fld, LONGINT adr, BOOLEAN visible) +{ + while ((fld != NIL && fld->mode == 4)) { + if ((fld->vis != 0 && visible)) { + OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->vis); + OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)fld->name, ((LONGINT)(256))); + OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->adr); + OPT_FPrintStr(fld->typ); + OPM_FPrint(&*FPrintStr__12_s->pbfp, fld->typ->pbfp); + OPM_FPrint(&*FPrintStr__12_s->pvfp, fld->typ->pvfp); + } else { + FPrintHdFld__15(fld->typ, fld, fld->adr + adr); + } + fld = fld->link; + } +} + +static void FPrintTProcs__17 (OPT_Object obj) +{ + if (obj != NIL) { + FPrintTProcs__17(obj->left); + if (obj->mode == 13) { + if (obj->vis != 0) { + OPM_FPrint(&*FPrintStr__12_s->pbfp, ((LONGINT)(13))); + OPM_FPrint(&*FPrintStr__12_s->pbfp, __ASHR(obj->adr, 16)); + OPT_FPrintSign(&*FPrintStr__12_s->pbfp, obj->typ, obj->link); + OPT_FPrintName(&*FPrintStr__12_s->pbfp, (void*)obj->name, ((LONGINT)(256))); + } + } + FPrintTProcs__17(obj->right); + } +} + +void OPT_FPrintStr (OPT_Struct typ) +{ + INTEGER f, c; + OPT_Struct btyp = NIL; + OPT_Object strobj = NIL, bstrobj = NIL; + LONGINT pbfp, pvfp; + struct FPrintStr__12 _s; + _s.pbfp = &pbfp; + _s.pvfp = &pvfp; + _s.lnk = FPrintStr__12_s; + FPrintStr__12_s = &_s; + if (!typ->fpdone) { + OPT_IdFPrint(typ); + pbfp = typ->idfp; + if (typ->sysflag != 0) { + OPM_FPrint(&pbfp, typ->sysflag); + } + pvfp = pbfp; + typ->pbfp = pbfp; + typ->pvfp = pvfp; + typ->fpdone = 1; + f = typ->form; + c = typ->comp; + btyp = typ->BaseTyp; + if (f == 13) { + strobj = typ->strobj; + bstrobj = btyp->strobj; + if (((strobj == NIL || strobj->name[0] == 0x00) || bstrobj == NIL) || bstrobj->name[0] == 0x00) { + OPT_FPrintStr(btyp); + OPM_FPrint(&pbfp, btyp->pbfp); + pvfp = pbfp; + } + } else if (f == 14) { + } else if (__IN(c, 0x0c)) { + OPT_FPrintStr(btyp); + OPM_FPrint(&pbfp, btyp->pvfp); + pvfp = pbfp; + } else { + if (btyp != NIL) { + OPT_FPrintStr(btyp); + OPM_FPrint(&pbfp, btyp->pbfp); + OPM_FPrint(&pvfp, btyp->pvfp); + } + OPM_FPrint(&pvfp, typ->size); + OPM_FPrint(&pvfp, typ->align); + OPM_FPrint(&pvfp, typ->n); + OPT_nofhdfld = 0; + FPrintFlds__13(typ->link, ((LONGINT)(0)), 1); + if (OPT_nofhdfld > 2048) { + OPM_Mark(225, typ->txtpos); + } + FPrintTProcs__17(typ->link); + OPM_FPrint(&pvfp, pbfp); + strobj = typ->strobj; + if (strobj == NIL || strobj->name[0] == 0x00) { + pbfp = pvfp; + } + } + typ->pbfp = pbfp; + typ->pvfp = pvfp; + } + FPrintStr__12_s = _s.lnk; +} + +void OPT_FPrintObj (OPT_Object obj) +{ + LONGINT fprint; + INTEGER f, m; + REAL rval; + OPT_ConstExt ext = NIL; + if (!obj->fpdone) { + fprint = 0; + obj->fpdone = 1; + OPM_FPrint(&fprint, obj->mode); + if (obj->mode == 3) { + f = obj->typ->form; + OPM_FPrint(&fprint, f); + switch (f) { + case 2: case 3: case 4: case 5: case 6: + OPM_FPrint(&fprint, obj->conval->intval); + break; + case 9: + OPM_FPrintSet(&fprint, obj->conval->setval); + break; + case 7: + rval = obj->conval->realval; + OPM_FPrintReal(&fprint, rval); + break; + case 8: + OPM_FPrintLReal(&fprint, obj->conval->realval); + break; + case 10: + OPT_FPrintName(&fprint, (void*)*obj->conval->ext, ((LONGINT)(256))); + break; + case 11: + break; + default: + OPT_err(127); + break; + } + } else if (obj->mode == 1) { + OPM_FPrint(&fprint, obj->vis); + OPT_FPrintStr(obj->typ); + OPM_FPrint(&fprint, obj->typ->pbfp); + } else if (__IN(obj->mode, 0x0480)) { + OPT_FPrintSign(&fprint, obj->typ, obj->link); + } else if (obj->mode == 9) { + OPT_FPrintSign(&fprint, obj->typ, obj->link); + ext = obj->conval->ext; + m = (int)(*ext)[0]; + f = 1; + OPM_FPrint(&fprint, m); + while (f <= m) { + OPM_FPrint(&fprint, (int)(*ext)[__X(f, ((LONGINT)(256)))]); + f += 1; + } + } else if (obj->mode == 5) { + OPT_FPrintStr(obj->typ); + OPM_FPrint(&fprint, obj->typ->pbfp); + } + obj->fprint = fprint; + } +} + +void OPT_FPrintErr (OPT_Object obj, INTEGER errcode) +{ + INTEGER i, j; + CHAR ch; + if (obj->mnolev != 0) { + __COPY(OPT_GlbMod[__X(-obj->mnolev, ((LONGINT)(64)))]->name, OPM_objname, ((LONGINT)(64))); + i = 0; + while (OPM_objname[__X(i, ((LONGINT)(64)))] != 0x00) { + i += 1; + } + OPM_objname[__X(i, ((LONGINT)(64)))] = '.'; + j = 0; + i += 1; + do { + ch = obj->name[__X(j, ((LONGINT)(256)))]; + OPM_objname[__X(i, ((LONGINT)(64)))] = ch; + j += 1; + i += 1; + } while (!(ch == 0x00)); + } else { + __COPY(obj->name, OPM_objname, ((LONGINT)(64))); + } + if (errcode == 249) { + if (OPM_noerr) { + OPT_err(errcode); + } + } else if (errcode == 253) { + if ((((!OPT_symNew && !OPT_symExtended)) && !OPT_extsf)) { + OPT_err(errcode); + } + OPT_symExtended = 1; + } else { + if ((!OPT_symNew && !OPT_newsf)) { + OPT_err(errcode); + } + OPT_symNew = 1; + } +} + +void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old) +{ + OPT_Object ob0 = NIL, ob1 = NIL; + BOOLEAN left; + if (*root == NIL) { + *root = obj; + *old = NIL; + } else { + ob0 = *root; + ob1 = ob0->right; + left = 0; + if (__STRCMP(obj->name, ob0->name) < 0) { + ob1 = ob0->left; + left = 1; + } else if (__STRCMP(obj->name, ob0->name) > 0) { + ob1 = ob0->right; + left = 0; + } else { + *old = ob0; + return; + } + for (;;) { + if (ob1 != NIL) { + if (__STRCMP(obj->name, ob1->name) < 0) { + ob0 = ob1; + ob1 = ob1->left; + left = 1; + } else if (__STRCMP(obj->name, ob1->name) > 0) { + ob0 = ob1; + ob1 = ob1->right; + left = 0; + } else { + *old = ob1; + break; + } + } else { + ob1 = obj; + if (left) { + ob0->left = ob1; + } else { + ob0->right = ob1; + } + ob1->left = NIL; + ob1->right = NIL; + *old = NIL; + break; + } + } + } +} + +static void OPT_InName (CHAR *name, LONGINT name__len) +{ + INTEGER i; + CHAR ch; + i = 0; + do { + OPM_SymRCh(&ch); + name[__X(i, name__len)] = ch; + i += 1; + } while (!(ch == 0x00)); +} + +static void OPT_InMod (SHORTINT *mno) +{ + OPT_Object head = NIL; + OPS_Name name; + LONGINT mn; + SHORTINT i; + mn = OPM_SymRInt(); + if (mn == 0) { + *mno = OPT_impCtxt.glbmno[0]; + } else { + if (mn == 16) { + OPT_InName((void*)name, ((LONGINT)(256))); + if ((__STRCMP(name, OPT_SelfName) == 0 && !OPT_impCtxt.self)) { + OPT_err(154); + } + i = 0; + while ((i < OPT_nofGmod && __STRCMP(name, OPT_GlbMod[__X(i, ((LONGINT)(64)))]->name) != 0)) { + i += 1; + } + if (i < OPT_nofGmod) { + *mno = i; + } else { + head = OPT_NewObj(); + head->mode = 12; + __COPY(name, head->name, ((LONGINT)(256))); + *mno = OPT_nofGmod; + head->mnolev = -*mno; + if (OPT_nofGmod < 64) { + OPT_GlbMod[__X(*mno, ((LONGINT)(64)))] = head; + OPT_nofGmod += 1; + } else { + OPT_err(227); + } + } + OPT_impCtxt.glbmno[__X(OPT_impCtxt.nofm, ((LONGINT)(64)))] = *mno; + OPT_impCtxt.nofm += 1; + } else { + *mno = OPT_impCtxt.glbmno[__X(-mn, ((LONGINT)(64)))]; + } + } +} + +static void OPT_InConstant (LONGINT f, OPT_Const conval) +{ + CHAR ch; + INTEGER i; + OPT_ConstExt ext = NIL; + REAL rval; + switch (f) { + case 1: case 3: case 2: + OPM_SymRCh(&ch); + conval->intval = (int)ch; + break; + case 4: case 5: case 6: + conval->intval = OPM_SymRInt(); + break; + case 9: + OPM_SymRSet(&conval->setval); + break; + case 7: + OPM_SymRReal(&rval); + conval->realval = rval; + conval->intval = -1; + break; + case 8: + OPM_SymRLReal(&conval->realval); + conval->intval = -1; + break; + case 10: + ext = OPT_NewExt(); + conval->ext = ext; + i = 0; + do { + OPM_SymRCh(&ch); + (*ext)[__X(i, ((LONGINT)(256)))] = ch; + i += 1; + } while (!(ch == 0x00)); + conval->intval2 = i; + conval->intval = -1; + break; + case 11: + conval->intval = 0; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPT.InConstant(), f = ", (LONGINT)41); + OPM_LogWNum(f, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } +} + +static void OPT_InSign (SHORTINT mno, OPT_Struct *res, OPT_Object *par) +{ + OPT_Object last = NIL, new = NIL; + LONGINT tag; + OPT_InStruct(&*res); + tag = OPM_SymRInt(); + last = NIL; + while (tag != 18) { + new = OPT_NewObj(); + new->mnolev = -mno; + if (last == NIL) { + *par = new; + } else { + last->link = new; + } + if (tag == 23) { + new->mode = 1; + } else { + new->mode = 2; + } + OPT_InStruct(&new->typ); + new->adr = OPM_SymRInt(); + OPT_InName((void*)new->name, ((LONGINT)(256))); + last = new; + tag = OPM_SymRInt(); + } +} + +static OPT_Object OPT_InFld (void) +{ + OPT_Object _o_result; + LONGINT tag; + OPT_Object obj = NIL; + tag = OPT_impCtxt.nextTag; + obj = OPT_NewObj(); + if (tag <= 26) { + obj->mode = 4; + if (tag == 26) { + obj->vis = 2; + } else { + obj->vis = 1; + } + OPT_InStruct(&obj->typ); + OPT_InName((void*)obj->name, ((LONGINT)(256))); + obj->adr = OPM_SymRInt(); + } else { + obj->mode = 4; + if (tag == 27) { + __MOVE("@ptr", obj->name, 5); + } else { + __MOVE("@proc", obj->name, 6); + } + obj->typ = OPT_undftyp; + obj->vis = 0; + obj->adr = OPM_SymRInt(); + } + _o_result = obj; + return _o_result; +} + +static OPT_Object OPT_InTProc (SHORTINT mno) +{ + OPT_Object _o_result; + LONGINT tag; + OPT_Object obj = NIL; + tag = OPT_impCtxt.nextTag; + obj = OPT_NewObj(); + obj->mnolev = -mno; + if (tag == 29) { + obj->mode = 13; + obj->conval = OPT_NewConst(); + obj->conval->intval = -1; + OPT_InSign(mno, &obj->typ, &obj->link); + obj->vis = 1; + OPT_InName((void*)obj->name, ((LONGINT)(256))); + obj->adr = __ASHL(OPM_SymRInt(), 16); + } else { + obj->mode = 13; + __MOVE("@tproc", obj->name, 7); + obj->link = OPT_NewObj(); + obj->typ = OPT_undftyp; + obj->vis = 0; + obj->adr = __ASHL(OPM_SymRInt(), 16); + } + _o_result = obj; + return _o_result; +} + +static void OPT_InStruct (OPT_Struct *typ) +{ + SHORTINT mno; + INTEGER ref; + LONGINT tag; + OPS_Name name; + OPT_Struct t = NIL; + OPT_Object obj = NIL, last = NIL, fld = NIL, old = NIL, dummy = NIL; + tag = OPM_SymRInt(); + if (tag != 34) { + *typ = OPT_impCtxt.ref[__X(-tag, ((LONGINT)(255)))]; + } else { + ref = OPT_impCtxt.nofr; + OPT_impCtxt.nofr += 1; + if (ref < OPT_impCtxt.minr) { + OPT_impCtxt.minr = ref; + } + OPT_InMod(&mno); + OPT_InName((void*)name, ((LONGINT)(256))); + obj = OPT_NewObj(); + if (name[0] == 0x00) { + if (OPT_impCtxt.self) { + old = NIL; + } else { + __MOVE("@", obj->name, 2); + OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old); + obj->name[0] = 0x00; + } + *typ = OPT_NewStr(0, 1); + } else { + __COPY(name, obj->name, ((LONGINT)(256))); + OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old); + if (old != NIL) { + OPT_FPrintObj(old); + OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] = old->typ->pvfp; + if (OPT_impCtxt.self) { + *typ = OPT_NewStr(0, 1); + } else { + *typ = old->typ; + (*typ)->link = NIL; + (*typ)->sysflag = 0; + (*typ)->fpdone = 0; + (*typ)->idfpdone = 0; + } + } else { + *typ = OPT_NewStr(0, 1); + } + } + OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))] = *typ; + OPT_impCtxt.old[__X(ref, ((LONGINT)(255)))] = old; + (*typ)->ref = ref + 255; + (*typ)->mno = mno; + (*typ)->allocated = 1; + (*typ)->strobj = obj; + obj->mode = 5; + obj->typ = *typ; + obj->mnolev = -mno; + obj->vis = 0; + tag = OPM_SymRInt(); + if (tag == 35) { + (*typ)->sysflag = (int)OPM_SymRInt(); + tag = OPM_SymRInt(); + } + switch (tag) { + case 36: + (*typ)->form = 13; + (*typ)->size = OPM_PointerSize; + (*typ)->n = 0; + OPT_InStruct(&(*typ)->BaseTyp); + break; + case 37: + (*typ)->form = 15; + (*typ)->comp = 2; + OPT_InStruct(&(*typ)->BaseTyp); + (*typ)->n = OPM_SymRInt(); + (*OPT_typSize)(*typ); + break; + case 38: + (*typ)->form = 15; + (*typ)->comp = 3; + OPT_InStruct(&(*typ)->BaseTyp); + if ((*typ)->BaseTyp->comp == 3) { + (*typ)->n = (*typ)->BaseTyp->n + 1; + } else { + (*typ)->n = 0; + } + (*OPT_typSize)(*typ); + break; + case 39: + (*typ)->form = 15; + (*typ)->comp = 4; + OPT_InStruct(&(*typ)->BaseTyp); + if ((*typ)->BaseTyp == OPT_notyp) { + (*typ)->BaseTyp = NIL; + } + (*typ)->extlev = 0; + t = (*typ)->BaseTyp; + while (t != NIL) { + (*typ)->extlev += 1; + t = t->BaseTyp; + } + (*typ)->size = OPM_SymRInt(); + (*typ)->align = OPM_SymRInt(); + (*typ)->n = OPM_SymRInt(); + OPT_impCtxt.nextTag = OPM_SymRInt(); + last = NIL; + while ((OPT_impCtxt.nextTag >= 25 && OPT_impCtxt.nextTag <= 28)) { + fld = OPT_InFld(); + fld->mnolev = -mno; + if (last != NIL) { + last->link = fld; + } + last = fld; + OPT_InsertImport(fld, &(*typ)->link, &dummy); + OPT_impCtxt.nextTag = OPM_SymRInt(); + } + while (OPT_impCtxt.nextTag != 18) { + fld = OPT_InTProc(mno); + OPT_InsertImport(fld, &(*typ)->link, &dummy); + OPT_impCtxt.nextTag = OPM_SymRInt(); + } + break; + case 40: + (*typ)->form = 14; + (*typ)->size = OPM_ProcSize; + OPT_InSign(mno, &(*typ)->BaseTyp, &(*typ)->link); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.InStruct, tag = ", (LONGINT)39); + OPM_LogWNum(tag, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + if (ref == OPT_impCtxt.minr) { + while (ref < OPT_impCtxt.nofr) { + t = OPT_impCtxt.ref[__X(ref, ((LONGINT)(255)))]; + OPT_FPrintStr(t); + obj = t->strobj; + if (obj->name[0] != 0x00) { + OPT_FPrintObj(obj); + } + old = OPT_impCtxt.old[__X(ref, ((LONGINT)(255)))]; + if (old != NIL) { + t->strobj = old; + if (OPT_impCtxt.self) { + if (old->mnolev < 0) { + if (old->history != 5) { + if (old->fprint != obj->fprint) { + old->history = 2; + } else if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) { + old->history = 3; + } + } + } else if (old->fprint != obj->fprint) { + old->history = 2; + } else if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) { + old->history = 3; + } else if (old->vis == 0) { + old->history = 1; + } else { + old->history = 0; + } + } else { + if (OPT_impCtxt.pvfp[__X(ref, ((LONGINT)(255)))] != t->pvfp) { + old->history = 5; + } + if (old->fprint != obj->fprint) { + OPT_FPrintErr(old, 249); + } + } + } else if (OPT_impCtxt.self) { + obj->history = 4; + } else { + obj->history = 1; + } + ref += 1; + } + OPT_impCtxt.minr = 255; + } + } +} + +static OPT_Object OPT_InObj (SHORTINT mno) +{ + OPT_Object _o_result; + INTEGER i, s; + CHAR ch; + OPT_Object obj = NIL, old = NIL; + OPT_Struct typ = NIL; + LONGINT tag; + OPT_ConstExt ext = NIL; + tag = OPT_impCtxt.nextTag; + if (tag == 19) { + OPT_InStruct(&typ); + obj = typ->strobj; + if (!OPT_impCtxt.self) { + obj->vis = 1; + } + } else { + obj = OPT_NewObj(); + obj->mnolev = -mno; + obj->vis = 1; + if (tag <= 13) { + obj->mode = 3; + obj->typ = OPT_impCtxt.ref[__X(tag, ((LONGINT)(255)))]; + obj->conval = OPT_NewConst(); + OPT_InConstant(tag, obj->conval); + } else if (tag >= 31) { + obj->conval = OPT_NewConst(); + obj->conval->intval = -1; + OPT_InSign(mno, &obj->typ, &obj->link); + switch (tag) { + case 31: + obj->mode = 7; + break; + case 32: + obj->mode = 10; + break; + case 33: + obj->mode = 9; + ext = OPT_NewExt(); + obj->conval->ext = ext; + s = (int)OPM_SymRInt(); + (*ext)[0] = (CHAR)s; + i = 1; + while (i <= s) { + OPM_SymRCh(&(*ext)[__X(i, ((LONGINT)(256)))]); + i += 1; + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.InObj, tag = ", (LONGINT)36); + OPM_LogWNum(tag, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } else if (tag == 20) { + obj->mode = 5; + OPT_InStruct(&obj->typ); + } else { + obj->mode = 1; + if (tag == 22) { + obj->vis = 2; + } + OPT_InStruct(&obj->typ); + } + OPT_InName((void*)obj->name, ((LONGINT)(256))); + } + OPT_FPrintObj(obj); + if ((obj->mode == 1 && (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00))) { + OPM_FPrint(&OPT_impCtxt.reffp, obj->typ->ref - 255); + } + if (tag != 19) { + OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right, &old); + if (OPT_impCtxt.self) { + if (old != NIL) { + if (old->vis == 0) { + old->history = 4; + } else { + OPT_FPrintObj(old); + if (obj->fprint != old->fprint) { + old->history = 2; + } else if (obj->typ->pvfp != old->typ->pvfp) { + old->history = 3; + } else { + old->history = 1; + } + } + } else { + obj->history = 4; + } + } + } else { + if (OPT_impCtxt.self) { + if (obj->vis == 0) { + obj->history = 4; + } else if (obj->history == 0) { + obj->history = 1; + } + } + } + _o_result = obj; + return _o_result; +} + +void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done) +{ + OPT_Object obj = NIL; + SHORTINT mno; + OPS_Name aliasName__copy; + __DUPARR(aliasName, OPS_Name); + if (__STRCMP(name, "SYSTEM") == 0) { + OPT_SYSimported = 1; + OPT_Insert(aliasName, &obj); + obj->mode = 11; + obj->mnolev = 0; + obj->scope = OPT_syslink; + obj->typ = OPT_notyp; + } else { + OPT_impCtxt.nofr = 16; + OPT_impCtxt.minr = 255; + OPT_impCtxt.nofm = 0; + OPT_impCtxt.self = __STRCMP(aliasName, "@self") == 0; + OPT_impCtxt.reffp = 0; + OPM_OldSym((void*)name, ((LONGINT)(256)), &*done); + if (*done) { + OPT_InMod(&mno); + OPT_impCtxt.nextTag = OPM_SymRInt(); + while (!OPM_eofSF()) { + obj = OPT_InObj(mno); + OPT_impCtxt.nextTag = OPM_SymRInt(); + } + OPT_Insert(aliasName, &obj); + obj->mode = 11; + obj->scope = OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->right; + OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->link = obj; + obj->mnolev = -mno; + obj->typ = OPT_notyp; + OPM_CloseOldSym(); + } else if (OPT_impCtxt.self) { + OPT_newsf = 1; + OPT_extsf = 1; + OPT_sfpresent = 0; + } else { + OPT_err(152); + } + } +} + +static void OPT_OutName (CHAR *name, LONGINT name__len) +{ + INTEGER i; + CHAR ch; + i = 0; + do { + ch = name[__X(i, name__len)]; + OPM_SymWCh(ch); + i += 1; + } while (!(ch == 0x00)); +} + +static void OPT_OutMod (INTEGER mno) +{ + if (OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))] < 0) { + OPM_SymWInt(((LONGINT)(16))); + OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))] = OPT_expCtxt.nofm; + OPT_expCtxt.nofm += 1; + OPT_OutName((void*)OPT_GlbMod[__X(mno, ((LONGINT)(64)))]->name, ((LONGINT)(256))); + } else { + OPM_SymWInt(-OPT_expCtxt.locmno[__X(mno, ((LONGINT)(64)))]); + } +} + +static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, LONGINT adr) +{ + LONGINT i, j, n; + OPT_Struct btyp = NIL; + if (typ->comp == 4) { + OPT_OutFlds(typ->link, adr, 0); + } else if (typ->comp == 2) { + btyp = typ->BaseTyp; + n = typ->n; + while (btyp->comp == 2) { + n = btyp->n * n; + btyp = btyp->BaseTyp; + } + if (btyp->form == 13 || btyp->comp == 4) { + j = OPT_nofhdfld; + OPT_OutHdFld(btyp, fld, adr); + if (j != OPT_nofhdfld) { + i = 1; + while ((i < n && OPT_nofhdfld <= 2048)) { + adr += btyp->size; + OPT_OutHdFld(btyp, fld, adr); + i += 1; + } + } + } + } else if (typ->form == 13 || __STRCMP(fld->name, "@ptr") == 0) { + OPM_SymWInt(((LONGINT)(27))); + OPM_SymWInt(adr); + OPT_nofhdfld += 1; + } +} + +static void OPT_OutFlds (OPT_Object fld, LONGINT adr, BOOLEAN visible) +{ + while ((fld != NIL && fld->mode == 4)) { + if ((fld->vis != 0 && visible)) { + if (fld->vis == 2) { + OPM_SymWInt(((LONGINT)(26))); + } else { + OPM_SymWInt(((LONGINT)(25))); + } + OPT_OutStr(fld->typ); + OPT_OutName((void*)fld->name, ((LONGINT)(256))); + OPM_SymWInt(fld->adr); + } else { + OPT_OutHdFld(fld->typ, fld, fld->adr + adr); + } + fld = fld->link; + } +} + +static void OPT_OutSign (OPT_Struct result, OPT_Object par) +{ + OPT_OutStr(result); + while (par != NIL) { + if (par->mode == 1) { + OPM_SymWInt(((LONGINT)(23))); + } else { + OPM_SymWInt(((LONGINT)(24))); + } + OPT_OutStr(par->typ); + OPM_SymWInt(par->adr); + OPT_OutName((void*)par->name, ((LONGINT)(256))); + par = par->link; + } + OPM_SymWInt(((LONGINT)(18))); +} + +static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj) +{ + if (obj != NIL) { + OPT_OutTProcs(typ, obj->left); + if (obj->mode == 13) { + if ((((typ->BaseTyp != NIL && __ASHR(obj->adr, 16) < typ->BaseTyp->n)) && obj->vis == 0)) { + OPM_Mark(109, typ->txtpos); + } + if (obj->vis != 0) { + if (obj->vis != 0) { + OPM_SymWInt(((LONGINT)(29))); + OPT_OutSign(obj->typ, obj->link); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + OPM_SymWInt(__ASHR(obj->adr, 16)); + } else { + OPM_SymWInt(((LONGINT)(30))); + OPM_SymWInt(__ASHR(obj->adr, 16)); + } + } + } + OPT_OutTProcs(typ, obj->right); + } +} + +static void OPT_OutStr (OPT_Struct typ) +{ + OPT_Object strobj = NIL; + if (typ->ref < OPT_expCtxt.ref) { + OPM_SymWInt(-typ->ref); + } else { + OPM_SymWInt(((LONGINT)(34))); + typ->ref = OPT_expCtxt.ref; + OPT_expCtxt.ref += 1; + if (OPT_expCtxt.ref >= 255) { + OPT_err(228); + } + OPT_OutMod(typ->mno); + strobj = typ->strobj; + if ((strobj != NIL && strobj->name[0] != 0x00)) { + OPT_OutName((void*)strobj->name, ((LONGINT)(256))); + switch (strobj->history) { + case 2: + OPT_FPrintErr(strobj, 252); + break; + case 3: + OPT_FPrintErr(strobj, 251); + break; + case 5: + OPT_FPrintErr(strobj, 249); + break; + default: + break; + } + } else { + OPM_SymWCh(0x00); + } + if (typ->sysflag != 0) { + OPM_SymWInt(((LONGINT)(35))); + OPM_SymWInt(typ->sysflag); + } + switch (typ->form) { + case 13: + OPM_SymWInt(((LONGINT)(36))); + OPT_OutStr(typ->BaseTyp); + break; + case 14: + OPM_SymWInt(((LONGINT)(40))); + OPT_OutSign(typ->BaseTyp, typ->link); + break; + case 15: + switch (typ->comp) { + case 2: + OPM_SymWInt(((LONGINT)(37))); + OPT_OutStr(typ->BaseTyp); + OPM_SymWInt(typ->n); + break; + case 3: + OPM_SymWInt(((LONGINT)(38))); + OPT_OutStr(typ->BaseTyp); + break; + case 4: + OPM_SymWInt(((LONGINT)(39))); + if (typ->BaseTyp == NIL) { + OPT_OutStr(OPT_notyp); + } else { + OPT_OutStr(typ->BaseTyp); + } + OPM_SymWInt(typ->size); + OPM_SymWInt(typ->align); + OPM_SymWInt(typ->n); + OPT_nofhdfld = 0; + OPT_OutFlds(typ->link, ((LONGINT)(0)), 1); + if (OPT_nofhdfld > 2048) { + OPM_Mark(223, typ->txtpos); + } + OPT_OutTProcs(typ, typ->link); + OPM_SymWInt(((LONGINT)(18))); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.OutStr, typ^.comp = ", (LONGINT)43); + OPM_LogWNum(typ->comp, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.OutStr, typ^.form = ", (LONGINT)43); + OPM_LogWNum(typ->form, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } +} + +static void OPT_OutConstant (OPT_Object obj) +{ + INTEGER f; + REAL rval; + f = obj->typ->form; + OPM_SymWInt(f); + switch (f) { + case 2: case 3: + OPM_SymWCh((CHAR)obj->conval->intval); + break; + case 4: case 5: case 6: + OPM_SymWInt(obj->conval->intval); + break; + case 9: + OPM_SymWSet(obj->conval->setval); + break; + case 7: + rval = obj->conval->realval; + OPM_SymWReal(rval); + break; + case 8: + OPM_SymWLReal(obj->conval->realval); + break; + case 10: + OPT_OutName((void*)*obj->conval->ext, ((LONGINT)(256))); + break; + case 11: + break; + default: + OPT_err(127); + break; + } +} + +static void OPT_OutObj (OPT_Object obj) +{ + INTEGER i, j; + OPT_ConstExt ext = NIL; + if (obj != NIL) { + OPT_OutObj(obj->left); + if (__IN(obj->mode, 0x06ea)) { + if (obj->history == 4) { + OPT_FPrintErr(obj, 250); + } else if (obj->vis != 0) { + switch (obj->history) { + case 0: + OPT_FPrintErr(obj, 253); + break; + case 1: + break; + case 2: + OPT_FPrintErr(obj, 252); + break; + case 3: + OPT_FPrintErr(obj, 251); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.OutObj, obj^.history = ", (LONGINT)46); + OPM_LogWNum(obj->history, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + switch (obj->mode) { + case 3: + OPT_OutConstant(obj); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + break; + case 5: + if (obj->typ->strobj == obj) { + OPM_SymWInt(((LONGINT)(19))); + OPT_OutStr(obj->typ); + } else { + OPM_SymWInt(((LONGINT)(20))); + OPT_OutStr(obj->typ); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + } + break; + case 1: + if (obj->vis == 2) { + OPM_SymWInt(((LONGINT)(22))); + } else { + OPM_SymWInt(((LONGINT)(21))); + } + OPT_OutStr(obj->typ); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + if (obj->typ->strobj == NIL || obj->typ->strobj->name[0] == 0x00) { + OPM_FPrint(&OPT_expCtxt.reffp, obj->typ->ref); + } + break; + case 7: + OPM_SymWInt(((LONGINT)(31))); + OPT_OutSign(obj->typ, obj->link); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + break; + case 10: + OPM_SymWInt(((LONGINT)(32))); + OPT_OutSign(obj->typ, obj->link); + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + break; + case 9: + OPM_SymWInt(((LONGINT)(33))); + OPT_OutSign(obj->typ, obj->link); + ext = obj->conval->ext; + j = (int)(*ext)[0]; + i = 1; + OPM_SymWInt(j); + while (i <= j) { + OPM_SymWCh((*ext)[__X(i, ((LONGINT)(256)))]); + i += 1; + } + OPT_OutName((void*)obj->name, ((LONGINT)(256))); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case at OPT.OutObj, obj.mode = ", (LONGINT)42); + OPM_LogWNum(obj->mode, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + } + } + OPT_OutObj(obj->right); + } +} + +void OPT_Export (BOOLEAN *ext, BOOLEAN *new) +{ + INTEGER i; + SHORTINT nofmod; + BOOLEAN done; + OPT_symExtended = 0; + OPT_symNew = 0; + nofmod = OPT_nofGmod; + OPT_Import((CHAR*)"@self", OPT_SelfName, &done); + OPT_nofGmod = nofmod; + if (OPM_noerr) { + OPM_NewSym((void*)OPT_SelfName, ((LONGINT)(256))); + if (OPM_noerr) { + OPM_SymWInt(((LONGINT)(16))); + OPT_OutName((void*)OPT_SelfName, ((LONGINT)(256))); + OPT_expCtxt.reffp = 0; + OPT_expCtxt.ref = 16; + OPT_expCtxt.nofm = 1; + OPT_expCtxt.locmno[0] = 0; + i = 1; + while (i < 64) { + OPT_expCtxt.locmno[__X(i, ((LONGINT)(64)))] = -1; + i += 1; + } + OPT_OutObj(OPT_topScope->right); + *ext = (OPT_sfpresent && OPT_symExtended); + *new = !OPT_sfpresent || OPT_symNew; + if (OPM_forceNewSym) { + *new = 1; + } + if ((((OPM_noerr && OPT_sfpresent)) && OPT_impCtxt.reffp != OPT_expCtxt.reffp)) { + *new = 1; + if (!OPT_extsf) { + OPT_err(155); + } + } + OPT_newsf = 0; + OPT_symNew = 0; + if (!OPM_noerr || OPT_findpc) { + OPM_DeleteNewSym(); + } + } + } +} + +static void OPT_InitStruct (OPT_Struct *typ, SHORTINT form) +{ + *typ = OPT_NewStr(form, 1); + (*typ)->ref = form; + (*typ)->size = OPM_ByteSize; + (*typ)->allocated = 1; + (*typ)->strobj = OPT_NewObj(); + (*typ)->pbfp = form; + (*typ)->pvfp = form; + (*typ)->fpdone = 1; + (*typ)->idfp = form; + (*typ)->idfpdone = 1; +} + +static void OPT_EnterBoolConst (OPS_Name name, LONGINT value) +{ + OPT_Object obj = NIL; + OPS_Name name__copy; + __DUPARR(name, OPS_Name); + OPT_Insert(name, &obj); + obj->conval = OPT_NewConst(); + obj->mode = 3; + obj->typ = OPT_booltyp; + obj->conval->intval = value; +} + +static void OPT_EnterTyp (OPS_Name name, SHORTINT form, INTEGER size, OPT_Struct *res) +{ + OPT_Object obj = NIL; + OPT_Struct typ = NIL; + OPS_Name name__copy; + __DUPARR(name, OPS_Name); + OPT_Insert(name, &obj); + typ = OPT_NewStr(form, 1); + obj->mode = 5; + obj->typ = typ; + obj->vis = 1; + typ->strobj = obj; + typ->size = size; + typ->ref = form; + typ->allocated = 1; + typ->pbfp = form; + typ->pvfp = form; + typ->fpdone = 1; + typ->idfp = form; + typ->idfpdone = 1; + *res = typ; +} + +static void OPT_EnterProc (OPS_Name name, INTEGER num) +{ + OPT_Object obj = NIL; + OPS_Name name__copy; + __DUPARR(name, OPS_Name); + OPT_Insert(name, &obj); + obj->mode = 8; + obj->typ = OPT_notyp; + obj->adr = num; +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(OPT_topScope); + P(OPT_undftyp); + P(OPT_bytetyp); + P(OPT_booltyp); + P(OPT_chartyp); + P(OPT_sinttyp); + P(OPT_inttyp); + P(OPT_linttyp); + P(OPT_realtyp); + P(OPT_lrltyp); + P(OPT_settyp); + P(OPT_stringtyp); + P(OPT_niltyp); + P(OPT_notyp); + P(OPT_sysptrtyp); + __ENUMP(OPT_GlbMod, 64, P); + P(OPT_universe); + P(OPT_syslink); + __ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 6216, 1, P); +} + +__TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 40), {0, -16}}; +__TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 344), {0, 8, 16, 24, 304, 312, -56}}; +__TDESC(OPT_StrDesc, 1, 3) = {__TDFLDS("StrDesc", 104), {80, 88, 96, -32}}; +__TDESC(OPT_NodeDesc, 1, 6) = {__TDFLDS("NodeDesc", 56), {0, 8, 16, 32, 40, 48, -56}}; +__TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 6216), {32, 40, 48, 56, 64, 72, 80, 88, 96, 104, 112, 120, 128, 136, 144, 152, + 160, 168, 176, 184, 192, 200, 208, 216, 224, 232, 240, 248, 256, 264, 272, 280, + 288, 296, 304, 312, 320, 328, 336, 344, 352, 360, 368, 376, 384, 392, 400, 408, + 416, 424, 432, 440, 448, 456, 464, 472, 480, 488, 496, 504, 512, 520, 528, 536, + 544, 552, 560, 568, 576, 584, 592, 600, 608, 616, 624, 632, 640, 648, 656, 664, + 672, 680, 688, 696, 704, 712, 720, 728, 736, 744, 752, 760, 768, 776, 784, 792, + 800, 808, 816, 824, 832, 840, 848, 856, 864, 872, 880, 888, 896, 904, 912, 920, + 928, 936, 944, 952, 960, 968, 976, 984, 992, 1000, 1008, 1016, 1024, 1032, 1040, 1048, + 1056, 1064, 1072, 1080, 1088, 1096, 1104, 1112, 1120, 1128, 1136, 1144, 1152, 1160, 1168, 1176, + 1184, 1192, 1200, 1208, 1216, 1224, 1232, 1240, 1248, 1256, 1264, 1272, 1280, 1288, 1296, 1304, + 1312, 1320, 1328, 1336, 1344, 1352, 1360, 1368, 1376, 1384, 1392, 1400, 1408, 1416, 1424, 1432, + 1440, 1448, 1456, 1464, 1472, 1480, 1488, 1496, 1504, 1512, 1520, 1528, 1536, 1544, 1552, 1560, + 1568, 1576, 1584, 1592, 1600, 1608, 1616, 1624, 1632, 1640, 1648, 1656, 1664, 1672, 1680, 1688, + 1696, 1704, 1712, 1720, 1728, 1736, 1744, 1752, 1760, 1768, 1776, 1784, 1792, 1800, 1808, 1816, + 1824, 1832, 1840, 1848, 1856, 1864, 1872, 1880, 1888, 1896, 1904, 1912, 1920, 1928, 1936, 1944, + 1952, 1960, 1968, 1976, 1984, 1992, 2000, 2008, 2016, 2024, 2032, 2040, 2048, 2056, 2064, 2072, + 2080, 2088, 2096, 2104, 2112, 2120, 2128, 2136, 2144, 2152, 2160, 2168, 2176, 2184, 2192, 2200, + 2208, 2216, 2224, 2232, 2240, 2248, 2256, 2264, 2272, 2280, 2288, 2296, 2304, 2312, 2320, 2328, + 2336, 2344, 2352, 2360, 2368, 2376, 2384, 2392, 2400, 2408, 2416, 2424, 2432, 2440, 2448, 2456, + 2464, 2472, 2480, 2488, 2496, 2504, 2512, 2520, 2528, 2536, 2544, 2552, 2560, 2568, 2576, 2584, + 2592, 2600, 2608, 2616, 2624, 2632, 2640, 2648, 2656, 2664, 2672, 2680, 2688, 2696, 2704, 2712, + 2720, 2728, 2736, 2744, 2752, 2760, 2768, 2776, 2784, 2792, 2800, 2808, 2816, 2824, 2832, 2840, + 2848, 2856, 2864, 2872, 2880, 2888, 2896, 2904, 2912, 2920, 2928, 2936, 2944, 2952, 2960, 2968, + 2976, 2984, 2992, 3000, 3008, 3016, 3024, 3032, 3040, 3048, 3056, 3064, 3072, 3080, 3088, 3096, + 3104, 3112, 3120, 3128, 3136, 3144, 3152, 3160, 3168, 3176, 3184, 3192, 3200, 3208, 3216, 3224, + 3232, 3240, 3248, 3256, 3264, 3272, 3280, 3288, 3296, 3304, 3312, 3320, 3328, 3336, 3344, 3352, + 3360, 3368, 3376, 3384, 3392, 3400, 3408, 3416, 3424, 3432, 3440, 3448, 3456, 3464, 3472, 3480, + 3488, 3496, 3504, 3512, 3520, 3528, 3536, 3544, 3552, 3560, 3568, 3576, 3584, 3592, 3600, 3608, + 3616, 3624, 3632, 3640, 3648, 3656, 3664, 3672, 3680, 3688, 3696, 3704, 3712, 3720, 3728, 3736, + 3744, 3752, 3760, 3768, 3776, 3784, 3792, 3800, 3808, 3816, 3824, 3832, 3840, 3848, 3856, 3864, + 3872, 3880, 3888, 3896, 3904, 3912, 3920, 3928, 3936, 3944, 3952, 3960, 3968, 3976, 3984, 3992, + 4000, 4008, 4016, 4024, 4032, 4040, 4048, 4056, 4064, 4072, 4080, 4088, 4096, 4104, -4088}}; +__TDESC(OPT_ExpCtxt, 1, 0) = {__TDFLDS("ExpCtxt", 80), {-8}}; + +export void *OPT__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPS); + __REGMOD("OPT", EnumPtrs); + __REGCMD("Close", OPT_Close); + __REGCMD("CloseScope", OPT_CloseScope); + __INITYP(OPT_ConstDesc, OPT_ConstDesc, 0); + __INITYP(OPT_ObjDesc, OPT_ObjDesc, 0); + __INITYP(OPT_StrDesc, OPT_StrDesc, 0); + __INITYP(OPT_NodeDesc, OPT_NodeDesc, 0); + __INITYP(OPT_ImpCtxt, OPT_ImpCtxt, 0); + __INITYP(OPT_ExpCtxt, OPT_ExpCtxt, 0); +/* BEGIN */ + OPT_topScope = NIL; + OPT_OpenScope(0, NIL); + OPM_errpos = 0; + OPT_InitStruct(&OPT_undftyp, 0); + OPT_InitStruct(&OPT_notyp, 12); + OPT_InitStruct(&OPT_stringtyp, 10); + OPT_InitStruct(&OPT_niltyp, 11); + OPT_undftyp->BaseTyp = OPT_undftyp; + OPT_EnterTyp((CHAR*)"BYTE", 1, OPM_ByteSize, &OPT_bytetyp); + OPT_EnterTyp((CHAR*)"PTR", 13, OPM_PointerSize, &OPT_sysptrtyp); + OPT_EnterProc((CHAR*)"ADR", 20); + OPT_EnterProc((CHAR*)"CC", 21); + OPT_EnterProc((CHAR*)"LSH", 22); + OPT_EnterProc((CHAR*)"ROT", 23); + OPT_EnterProc((CHAR*)"GET", 24); + OPT_EnterProc((CHAR*)"PUT", 25); + OPT_EnterProc((CHAR*)"GETREG", 26); + OPT_EnterProc((CHAR*)"PUTREG", 27); + OPT_EnterProc((CHAR*)"BIT", 28); + OPT_EnterProc((CHAR*)"VAL", 29); + OPT_EnterProc((CHAR*)"NEW", 30); + OPT_EnterProc((CHAR*)"MOVE", 31); + OPT_syslink = OPT_topScope->right; + OPT_universe = OPT_topScope; + OPT_topScope->right = NIL; + OPT_EnterTyp((CHAR*)"CHAR", 3, OPM_CharSize, &OPT_chartyp); + OPT_EnterTyp((CHAR*)"SET", 9, OPM_SetSize, &OPT_settyp); + OPT_EnterTyp((CHAR*)"REAL", 7, OPM_RealSize, &OPT_realtyp); + OPT_EnterTyp((CHAR*)"INTEGER", 5, OPM_IntSize, &OPT_inttyp); + OPT_EnterTyp((CHAR*)"LONGINT", 6, OPM_LIntSize, &OPT_linttyp); + OPT_EnterTyp((CHAR*)"LONGREAL", 8, OPM_LRealSize, &OPT_lrltyp); + OPT_EnterTyp((CHAR*)"SHORTINT", 4, OPM_SIntSize, &OPT_sinttyp); + OPT_EnterTyp((CHAR*)"BOOLEAN", 2, OPM_BoolSize, &OPT_booltyp); + OPT_EnterBoolConst((CHAR*)"FALSE", ((LONGINT)(0))); + OPT_EnterBoolConst((CHAR*)"TRUE", ((LONGINT)(1))); + OPT_EnterProc((CHAR*)"HALT", 0); + OPT_EnterProc((CHAR*)"NEW", 1); + OPT_EnterProc((CHAR*)"ABS", 2); + OPT_EnterProc((CHAR*)"CAP", 3); + OPT_EnterProc((CHAR*)"ORD", 4); + OPT_EnterProc((CHAR*)"ENTIER", 5); + OPT_EnterProc((CHAR*)"ODD", 6); + OPT_EnterProc((CHAR*)"MIN", 7); + OPT_EnterProc((CHAR*)"MAX", 8); + OPT_EnterProc((CHAR*)"CHR", 9); + OPT_EnterProc((CHAR*)"SHORT", 10); + OPT_EnterProc((CHAR*)"LONG", 11); + OPT_EnterProc((CHAR*)"SIZE", 12); + OPT_EnterProc((CHAR*)"INC", 13); + OPT_EnterProc((CHAR*)"DEC", 14); + OPT_EnterProc((CHAR*)"INCL", 15); + OPT_EnterProc((CHAR*)"EXCL", 16); + OPT_EnterProc((CHAR*)"LEN", 17); + OPT_EnterProc((CHAR*)"COPY", 18); + OPT_EnterProc((CHAR*)"ASH", 19); + OPT_EnterProc((CHAR*)"ASSERT", 32); + OPT_impCtxt.ref[0] = OPT_undftyp; + OPT_impCtxt.ref[1] = OPT_bytetyp; + OPT_impCtxt.ref[2] = OPT_booltyp; + OPT_impCtxt.ref[3] = OPT_chartyp; + OPT_impCtxt.ref[4] = OPT_sinttyp; + OPT_impCtxt.ref[5] = OPT_inttyp; + OPT_impCtxt.ref[6] = OPT_linttyp; + OPT_impCtxt.ref[7] = OPT_realtyp; + OPT_impCtxt.ref[8] = OPT_lrltyp; + OPT_impCtxt.ref[9] = OPT_settyp; + OPT_impCtxt.ref[10] = OPT_stringtyp; + OPT_impCtxt.ref[11] = OPT_niltyp; + OPT_impCtxt.ref[12] = OPT_notyp; + OPT_impCtxt.ref[13] = OPT_sysptrtyp; + __ENDMOD; +} diff --git a/bootstrap/windows-88/OPT.h b/bootstrap/windows-88/OPT.h new file mode 100644 index 00000000..4c3442b5 --- /dev/null +++ b/bootstrap/windows-88/OPT.h @@ -0,0 +1,106 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPT__h +#define OPT__h + +#define LARGE +#include "SYSTEM.h" +#include "OPS.h" + +typedef + struct OPT_ConstDesc *OPT_Const; + +typedef + OPS_String *OPT_ConstExt; + +typedef + struct OPT_ConstDesc { + OPT_ConstExt ext; + LONGINT intval, intval2; + SET setval; + LONGREAL realval; + } OPT_ConstDesc; + +typedef + struct OPT_NodeDesc *OPT_Node; + +typedef + struct OPT_StrDesc *OPT_Struct; + +typedef + struct OPT_ObjDesc *OPT_Object; + +typedef + struct OPT_NodeDesc { + OPT_Node left, right, link; + SHORTINT class, subcl; + BOOLEAN readonly; + OPT_Struct typ; + OPT_Object obj; + OPT_Const conval; + } OPT_NodeDesc; + +typedef + struct OPT_ObjDesc { + OPT_Object left, right, link, scope; + OPS_Name name; + BOOLEAN leaf; + SHORTINT mode, mnolev, vis, history; + BOOLEAN used, fpdone; + LONGINT fprint; + OPT_Struct typ; + OPT_Const conval; + LONGINT adr, linkadr; + INTEGER x; + } OPT_ObjDesc; + +typedef + struct OPT_StrDesc { + SHORTINT form, comp, mno, extlev; + INTEGER ref, sysflag; + LONGINT n, size, align, txtpos; + BOOLEAN allocated, pbused, pvused; + char _prvt0[8]; + LONGINT pbfp, pvfp; + OPT_Struct BaseTyp; + OPT_Object link, strobj; + } OPT_StrDesc; + + +import void (*OPT_typSize)(OPT_Struct); +import OPT_Object OPT_topScope; +import OPT_Struct OPT_undftyp, OPT_bytetyp, OPT_booltyp, OPT_chartyp, OPT_sinttyp, OPT_inttyp, OPT_linttyp, OPT_realtyp, OPT_lrltyp, OPT_settyp, OPT_stringtyp, OPT_niltyp, OPT_notyp, OPT_sysptrtyp; +import SHORTINT OPT_nofGmod; +import OPT_Object OPT_GlbMod[64]; +import OPS_Name OPT_SelfName; +import BOOLEAN OPT_SYSimported; + +import LONGINT *OPT_ConstDesc__typ; +import LONGINT *OPT_ObjDesc__typ; +import LONGINT *OPT_StrDesc__typ; +import LONGINT *OPT_NodeDesc__typ; + +import void OPT_Close (void); +import void OPT_CloseScope (void); +import void OPT_Export (BOOLEAN *ext, BOOLEAN *new); +import void OPT_FPrintErr (OPT_Object obj, INTEGER errcode); +import void OPT_FPrintObj (OPT_Object obj); +import void OPT_FPrintStr (OPT_Struct typ); +import void OPT_Find (OPT_Object *res); +import void OPT_FindField (OPS_Name name, OPT_Struct typ, OPT_Object *res); +import void OPT_FindImport (OPT_Object mod, OPT_Object *res); +import void OPT_IdFPrint (OPT_Struct typ); +import void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done); +import void OPT_Init (OPS_Name name, SET opt); +import void OPT_Insert (OPS_Name name, OPT_Object *obj); +import void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old); +import OPT_Const OPT_NewConst (void); +import OPT_ConstExt OPT_NewExt (void); +import OPT_Node OPT_NewNode (SHORTINT class); +import OPT_Object OPT_NewObj (void); +import OPT_Struct OPT_NewStr (SHORTINT form, SHORTINT comp); +import void OPT_OpenScope (SHORTINT level, OPT_Object owner); +import void *OPT__init(void); + + +#endif diff --git a/bootstrap/windows-88/OPV.c b/bootstrap/windows-88/OPV.c new file mode 100644 index 00000000..627e325b --- /dev/null +++ b/bootstrap/windows-88/OPV.c @@ -0,0 +1,1689 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "OPC.h" +#include "OPM.h" +#include "OPS.h" +#include "OPT.h" + +typedef + struct OPV_ExitInfo { + INTEGER level, label; + } OPV_ExitInfo; + + +static BOOLEAN OPV_assert, OPV_inxchk, OPV_mainprog, OPV_ansi; +static INTEGER OPV_stamp; +static LONGINT OPV_recno; +static OPV_ExitInfo OPV_exit; +static INTEGER OPV_nofExitLabels; +static BOOLEAN OPV_naturalAlignment; + +export LONGINT *OPV_ExitInfo__typ; + +static void OPV_ActualPar (OPT_Node n, OPT_Object fp); +export void OPV_AdrAndSize (OPT_Object topScope); +static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc); +static void OPV_Convert (OPT_Node n, INTEGER form, INTEGER prec); +static void OPV_DefineTDescs (OPT_Node n); +static void OPV_Entier (OPT_Node n, INTEGER prec); +static void OPV_GetTProcNum (OPT_Object obj); +static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc); +static BOOLEAN OPV_ImplicitReturn (OPT_Node n); +static void OPV_Index (OPT_Node n, OPT_Node d, INTEGER prec, INTEGER dim); +export void OPV_Init (void); +static void OPV_InitTDescs (OPT_Node n); +static void OPV_Len (OPT_Node n, LONGINT dim); +export void OPV_Module (OPT_Node prog); +static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max); +static void OPV_NewArr (OPT_Node d, OPT_Node x); +static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp); +static BOOLEAN OPV_SideEffects (OPT_Node n); +static void OPV_Stamp (OPS_Name s); +static OPT_Object OPV_SuperProc (OPT_Node n); +static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported); +static void OPV_TraverseRecord (OPT_Struct typ); +export void OPV_TypSize (OPT_Struct typ); +static void OPV_TypeOf (OPT_Node n); +static void OPV_design (OPT_Node n, INTEGER prec); +static void OPV_expr (OPT_Node n, INTEGER prec); +static void OPV_stat (OPT_Node n, OPT_Object outerProc); + + +static LONGINT OPV_NaturalAlignment (LONGINT size, LONGINT max) +{ + LONGINT _o_result; + LONGINT i; + if (size >= max) { + _o_result = max; + return _o_result; + } else { + i = 1; + while (i < size) { + i += i; + } + _o_result = i; + return _o_result; + } + __RETCHK; +} + +void OPV_TypSize (OPT_Struct typ) +{ + INTEGER f, c; + LONGINT offset, size, base, fbase, off0; + OPT_Object fld = NIL; + OPT_Struct btyp = NIL; + if (typ == OPT_undftyp) { + OPM_err(58); + } else if (typ->size == -1) { + f = typ->form; + c = typ->comp; + if (c == 4) { + btyp = typ->BaseTyp; + if (btyp == NIL) { + offset = 0; + base = OPM_RecAlign; + } else { + OPV_TypSize(btyp); + offset = btyp->size - (LONGINT)__ASHR(btyp->sysflag, 8); + base = btyp->align; + } + fld = typ->link; + while ((fld != NIL && fld->mode == 4)) { + btyp = fld->typ; + OPV_TypSize(btyp); + size = btyp->size; + fbase = OPC_Base(btyp); + OPC_Align(&offset, fbase); + fld->adr = offset; + offset += size; + if (fbase > base) { + base = fbase; + } + fld = fld->link; + } + off0 = offset; + if (offset == 0) { + offset = 1; + } + if (OPM_RecSize == 0) { + base = OPV_NaturalAlignment(offset, OPM_RecAlign); + } + OPC_Align(&offset, base); + if ((typ->strobj == NIL && __MASK(typ->align, -65536) == 0)) { + OPV_recno += 1; + base += __ASHL(OPV_recno, 16); + } + typ->size = offset; + typ->align = base; + typ->sysflag = __MASK(typ->sysflag, -256) + (int)__ASHL(offset - off0, 8); + } else if (c == 2) { + OPV_TypSize(typ->BaseTyp); + typ->size = typ->n * typ->BaseTyp->size; + } else if (f == 13) { + typ->size = OPM_PointerSize; + if (typ->BaseTyp == OPT_undftyp) { + OPM_Mark(128, typ->n); + } else { + OPV_TypSize(typ->BaseTyp); + } + } else if (f == 14) { + typ->size = OPM_ProcSize; + } else if (c == 3) { + btyp = typ->BaseTyp; + OPV_TypSize(btyp); + if (btyp->comp == 3) { + typ->size = btyp->size + 4; + } else { + typ->size = 8; + } + } + } +} + +void OPV_Init (void) +{ + OPV_stamp = 0; + OPV_recno = 0; + OPV_nofExitLabels = 0; + OPV_assert = __IN(7, OPM_opt); + OPV_inxchk = __IN(0, OPM_opt); + OPV_mainprog = __IN(10, OPM_opt); + OPV_ansi = __IN(6, OPM_opt); +} + +static void OPV_GetTProcNum (OPT_Object obj) +{ + LONGINT oldPos; + OPT_Struct typ = NIL; + OPT_Object redef = NIL; + oldPos = OPM_errpos; + OPM_errpos = obj->scope->adr; + typ = obj->link->typ; + if (typ->form == 13) { + typ = typ->BaseTyp; + } + OPT_FindField(obj->name, typ->BaseTyp, &redef); + if (redef != NIL) { + obj->adr = __ASHL(__ASHR(redef->adr, 16), 16); + if (!__IN(2, obj->conval->setval)) { + OPM_err(119); + } + } else { + obj->adr += __ASHL(typ->n, 16); + typ->n += 1; + } + OPM_errpos = oldPos; +} + +static void OPV_TraverseRecord (OPT_Struct typ) +{ + if (!typ->allocated) { + if (typ->BaseTyp != NIL) { + OPV_TraverseRecord(typ->BaseTyp); + typ->n = typ->BaseTyp->n; + } + typ->allocated = 1; + OPV_Traverse(typ->link, typ->strobj, 0); + } +} + +static void OPV_Stamp (OPS_Name s) +{ + INTEGER i, j, k; + CHAR n[10]; + OPV_stamp += 1; + i = 0; + j = OPV_stamp; + while (s[__X(i, ((LONGINT)(256)))] != 0x00) { + i += 1; + } + if (i > 25) { + i = 25; + } + s[__X(i, ((LONGINT)(256)))] = '_'; + s[__X(i + 1, ((LONGINT)(256)))] = '_'; + i += 2; + k = 0; + do { + n[__X(k, ((LONGINT)(10)))] = (CHAR)((int)__MOD(j, 10) + 48); + j = __DIV(j, 10); + k += 1; + } while (!(j == 0)); + do { + k -= 1; + s[__X(i, ((LONGINT)(256)))] = n[__X(k, ((LONGINT)(10)))]; + i += 1; + } while (!(k == 0)); + s[__X(i, ((LONGINT)(256)))] = 0x00; +} + +static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exported) +{ + INTEGER mode; + OPT_Object scope = NIL; + OPT_Struct typ = NIL; + if (obj != NIL) { + OPV_Traverse(obj->left, outerScope, exported); + if (obj->name[0] == '@') { + obj->name[0] = '_'; + OPV_Stamp(obj->name); + } + obj->linkadr = 0; + mode = obj->mode; + if ((mode == 5 && (obj->vis != 0) == exported)) { + typ = obj->typ; + OPV_TypSize(obj->typ); + if (typ->form == 13) { + typ = typ->BaseTyp; + } + if (typ->comp == 4) { + OPV_TraverseRecord(typ); + } + } else if (mode == 13) { + OPV_GetTProcNum(obj); + } else if (mode == 1) { + OPV_TypSize(obj->typ); + } + if (!exported) { + if ((__IN(mode, 0x60) && obj->mnolev > 0)) { + OPV_Stamp(obj->name); + } + if (__IN(mode, 0x26)) { + obj->scope = outerScope; + } else if (__IN(mode, 0x26c0)) { + if (obj->conval->setval == 0x0) { + OPM_err(129); + } + scope = obj->scope; + scope->leaf = 1; + __COPY(obj->name, scope->name, ((LONGINT)(256))); + OPV_Stamp(scope->name); + if (mode == 9) { + obj->adr = 1; + } + if (scope->mnolev > 1) { + outerScope->leaf = 0; + } + OPV_Traverse(obj->scope->right, obj->scope, 0); + } + } + OPV_Traverse(obj->right, outerScope, exported); + } +} + +void OPV_AdrAndSize (OPT_Object topScope) +{ + OPM_errpos = topScope->adr; + topScope->leaf = 1; + OPV_Traverse(topScope->right, topScope, 1); + OPV_Traverse(topScope->right, topScope, 0); + OPT_chartyp->strobj->linkadr = 2; + OPT_settyp->strobj->linkadr = 2; + OPT_realtyp->strobj->linkadr = 2; + OPT_inttyp->strobj->linkadr = 2; + OPT_linttyp->strobj->linkadr = 2; + OPT_lrltyp->strobj->linkadr = 2; + OPT_sinttyp->strobj->linkadr = 2; + OPT_booltyp->strobj->linkadr = 2; + OPT_bytetyp->strobj->linkadr = 2; + OPT_sysptrtyp->strobj->linkadr = 2; +} + +static INTEGER OPV_Precedence (INTEGER class, INTEGER subclass, INTEGER form, INTEGER comp) +{ + INTEGER _o_result; + switch (class) { + case 7: case 0: case 2: case 4: case 9: + case 13: + _o_result = 10; + return _o_result; + break; + case 5: + if (__IN(3, OPM_opt)) { + _o_result = 10; + return _o_result; + } else { + _o_result = 9; + return _o_result; + } + break; + case 1: + if (__IN(comp, 0x0c)) { + _o_result = 10; + return _o_result; + } else { + _o_result = 9; + return _o_result; + } + break; + case 3: + _o_result = 9; + return _o_result; + break; + case 11: + switch (subclass) { + case 33: case 7: case 24: case 29: case 20: + _o_result = 9; + return _o_result; + break; + case 16: case 21: case 22: case 23: case 25: + _o_result = 10; + return _o_result; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence Nmop, subclass = ", (LONGINT)51); + OPM_LogWNum(subclass, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + break; + case 12: + switch (subclass) { + case 1: + if (form == 9) { + _o_result = 4; + return _o_result; + } else { + _o_result = 8; + return _o_result; + } + break; + case 2: + if (form == 9) { + _o_result = 3; + return _o_result; + } else { + _o_result = 8; + return _o_result; + } + break; + case 3: case 4: + _o_result = 10; + return _o_result; + break; + case 6: + if (form == 9) { + _o_result = 2; + return _o_result; + } else { + _o_result = 7; + return _o_result; + } + break; + case 7: + if (form == 9) { + _o_result = 4; + return _o_result; + } else { + _o_result = 7; + return _o_result; + } + break; + case 11: case 12: case 13: case 14: + _o_result = 6; + return _o_result; + break; + case 9: case 10: + _o_result = 5; + return _o_result; + break; + case 5: + _o_result = 1; + return _o_result; + break; + case 8: + _o_result = 0; + return _o_result; + break; + case 19: case 15: case 17: case 18: case 26: + case 27: case 28: + _o_result = 10; + return _o_result; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence Ndop, subclass = ", (LONGINT)51); + OPM_LogWNum(subclass, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + break; + case 10: + _o_result = 10; + return _o_result; + break; + case 8: case 6: + _o_result = 12; + return _o_result; + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.Precedence, class = ", (LONGINT)43); + OPM_LogWNum(class, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + __RETCHK; +} + +static void OPV_Len (OPT_Node n, LONGINT dim) +{ + while ((n->class == 4 && n->typ->comp == 3)) { + dim += 1; + n = n->left; + } + if ((n->class == 3 && n->typ->comp == 3)) { + OPV_design(n->left, 10); + OPM_WriteString((CHAR*)"->len[", (LONGINT)7); + OPM_WriteInt(dim); + OPM_Write(']'); + } else { + OPC_Len(n->obj, n->typ, dim); + } +} + +static BOOLEAN OPV_SideEffects (OPT_Node n) +{ + BOOLEAN _o_result; + if (n != NIL) { + _o_result = (n->class == 13 || OPV_SideEffects(n->left)) || OPV_SideEffects(n->right); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +static void OPV_Entier (OPT_Node n, INTEGER prec) +{ + if (__IN(n->typ->form, 0x0180)) { + OPM_WriteString((CHAR*)"__ENTIER(", (LONGINT)10); + OPV_expr(n, -1); + OPM_Write(')'); + } else { + OPV_expr(n, prec); + } +} + +static void OPV_Convert (OPT_Node n, INTEGER form, INTEGER prec) +{ + INTEGER from; + from = n->typ->form; + if (form == 9) { + OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9); + OPV_Entier(n, -1); + OPM_Write(')'); + } else if (form == 6) { + if (from < 6) { + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + } + OPV_Entier(n, 9); + } else if (form == 5) { + if (from < 5) { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + OPV_expr(n, 9); + } else { + if (__IN(2, OPM_opt)) { + OPM_WriteString((CHAR*)"__SHORT", (LONGINT)8); + if (OPV_SideEffects(n)) { + OPM_Write('F'); + } + OPM_Write('('); + OPV_Entier(n, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(OPM_MaxInt + 1); + OPM_Write(')'); + } else { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + OPV_Entier(n, 9); + } + } + } else if (form == 4) { + if (__IN(2, OPM_opt)) { + OPM_WriteString((CHAR*)"__SHORT", (LONGINT)8); + if (OPV_SideEffects(n)) { + OPM_Write('F'); + } + OPM_Write('('); + OPV_Entier(n, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(OPM_MaxSInt + 1); + OPM_Write(')'); + } else { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + OPV_Entier(n, 9); + } + } else if (form == 3) { + if (__IN(2, OPM_opt)) { + OPM_WriteString((CHAR*)"__CHR", (LONGINT)6); + if (OPV_SideEffects(n)) { + OPM_Write('F'); + } + OPM_Write('('); + OPV_Entier(n, -1); + OPM_Write(')'); + } else { + OPM_WriteString((CHAR*)"(CHAR)", (LONGINT)7); + OPV_Entier(n, 9); + } + } else { + OPV_expr(n, prec); + } +} + +static void OPV_TypeOf (OPT_Node n) +{ + if (n->typ->form == 13) { + OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10); + OPV_expr(n, -1); + OPM_Write(')'); + } else if (__IN(n->class, 0x15)) { + OPC_Andent(n->typ); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } else if (n->class == 3) { + OPM_WriteString((CHAR*)"__TYPEOF(", (LONGINT)10); + OPV_expr(n->left, -1); + OPM_Write(')'); + } else if (n->class == 5) { + OPV_TypeOf(n->left); + } else if ((n->class == 11 && n->subcl == 29)) { + OPC_TypeOf(n->left->obj); + } else { + OPC_TypeOf(n->obj); + } +} + +static void OPV_Index (OPT_Node n, OPT_Node d, INTEGER prec, INTEGER dim) +{ + if (!OPV_inxchk || (n->right->class == 7 && (n->right->conval->intval == 0 || n->left->typ->comp != 3))) { + OPV_expr(n->right, prec); + } else { + if (OPV_SideEffects(n->right)) { + OPM_WriteString((CHAR*)"__XF(", (LONGINT)6); + } else { + OPM_WriteString((CHAR*)"__X(", (LONGINT)5); + } + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_Len(d, dim); + OPM_Write(')'); + } +} + +static void OPV_design (OPT_Node n, INTEGER prec) +{ + OPT_Object obj = NIL; + OPT_Struct typ = NIL; + INTEGER class, designPrec, comp; + OPT_Node d = NIL, x = NIL; + INTEGER dims, i, _for__26; + comp = n->typ->comp; + obj = n->obj; + class = n->class; + designPrec = OPV_Precedence(class, n->subcl, n->typ->form, comp); + if ((((((class == 0 && obj->mnolev > 0)) && (int)obj->mnolev != OPM_level)) && prec == 10)) { + designPrec = 9; + } + if (prec > designPrec) { + OPM_Write('('); + } + if (prec == 11) { + OPM_Write('*'); + } + switch (class) { + case 9: + OPC_Ident(n->obj); + break; + case 0: + OPC_CompleteIdent(n->obj); + break; + case 1: + if (!__IN(comp, 0x0c)) { + OPM_Write('*'); + } + OPC_CompleteIdent(n->obj); + break; + case 2: + if (n->left->class == 3) { + OPV_design(n->left->left, designPrec); + OPM_WriteString((CHAR*)"->", (LONGINT)3); + } else { + OPV_design(n->left, designPrec); + OPM_Write('.'); + } + OPC_Ident(n->obj); + break; + case 3: + if (n->typ->comp == 3) { + OPV_design(n->left, 10); + OPM_WriteString((CHAR*)"->data", (LONGINT)7); + } else { + OPM_Write('*'); + OPV_design(n->left, designPrec); + } + break; + case 4: + d = n->left; + if (d->typ->comp == 3) { + dims = 0; + while (d->class == 4) { + d = d->left; + dims += 1; + } + if (n->typ->comp == 3) { + OPM_Write('&'); + } + OPV_design(d, designPrec); + OPM_Write('['); + if (n->typ->comp == 3) { + OPM_Write('('); + } + i = dims; + x = n; + while (x != d) { + if (x->left != d) { + OPV_Index(x, d, 7, i); + OPM_WriteString((CHAR*)" + ", (LONGINT)4); + OPV_Len(d, i); + OPM_WriteString((CHAR*)" * (", (LONGINT)5); + i -= 1; + } else { + OPV_Index(x, d, -1, i); + } + x = x->left; + } + _for__26 = dims; + i = 1; + while (i <= _for__26) { + OPM_Write(')'); + i += 1; + } + if (n->typ->comp == 3) { + OPM_Write(')'); + while ((LONGINT)i < __ASHR(d->typ->size - 4, 2)) { + OPM_WriteString((CHAR*)" * ", (LONGINT)4); + OPV_Len(d, i); + i += 1; + } + } + OPM_Write(']'); + } else { + OPV_design(n->left, designPrec); + OPM_Write('['); + OPV_Index(n, n->left, -1, 0); + OPM_Write(']'); + } + break; + case 5: + typ = n->typ; + obj = n->left->obj; + if (__IN(3, OPM_opt)) { + if (typ->comp == 4) { + OPM_WriteString((CHAR*)"__GUARDR(", (LONGINT)10); + if ((int)obj->mnolev != OPM_level) { + OPM_WriteStringVar((void*)obj->scope->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"__curr->", (LONGINT)9); + OPC_Ident(obj); + } else { + OPC_Ident(obj); + } + } else { + if (typ->BaseTyp->strobj == NIL) { + OPM_WriteString((CHAR*)"__GUARDA(", (LONGINT)10); + } else { + OPM_WriteString((CHAR*)"__GUARDP(", (LONGINT)10); + } + OPV_expr(n->left, -1); + typ = typ->BaseTyp; + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(typ); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(typ->extlev); + OPM_Write(')'); + } else { + if (typ->comp == 4) { + OPM_WriteString((CHAR*)"*(", (LONGINT)3); + OPC_Ident(typ->strobj); + OPM_WriteString((CHAR*)"*)", (LONGINT)3); + OPC_CompleteIdent(obj); + } else { + OPM_Write('('); + OPC_Ident(typ->strobj); + OPM_Write(')'); + OPV_expr(n->left, designPrec); + } + } + break; + case 6: + if (__IN(3, OPM_opt)) { + if (n->left->class == 1) { + OPM_WriteString((CHAR*)"__GUARDEQR(", (LONGINT)12); + OPC_CompleteIdent(n->left->obj); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_TypeOf(n->left); + } else { + OPM_WriteString((CHAR*)"__GUARDEQP(", (LONGINT)12); + OPV_expr(n->left->left, -1); + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(n->left->typ->strobj); + OPM_Write(')'); + } else { + OPV_expr(n->left, -1); + } + break; + case 11: + if (n->subcl == 29) { + OPV_design(n->left, prec); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.design, class = ", (LONGINT)39); + OPM_LogWNum(class, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + if (prec > designPrec) { + OPM_Write(')'); + } +} + +static void OPV_ActualPar (OPT_Node n, OPT_Object fp) +{ + OPT_Struct typ = NIL, aptyp = NIL; + INTEGER comp, form, mode, prec, dim; + OPM_Write('('); + while (n != NIL) { + typ = fp->typ; + comp = typ->comp; + form = typ->form; + mode = fp->mode; + prec = -1; + if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) { + OPM_Write('('); + OPC_Ident(n->typ->strobj); + OPM_WriteString((CHAR*)"*)", (LONGINT)3); + prec = 10; + } + if (!__IN(n->typ->comp, 0x0c)) { + if (mode == 2) { + if ((OPV_ansi && typ != n->typ)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } + OPM_Write('&'); + prec = 9; + } else if (OPV_ansi) { + if ((__IN(comp, 0x0c) && n->class == 7)) { + OPM_WriteString((CHAR*)"(CHAR*)", (LONGINT)8); + } else if ((((form == 13 && typ != n->typ)) && n->typ != OPT_niltyp)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } + } else { + if ((__IN(form, 0x0180) && __IN(n->typ->form, 0x70))) { + OPM_WriteString((CHAR*)"(double)", (LONGINT)9); + prec = 9; + } else if ((form == 6 && n->typ->form < 6)) { + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + prec = 9; + } + } + } else if (OPV_ansi) { + if ((((mode == 2 && typ != n->typ)) && prec == -1)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + } + } + if ((((mode == 2 && n->class == 11)) && n->subcl == 29)) { + OPV_expr(n->left, prec); + } else if ((((((form == 6 && n->class == 7)) && n->conval->intval <= OPM_MaxInt)) && n->conval->intval >= OPM_MinInt)) { + OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12); + OPV_expr(n, prec); + OPM_WriteString((CHAR*)"))", (LONGINT)3); + } else { + OPV_expr(n, prec); + } + if ((comp == 4 && mode == 2)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_TypeOf(n); + } else if (comp == 3) { + if (n->class == 7) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + OPM_WriteInt(n->conval->intval2); + } else { + aptyp = n->typ; + dim = 0; + while ((typ->comp == 3 && typ->BaseTyp->form != 1)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_Len(n, dim); + typ = typ->BaseTyp; + aptyp = aptyp->BaseTyp; + dim += 1; + } + if ((typ->comp == 3 && typ->BaseTyp->form == 1)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + while (aptyp->comp == 3) { + OPV_Len(n, dim); + OPM_WriteString((CHAR*)" * ", (LONGINT)4); + dim += 1; + aptyp = aptyp->BaseTyp; + } + OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12); + OPM_WriteInt(aptyp->size); + OPM_WriteString((CHAR*)"))", (LONGINT)3); + } + } + } + n = n->link; + fp = fp->link; + if (n != NIL) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + } + } + OPM_Write(')'); +} + +static OPT_Object OPV_SuperProc (OPT_Node n) +{ + OPT_Object _o_result; + OPT_Object obj = NIL; + OPT_Struct typ = NIL; + typ = n->right->typ; + if (typ->form == 13) { + typ = typ->BaseTyp; + } + OPT_FindField(n->left->obj->name, typ->BaseTyp, &obj); + _o_result = obj; + return _o_result; +} + +static void OPV_expr (OPT_Node n, INTEGER prec) +{ + INTEGER class, subclass, form, exprPrec; + OPT_Struct typ = NIL; + OPT_Node l = NIL, r = NIL; + OPT_Object proc = NIL; + class = n->class; + subclass = n->subcl; + form = n->typ->form; + l = n->left; + r = n->right; + exprPrec = OPV_Precedence(class, subclass, form, n->typ->comp); + if ((exprPrec <= prec && __IN(class, 0x3ce0))) { + OPM_Write('('); + } + switch (class) { + case 7: + OPC_Constant(n->conval, form); + break; + case 10: + OPM_WriteString((CHAR*)"__SETRNG(", (LONGINT)10); + OPV_expr(l, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(r, -1); + OPM_Write(')'); + break; + case 11: + switch (subclass) { + case 33: + OPM_Write('!'); + OPV_expr(l, exprPrec); + break; + case 7: + if (form == 9) { + OPM_Write('~'); + } else { + OPM_Write('-'); + } + OPV_expr(l, exprPrec); + break; + case 16: + typ = n->obj->typ; + if (l->typ->comp == 4) { + OPM_WriteString((CHAR*)"__IS(", (LONGINT)6); + OPC_TypeOf(l->obj); + } else { + OPM_WriteString((CHAR*)"__ISP(", (LONGINT)7); + OPV_expr(l, -1); + typ = typ->BaseTyp; + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(typ); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(typ->extlev); + OPM_Write(')'); + break; + case 20: + OPV_Convert(l, form, exprPrec); + break; + case 21: + if (OPV_SideEffects(l)) { + if (l->typ->form < 7) { + if (l->typ->form < 6) { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + } + OPM_WriteString((CHAR*)"__ABSF(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ABSFD(", (LONGINT)9); + } + } else { + OPM_WriteString((CHAR*)"__ABS(", (LONGINT)7); + } + OPV_expr(l, -1); + OPM_Write(')'); + break; + case 22: + OPM_WriteString((CHAR*)"__CAP(", (LONGINT)7); + OPV_expr(l, -1); + OPM_Write(')'); + break; + case 23: + OPM_WriteString((CHAR*)"__ODD(", (LONGINT)7); + OPV_expr(l, -1); + OPM_Write(')'); + break; + case 24: + OPM_WriteString((CHAR*)"(LONGINT)(uintptr_t)", (LONGINT)21); + if (l->class == 1) { + OPC_CompleteIdent(l->obj); + } else { + if ((l->typ->form != 10 && !__IN(l->typ->comp, 0x0c))) { + OPM_Write('&'); + } + OPV_expr(l, exprPrec); + } + break; + case 29: + if ((((__IN(n->typ->form, 0x6240) && __IN(l->typ->form, 0x6240))) && n->typ->size == l->typ->size) || !__IN(l->class, 0x17)) { + OPM_Write('('); + OPC_Ident(n->typ->strobj); + OPM_Write(')'); + if (__IN(n->typ->form, 0x6000) || __IN(l->typ->form, 0x6000)) { + OPM_WriteString((CHAR*)"(uintptr_t)", (LONGINT)12); + } + OPV_expr(l, exprPrec); + } else { + if (__IN(n->typ->form, 0x6000) || __IN(l->typ->form, 0x6000)) { + OPM_WriteString((CHAR*)"__VALP(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__VAL(", (LONGINT)7); + } + OPC_Ident(n->typ->strobj); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(l, -1); + OPM_Write(')'); + } + break; + default: + OPM_err(200); + break; + } + break; + case 12: + switch (subclass) { + case 19: + OPV_Len(l, r->conval->intval); + break; + case 15: case 17: case 18: case 26: case 27: + case 28: case 3: case 4: + switch (subclass) { + case 15: + OPM_WriteString((CHAR*)"__IN(", (LONGINT)6); + break; + case 17: + if (r->class == 7) { + if (r->conval->intval >= 0) { + OPM_WriteString((CHAR*)"__ASHL(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ASHR(", (LONGINT)8); + } + } else if (OPV_SideEffects(r)) { + OPM_WriteString((CHAR*)"__ASHF(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ASH(", (LONGINT)7); + } + break; + case 18: + OPM_WriteString((CHAR*)"__MASK(", (LONGINT)8); + break; + case 26: + OPM_WriteString((CHAR*)"__BIT(", (LONGINT)7); + break; + case 27: + if (r->class == 7) { + if (r->conval->intval >= 0) { + OPM_WriteString((CHAR*)"__LSHL(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__LSHR(", (LONGINT)8); + } + } else { + OPM_WriteString((CHAR*)"__LSH(", (LONGINT)7); + } + break; + case 28: + if (r->class == 7) { + if (r->conval->intval >= 0) { + OPM_WriteString((CHAR*)"__ROTL(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__ROTR(", (LONGINT)8); + } + } else { + OPM_WriteString((CHAR*)"__ROT(", (LONGINT)7); + } + break; + case 3: + if (OPV_SideEffects(n)) { + if (form < 6) { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + } + OPM_WriteString((CHAR*)"__DIVF(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__DIV(", (LONGINT)7); + } + break; + case 4: + if (form < 6) { + OPM_WriteString((CHAR*)"(int)", (LONGINT)6); + } + if (OPV_SideEffects(n)) { + OPM_WriteString((CHAR*)"__MODF(", (LONGINT)8); + } else { + OPM_WriteString((CHAR*)"__MOD(", (LONGINT)7); + } + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", (LONGINT)40); + OPM_LogWNum(subclass, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + OPV_expr(l, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if ((((__IN(subclass, 0x18020000) && r->class == 7)) && r->conval->intval < 0)) { + OPM_WriteInt(-r->conval->intval); + } else { + OPV_expr(r, -1); + } + if (__IN(subclass, 0x18000000)) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(l->typ->strobj); + } + OPM_Write(')'); + break; + case 9: case 10: case 11: case 12: case 13: + case 14: + if (__IN(l->typ->form, 0x8400)) { + OPM_WriteString((CHAR*)"__STRCMP(", (LONGINT)10); + OPV_expr(l, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(r, -1); + OPM_Write(')'); + OPC_Cmp(subclass); + OPM_Write('0'); + } else { + OPV_expr(l, exprPrec); + OPC_Cmp(subclass); + typ = l->typ; + if ((((((typ->form == 13 && r->typ->form != 11)) && r->typ != typ)) && r->typ != OPT_sysptrtyp)) { + OPM_WriteString((CHAR*)"(void *) ", (LONGINT)10); + } + OPV_expr(r, exprPrec); + } + break; + default: + if (subclass == 5 || (form == 9 && (subclass == 1 || subclass == 7))) { + OPM_Write('('); + } + OPV_expr(l, exprPrec); + switch (subclass) { + case 1: + if (form == 9) { + OPM_WriteString((CHAR*)" & ", (LONGINT)4); + } else { + OPM_WriteString((CHAR*)" * ", (LONGINT)4); + } + break; + case 2: + if (form == 9) { + OPM_WriteString((CHAR*)" ^ ", (LONGINT)4); + } else { + OPM_WriteString((CHAR*)" / ", (LONGINT)4); + if (r->obj == NIL || __IN(r->obj->typ->form, 0x70)) { + OPM_Write('('); + OPC_Ident(n->typ->strobj); + OPM_Write(')'); + } + } + break; + case 5: + OPM_WriteString((CHAR*)" && ", (LONGINT)5); + break; + case 6: + if (form == 9) { + OPM_WriteString((CHAR*)" | ", (LONGINT)4); + } else { + OPM_WriteString((CHAR*)" + ", (LONGINT)4); + } + break; + case 7: + if (form == 9) { + OPM_WriteString((CHAR*)" & ~", (LONGINT)5); + } else { + OPM_WriteString((CHAR*)" - ", (LONGINT)4); + } + break; + case 8: + OPM_WriteString((CHAR*)" || ", (LONGINT)5); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, subclass = ", (LONGINT)40); + OPM_LogWNum(subclass, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + OPV_expr(r, exprPrec); + if (subclass == 5 || (form == 9 && (subclass == 1 || subclass == 7))) { + OPM_Write(')'); + } + break; + } + break; + case 13: + if ((l->obj != NIL && l->obj->mode == 13)) { + if (l->subcl == 1) { + proc = OPV_SuperProc(n); + } else { + OPM_WriteString((CHAR*)"__", (LONGINT)3); + proc = OPC_BaseTProc(l->obj); + } + OPC_Ident(proc); + n->obj = proc->link; + } else if (l->class == 9) { + OPV_design(l, 10); + } else { + OPV_design(l, 11); + } + OPV_ActualPar(r, n->obj); + break; + default: + OPV_design(n, prec); + break; + } + if ((exprPrec <= prec && __IN(class, 0x3ca0))) { + OPM_Write(')'); + } +} + +static void OPV_IfStat (OPT_Node n, BOOLEAN withtrap, OPT_Object outerProc) +{ + OPT_Node if_ = NIL; + OPT_Object obj = NIL; + OPT_Struct typ = NIL; + LONGINT adr; + if_ = n->left; + while (if_ != NIL) { + OPM_WriteString((CHAR*)"if ", (LONGINT)4); + OPV_expr(if_->left, 12); + OPM_Write(' '); + OPC_BegBlk(); + if ((n->class == 27 && if_->left->left != NIL)) { + obj = if_->left->left->obj; + typ = obj->typ; + adr = obj->adr; + if (typ->comp == 4) { + OPC_BegStat(); + OPC_Ident(if_->left->obj); + OPM_WriteString((CHAR*)" *", (LONGINT)3); + OPM_WriteString(obj->name, ((LONGINT)(256))); + OPM_WriteString((CHAR*)"__ = (void*)", (LONGINT)13); + obj->adr = 0; + OPC_CompleteIdent(obj); + OPC_EndStat(); + } + obj->adr = 1; + obj->typ = if_->left->obj->typ; + OPV_stat(if_->right, outerProc); + obj->typ = typ; + obj->adr = adr; + } else { + OPV_stat(if_->right, outerProc); + } + if_ = if_->link; + if ((if_ != NIL || n->right != NIL) || withtrap) { + OPC_EndBlk0(); + OPM_WriteString((CHAR*)" else ", (LONGINT)7); + } else { + OPC_EndBlk(); + } + } + if (withtrap) { + OPM_WriteString((CHAR*)"__WITHCHK", (LONGINT)10); + OPC_EndStat(); + } else if (n->right != NIL) { + OPC_BegBlk(); + OPV_stat(n->right, outerProc); + OPC_EndBlk(); + } +} + +static void OPV_CaseStat (OPT_Node n, OPT_Object outerProc) +{ + OPT_Node switchCase = NIL, label = NIL; + LONGINT low, high; + INTEGER form, i; + OPM_WriteString((CHAR*)"switch ", (LONGINT)8); + OPV_expr(n->left, 12); + OPM_Write(' '); + OPC_BegBlk(); + form = n->left->typ->form; + switchCase = n->right->left; + while (switchCase != NIL) { + label = switchCase->left; + i = 0; + while (label != NIL) { + low = label->conval->intval; + high = label->conval->intval2; + while (low <= high) { + if (i == 0) { + OPC_BegStat(); + } + OPC_Case(low, form); + low += 1; + i += 1; + if (i == 5) { + OPM_WriteLn(); + i = 0; + } + } + label = label->link; + } + if (i > 0) { + OPM_WriteLn(); + } + OPC_Indent(1); + OPV_stat(switchCase->right, outerProc); + OPC_BegStat(); + OPM_WriteString((CHAR*)"break", (LONGINT)6); + OPC_EndStat(); + OPC_Indent(-1); + switchCase = switchCase->link; + } + OPC_BegStat(); + OPM_WriteString((CHAR*)"default: ", (LONGINT)10); + if (n->right->conval->setval != 0x0) { + OPC_Indent(1); + OPM_WriteLn(); + OPV_stat(n->right->right, outerProc); + OPC_BegStat(); + OPM_WriteString((CHAR*)"break", (LONGINT)6); + OPC_Indent(-1); + } else { + OPM_WriteString((CHAR*)"__CASECHK", (LONGINT)10); + } + OPC_EndStat(); + OPC_EndBlk(); +} + +static BOOLEAN OPV_ImplicitReturn (OPT_Node n) +{ + BOOLEAN _o_result; + while ((n != NIL && n->class != 26)) { + n = n->link; + } + _o_result = n == NIL; + return _o_result; +} + +static void OPV_NewArr (OPT_Node d, OPT_Node x) +{ + OPT_Struct typ = NIL, base = NIL; + INTEGER nofdim, nofdyn; + typ = d->typ->BaseTyp; + base = typ; + nofdim = 0; + nofdyn = 0; + while (base->comp == 3) { + nofdim += 1; + nofdyn += 1; + base = base->BaseTyp; + } + OPV_design(d, -1); + OPM_WriteString((CHAR*)" = __NEWARR(", (LONGINT)13); + while (base->comp == 2) { + nofdim += 1; + base = base->BaseTyp; + } + if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) { + OPC_Ident(base->strobj); + OPM_WriteString((CHAR*)"__typ", (LONGINT)6); + } else if (base->form == 13) { + OPM_WriteString((CHAR*)"POINTER__typ", (LONGINT)13); + } else { + OPM_WriteString((CHAR*)"NIL", (LONGINT)4); + } + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteString((CHAR*)"((LONGINT)(", (LONGINT)12); + OPM_WriteInt(base->size); + OPM_WriteString((CHAR*)"))", (LONGINT)3); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(OPC_Base(base)); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(nofdim); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(nofdyn); + while (typ != base) { + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (typ->comp == 3) { + if (x->class == 7) { + OPM_WriteString((CHAR*)"(LONGINT)(", (LONGINT)11); + OPV_expr(x, -1); + OPM_WriteString((CHAR*)")", (LONGINT)2); + } else { + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + OPV_expr(x, 10); + } + x = x->link; + } else { + OPM_WriteString((CHAR*)"(LONGINT)", (LONGINT)10); + OPM_WriteInt(typ->n); + } + typ = typ->BaseTyp; + } + OPM_Write(')'); +} + +static void OPV_DefineTDescs (OPT_Node n) +{ + while ((n != NIL && n->class == 14)) { + OPC_TDescDecl(n->typ); + n = n->link; + } +} + +static void OPV_InitTDescs (OPT_Node n) +{ + while ((n != NIL && n->class == 14)) { + OPC_InitTDesc(n->typ); + n = n->link; + } +} + +static void OPV_stat (OPT_Node n, OPT_Object outerProc) +{ + OPT_Object proc = NIL; + OPV_ExitInfo saved; + OPT_Node l = NIL, r = NIL; + while ((n != NIL && OPM_noerr)) { + OPM_errpos = n->conval->intval; + if (n->class != 14) { + OPC_BegStat(); + } + switch (n->class) { + case 18: + if (n->obj == NIL) { + OPM_level += 1; + OPV_stat(n->left, outerProc); + OPM_level -= 1; + OPC_GenEnumPtrs(OPT_topScope->scope); + OPV_DefineTDescs(n->right); + OPC_EnterBody(); + OPV_InitTDescs(n->right); + OPM_WriteString((CHAR*)"/* BEGIN */", (LONGINT)12); + OPM_WriteLn(); + OPV_stat(n->right, outerProc); + OPC_ExitBody(); + } else { + proc = n->obj; + OPC_TypeDefs(proc->scope->right, 0); + if (!proc->scope->leaf) { + OPC_DefineInter(proc); + } + OPM_level += 1; + OPV_stat(n->left, proc); + OPM_level -= 1; + OPC_EnterProc(proc); + OPV_stat(n->right, proc); + OPC_ExitProc(proc, 1, OPV_ImplicitReturn(n->right)); + } + break; + case 14: + break; + case 19: + switch (n->subcl) { + case 0: + l = n->left; + r = n->right; + if (l->typ->comp == 2) { + OPM_WriteString((CHAR*)"__MOVE(", (LONGINT)8); + OPV_expr(r, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(l, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + if (r->typ == OPT_stringtyp) { + OPM_WriteInt(r->conval->intval2); + } else { + OPM_WriteInt(r->typ->size); + } + OPM_Write(')'); + } else { + if ((((((l->typ->form == 13 && l->obj != NIL)) && l->obj->adr == 1)) && l->obj->mode == 1)) { + l->obj->adr = 0; + OPV_design(l, -1); + l->obj->adr = 1; + if (r->typ->form != 11) { + OPM_WriteString((CHAR*)" = (void*)", (LONGINT)11); + } else { + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + } + } else { + OPV_design(l, -1); + OPM_WriteString((CHAR*)" = ", (LONGINT)4); + } + if (l->typ == r->typ) { + OPV_expr(r, -1); + } else if ((((l->typ->form == 13 && r->typ->form != 11)) && l->typ->strobj != NIL)) { + OPM_Write('('); + OPC_Ident(l->typ->strobj); + OPM_Write(')'); + OPV_expr(r, -1); + } else if (l->typ->comp == 4) { + OPM_WriteString((CHAR*)"*(", (LONGINT)3); + OPC_Andent(l->typ); + OPM_WriteString((CHAR*)"*)&", (LONGINT)4); + OPV_expr(r, 9); + } else { + OPV_expr(r, -1); + } + } + break; + case 1: + if (n->left->typ->BaseTyp->comp == 4) { + OPM_WriteString((CHAR*)"__NEW(", (LONGINT)7); + OPV_design(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Andent(n->left->typ->BaseTyp); + OPM_WriteString((CHAR*)")", (LONGINT)2); + } else if (__IN(n->left->typ->BaseTyp->comp, 0x0c)) { + OPV_NewArr(n->left, n->right); + } + break; + case 13: case 14: + OPV_expr(n->left, -1); + OPC_Increment(n->subcl == 14); + OPV_expr(n->right, -1); + break; + case 15: case 16: + OPV_expr(n->left, -1); + OPC_SetInclude(n->subcl == 16); + OPM_WriteString((CHAR*)"__SETOF(", (LONGINT)9); + OPV_expr(n->right, -1); + OPM_Write(')'); + break; + case 18: + OPM_WriteString((CHAR*)"__COPY(", (LONGINT)8); + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_Len(n->left, ((LONGINT)(0))); + OPM_Write(')'); + break; + case 31: + OPM_WriteString((CHAR*)"__MOVE(", (LONGINT)8); + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->right->link, -1); + OPM_Write(')'); + break; + case 24: + OPM_WriteString((CHAR*)"__GET(", (LONGINT)7); + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(n->left->typ->strobj); + OPM_Write(')'); + break; + case 25: + OPM_WriteString((CHAR*)"__PUT(", (LONGINT)7); + OPV_expr(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->right, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPC_Ident(n->right->typ->strobj); + OPM_Write(')'); + break; + case 26: case 27: + OPM_err(200); + break; + case 30: + OPM_WriteString((CHAR*)"__SYSNEW(", (LONGINT)10); + OPV_design(n->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPV_expr(n->right, -1); + OPM_Write(')'); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.subcl = ", (LONGINT)40); + OPM_LogWNum(n->subcl, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + break; + case 13: + if ((n->left->obj != NIL && n->left->obj->mode == 13)) { + if (n->left->subcl == 1) { + proc = OPV_SuperProc(n); + } else { + OPM_WriteString((CHAR*)"__", (LONGINT)3); + proc = OPC_BaseTProc(n->left->obj); + } + OPC_Ident(proc); + n->obj = proc->link; + } else if (n->left->class == 9) { + OPV_design(n->left, 10); + } else { + OPV_design(n->left, 11); + } + OPV_ActualPar(n->right, n->obj); + break; + case 20: + if (n->subcl != 32) { + OPV_IfStat(n, 0, outerProc); + } else if (OPV_assert) { + OPM_WriteString((CHAR*)"__ASSERT(", (LONGINT)10); + OPV_expr(n->left->left->left, -1); + OPM_WriteString((CHAR*)", ", (LONGINT)3); + OPM_WriteInt(n->left->right->right->conval->intval); + OPM_Write(')'); + OPC_EndStat(); + } + break; + case 21: + OPV_exit.level += 1; + OPV_CaseStat(n, outerProc); + OPV_exit.level -= 1; + break; + case 22: + OPV_exit.level += 1; + OPM_WriteString((CHAR*)"while ", (LONGINT)7); + OPV_expr(n->left, 12); + OPM_Write(' '); + OPC_BegBlk(); + OPV_stat(n->right, outerProc); + OPC_EndBlk(); + OPV_exit.level -= 1; + break; + case 23: + OPV_exit.level += 1; + OPM_WriteString((CHAR*)"do ", (LONGINT)4); + OPC_BegBlk(); + OPV_stat(n->left, outerProc); + OPC_EndBlk0(); + OPM_WriteString((CHAR*)" while (!", (LONGINT)10); + OPV_expr(n->right, 9); + OPM_Write(')'); + OPV_exit.level -= 1; + break; + case 24: + saved = OPV_exit; + OPV_exit.level = 0; + OPV_exit.label = -1; + OPM_WriteString((CHAR*)"for (;;) ", (LONGINT)10); + OPC_BegBlk(); + OPV_stat(n->left, outerProc); + OPC_EndBlk(); + if (OPV_exit.label != -1) { + OPC_BegStat(); + OPM_WriteString((CHAR*)"exit__", (LONGINT)7); + OPM_WriteInt(OPV_exit.label); + OPM_Write(':'); + OPC_EndStat(); + } + OPV_exit = saved; + break; + case 25: + if (OPV_exit.level == 0) { + OPM_WriteString((CHAR*)"break", (LONGINT)6); + } else { + if (OPV_exit.label == -1) { + OPV_exit.label = OPV_nofExitLabels; + OPV_nofExitLabels += 1; + } + OPM_WriteString((CHAR*)"goto exit__", (LONGINT)12); + OPM_WriteInt(OPV_exit.label); + } + break; + case 26: + if (OPM_level == 0) { + if (OPV_mainprog) { + OPM_WriteString((CHAR*)"__FINI", (LONGINT)7); + } else { + OPM_WriteString((CHAR*)"__ENDMOD", (LONGINT)9); + } + } else { + if (n->left != NIL) { + OPM_WriteString((CHAR*)"_o_result = ", (LONGINT)13); + if ((n->left->typ->form == 13 && n->obj->typ != n->left->typ)) { + OPM_WriteString((CHAR*)"(void*)", (LONGINT)8); + OPV_expr(n->left, 10); + } else { + OPV_expr(n->left, -1); + } + OPM_WriteString((CHAR*)";", (LONGINT)2); + OPM_WriteLn(); + OPC_BegStat(); + OPC_ExitProc(outerProc, 0, 0); + OPM_WriteString((CHAR*)"return _o_result", (LONGINT)17); + } else { + OPM_WriteString((CHAR*)"return", (LONGINT)7); + } + } + break; + case 27: + OPV_IfStat(n, n->subcl == 0, outerProc); + break; + case 28: + OPC_Halt(n->right->conval->intval); + break; + default: + OPM_LogWStr((CHAR*)"unhandled case in OPV.expr, n^.class = ", (LONGINT)40); + OPM_LogWNum(n->class, ((LONGINT)(0))); + OPM_LogWLn(); + break; + } + if (!__IN(n->class, 0x09744000)) { + OPC_EndStat(); + } + n = n->link; + } +} + +void OPV_Module (OPT_Node prog) +{ + if (!OPV_mainprog) { + OPC_GenHdr(prog->right); + OPC_GenHdrIncludes(); + } + OPC_GenBdy(prog->right); + OPV_stat(prog, NIL); +} + +__TDESC(OPV_ExitInfo, 1, 0) = {__TDFLDS("ExitInfo", 8), {-8}}; + +export void *OPV__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(OPC); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPS); + __MODULE_IMPORT(OPT); + __REGMOD("OPV", 0); + __REGCMD("Init", OPV_Init); + __INITYP(OPV_ExitInfo, OPV_ExitInfo, 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/windows-88/OPV.h b/bootstrap/windows-88/OPV.h new file mode 100644 index 00000000..7f0a5b8a --- /dev/null +++ b/bootstrap/windows-88/OPV.h @@ -0,0 +1,20 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef OPV__h +#define OPV__h + +#define LARGE +#include "SYSTEM.h" +#include "OPT.h" + + + + +import void OPV_AdrAndSize (OPT_Object topScope); +import void OPV_Init (void); +import void OPV_Module (OPT_Node prog); +import void OPV_TypSize (OPT_Struct typ); +import void *OPV__init(void); + + +#endif diff --git a/bootstrap/windows-88/Platform.c b/bootstrap/windows-88/Platform.c new file mode 100644 index 00000000..78274e99 --- /dev/null +++ b/bootstrap/windows-88/Platform.c @@ -0,0 +1,819 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" + +typedef + CHAR (*Platform_ArgPtr)[1024]; + +typedef + Platform_ArgPtr (*Platform_ArgVec)[1024]; + +typedef + LONGINT (*Platform_ArgVecPtr)[1]; + +typedef + CHAR (*Platform_EnvPtr)[1024]; + +typedef + struct Platform_FileIdentity { + LONGINT volume, indexhigh, indexlow, mtimehigh, mtimelow; + } Platform_FileIdentity; + +typedef + void (*Platform_HaltProcedure)(LONGINT); + +typedef + void (*Platform_SignalHandler)(INTEGER); + + +export BOOLEAN Platform_LittleEndian; +export LONGINT Platform_MainStackFrame, Platform_HaltCode; +export INTEGER Platform_PID; +export CHAR Platform_CWD[4096]; +export INTEGER Platform_ArgCount; +export LONGINT Platform_ArgVector; +static Platform_HaltProcedure Platform_HaltHandler; +static LONGINT Platform_TimeStart; +export INTEGER Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd; +export LONGINT Platform_StdIn, Platform_StdOut, Platform_StdErr; +static Platform_SignalHandler Platform_InterruptHandler; +export CHAR Platform_nl[3]; + +export LONGINT *Platform_FileIdentity__typ; + +export BOOLEAN Platform_Absent (INTEGER e); +export INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len); +export void Platform_AssertFail (LONGINT code); +export INTEGER Platform_Chdir (CHAR *n, LONGINT n__len); +export INTEGER Platform_Close (LONGINT h); +export BOOLEAN Platform_ConnectionFailed (INTEGER e); +export void Platform_Delay (LONGINT ms); +export BOOLEAN Platform_DifferentFilesystems (INTEGER e); +static void Platform_DisplayHaltCode (LONGINT code); +export INTEGER Platform_Error (void); +export void Platform_Exit (INTEGER code); +export void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len); +export void Platform_GetClock (LONGINT *t, LONGINT *d); +export void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len); +export void Platform_GetIntArg (INTEGER n, LONGINT *val); +export void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec); +export void Platform_Halt (LONGINT code); +export INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ); +export INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ); +export BOOLEAN Platform_Inaccessible (INTEGER e); +export void Platform_Init (INTEGER argc, LONGINT argvadr); +export void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d); +export INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h); +export BOOLEAN Platform_NoSuchDirectory (INTEGER e); +export LONGINT Platform_OSAllocate (LONGINT size); +export void Platform_OSFree (LONGINT address); +export INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h); +export INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h); +export INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n); +export INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n); +export INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len); +export BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2); +export BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2); +export INTEGER Platform_Seek (LONGINT h, LONGINT o, INTEGER r); +export void Platform_SetBadInstructionHandler (Platform_SignalHandler handler); +export void Platform_SetHalt (Platform_HaltProcedure p); +export void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source); +export INTEGER Platform_Size (LONGINT h, LONGINT *l); +export INTEGER Platform_Sync (LONGINT h); +export INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len); +static void Platform_TestLittleEndian (void); +export LONGINT Platform_Time (void); +export BOOLEAN Platform_TimedOut (INTEGER e); +export BOOLEAN Platform_TooManyFiles (INTEGER e); +export INTEGER Platform_Truncate (LONGINT h, LONGINT limit); +export INTEGER Platform_Unlink (CHAR *n, LONGINT n__len); +export INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l); +static void Platform_YMDHMStoClock (INTEGER ye, INTEGER mo, INTEGER da, INTEGER ho, INTEGER mi, INTEGER se, LONGINT *t, LONGINT *d); +static void Platform_errch (CHAR c); +static void Platform_errint (LONGINT l); +static void Platform_errln (void); +static void Platform_errposint (LONGINT l); +export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len); + +#include "WindowsWrapper.h" +#define Platform_ECONNABORTED() WSAECONNABORTED +#define Platform_ECONNREFUSED() WSAECONNREFUSED +#define Platform_EHOSTUNREACH() WSAEHOSTUNREACH +#define Platform_ENETUNREACH() WSAENETUNREACH +#define Platform_ERRORACCESSDENIED() ERROR_ACCESS_DENIED +#define Platform_ERRORFILENOTFOUND() ERROR_FILE_NOT_FOUND +#define Platform_ERRORNOTREADY() ERROR_NOT_READY +#define Platform_ERRORNOTSAMEDEVICE() ERROR_NOT_SAME_DEVICE +#define Platform_ERRORPATHNOTFOUND() ERROR_PATH_NOT_FOUND +#define Platform_ERRORSHARINGVIOLATION() ERROR_SHARING_VIOLATION +#define Platform_ERRORTOOMANYOPENFILES() ERROR_TOO_MANY_OPEN_FILES +#define Platform_ERRORWRITEPROTECT() ERROR_WRITE_PROTECT +#define Platform_ETIMEDOUT() WSAETIMEDOUT +extern void Heap_InitHeap(); +#define Platform_GetTickCount() (LONGINT)(uint32_t)GetTickCount() +#define Platform_HeapInitHeap() Heap_InitHeap() +#define Platform_SetInterruptHandler(h) SystemSetInterruptHandler((uintptr_t)h) +#define Platform_SetQuitHandler(h) SystemSetQuitHandler((uintptr_t)h) +#define Platform_allocate(size) (LONGINT)(uintptr_t)((void*)HeapAlloc(GetProcessHeap(), 0, (size_t)size)) +#define Platform_bhfiIndexHigh() (LONGINT)bhfi.nFileIndexHigh +#define Platform_bhfiIndexLow() (LONGINT)bhfi.nFileIndexLow +#define Platform_bhfiMtimeHigh() (LONGINT)bhfi.ftLastWriteTime.dwHighDateTime +#define Platform_bhfiMtimeLow() (LONGINT)bhfi.ftLastWriteTime.dwLowDateTime +#define Platform_bhfiVsn() (LONGINT)bhfi.dwVolumeSerialNumber +#define Platform_byHandleFileInformation() BY_HANDLE_FILE_INFORMATION bhfi +#define Platform_cleanupProcess() CloseHandle(pi.hProcess); CloseHandle(pi.hThread); +#define Platform_closeHandle(h) (INTEGER)CloseHandle((HANDLE)(uintptr_t)h) +#define Platform_createProcess(str, str__len) (INTEGER)CreateProcess(0, (char*)str, 0,0,0,0,0,0,&si,&pi) +#define Platform_deleteFile(n, n__len) (INTEGER)DeleteFile((char*)n) +#define Platform_err() (INTEGER)GetLastError() +#define Platform_errc(c) WriteFile((HANDLE)(uintptr_t)Platform_StdOut, &c, 1, 0,0) +#define Platform_errstring(s, s__len) WriteFile((HANDLE)(uintptr_t)Platform_StdOut, s, s__len-1, 0,0) +#define Platform_exit(code) ExitProcess((UINT)code) +#define Platform_fileTimeToSysTime() SYSTEMTIME st; FileTimeToSystemTime(&ft, &st) +#define Platform_flushFileBuffers(h) (INTEGER)FlushFileBuffers((HANDLE)(uintptr_t)h) +#define Platform_free(address) HeapFree(GetProcessHeap(), 0, (void*)(uintptr_t)address) +#define Platform_getCurrentDirectory(n, n__len) GetCurrentDirectory(n__len, (char*)n) +#define Platform_getExitCodeProcess(exitcode) GetExitCodeProcess(pi.hProcess, (DWORD*)exitcode); +#define Platform_getFileInformationByHandle(h) (INTEGER)GetFileInformationByHandle((HANDLE)(uintptr_t)h, &bhfi) +#define Platform_getFilePos(h, r, rc) LARGE_INTEGER liz = {0}; *rc = (INTEGER)SetFilePointerEx((HANDLE)(uintptr_t)h, liz, &li, FILE_CURRENT); *r = (LONGINT)li.QuadPart +#define Platform_getFileSize(h) (INTEGER)GetFileSizeEx((HANDLE)(uintptr_t)h, &li) +#define Platform_getLocalTime() SYSTEMTIME st; GetLocalTime(&st) +#define Platform_getenv(name, name__len, buf, buf__len) (INTEGER)GetEnvironmentVariable((char*)name, (char*)buf, buf__len) +#define Platform_getpid() (INTEGER)GetCurrentProcessId() +#define Platform_getstderrhandle() (uintptr_t)GetStdHandle(STD_ERROR_HANDLE) +#define Platform_getstdinhandle() (uintptr_t)GetStdHandle(STD_INPUT_HANDLE) +#define Platform_getstdouthandle() (uintptr_t)GetStdHandle(STD_OUTPUT_HANDLE) +#define Platform_identityToFileTime(i) FILETIME ft; ft.dwHighDateTime = i.mtimehigh; ft.dwLowDateTime = i.mtimelow +#define Platform_invalidHandleValue() ((LONGINT)(uintptr_t)INVALID_HANDLE_VALUE) +#define Platform_largeInteger() LARGE_INTEGER li +#define Platform_liLongint() (LONGINT)li.QuadPart +#define Platform_moveFile(o, o__len, n, n__len) (INTEGER)MoveFileEx((char*)o, (char*)n, MOVEFILE_REPLACE_EXISTING) +#define Platform_opennew(n, n__len) (LONGINT)(uintptr_t)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0) +#define Platform_openro(n, n__len) (LONGINT)(uintptr_t)CreateFile((char*)n, GENERIC_READ , FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0) +#define Platform_openrw(n, n__len) (LONGINT)(uintptr_t)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0) +#define Platform_processInfo() PROCESS_INFORMATION pi = {0}; +#define Platform_readfile(fd, p, l, n) (INTEGER)ReadFile ((HANDLE)(uintptr_t)fd, (void*)(uintptr_t)(p), (DWORD)l, (DWORD*)n, 0) +#define Platform_seekcur() FILE_CURRENT +#define Platform_seekend() FILE_END +#define Platform_seekset() FILE_BEGIN +#define Platform_setCurrentDirectory(n, n__len) (INTEGER)SetCurrentDirectory((char*)n) +#define Platform_setEndOfFile(h) (INTEGER)SetEndOfFile((HANDLE)(uintptr_t)h) +#define Platform_setFilePointerEx(h, o, r, rc) li.QuadPart=o; *rc = (INTEGER)SetFilePointerEx((HANDLE)(uintptr_t)h, li, 0, (DWORD)r) +#define Platform_sleep(ms) Sleep((DWORD)ms) +#define Platform_startupInfo() STARTUPINFO si = {0}; si.cb = sizeof(si); +#define Platform_sthour() (INTEGER)st.wHour +#define Platform_stmday() (INTEGER)st.wDay +#define Platform_stmin() (INTEGER)st.wMinute +#define Platform_stmon() (INTEGER)st.wMonth +#define Platform_stmsec() (INTEGER)st.wMilliseconds +#define Platform_stsec() (INTEGER)st.wSecond +#define Platform_styear() (INTEGER)st.wYear +#define Platform_waitForProcess() (INTEGER)WaitForSingleObject(pi.hProcess, INFINITE) +#define Platform_writefile(fd, p, l) (INTEGER)WriteFile((HANDLE)(uintptr_t)fd, (void*)(uintptr_t)(p), (DWORD)l, 0,0) + +BOOLEAN Platform_TooManyFiles (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_ERRORTOOMANYOPENFILES(); + return _o_result; +} + +BOOLEAN Platform_NoSuchDirectory (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_ERRORPATHNOTFOUND(); + return _o_result; +} + +BOOLEAN Platform_DifferentFilesystems (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_ERRORNOTSAMEDEVICE(); + return _o_result; +} + +BOOLEAN Platform_Inaccessible (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = ((e == Platform_ERRORACCESSDENIED() || e == Platform_ERRORWRITEPROTECT()) || e == Platform_ERRORNOTREADY()) || e == Platform_ERRORSHARINGVIOLATION(); + return _o_result; +} + +BOOLEAN Platform_Absent (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_ERRORFILENOTFOUND() || e == Platform_ERRORPATHNOTFOUND(); + return _o_result; +} + +BOOLEAN Platform_TimedOut (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = e == Platform_ETIMEDOUT(); + return _o_result; +} + +BOOLEAN Platform_ConnectionFailed (INTEGER e) +{ + BOOLEAN _o_result; + _o_result = ((e == Platform_ECONNREFUSED() || e == Platform_ECONNABORTED()) || e == Platform_ENETUNREACH()) || e == Platform_EHOSTUNREACH(); + return _o_result; +} + +LONGINT Platform_OSAllocate (LONGINT size) +{ + LONGINT _o_result; + _o_result = Platform_allocate(size); + return _o_result; +} + +void Platform_OSFree (LONGINT address) +{ + Platform_free(address); +} + +void Platform_Init (INTEGER argc, LONGINT argvadr) +{ + Platform_ArgVecPtr av = NIL; + Platform_MainStackFrame = argvadr; + Platform_ArgCount = argc; + av = (Platform_ArgVecPtr)(uintptr_t)argvadr; + Platform_ArgVector = (*av)[0]; + Platform_HaltCode = -128; + Platform_HeapInitHeap(); +} + +BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len) +{ + BOOLEAN _o_result; + CHAR buf[4096]; + INTEGER res; + __DUP(var, var__len, CHAR); + res = Platform_getenv(var, var__len, (void*)buf, ((LONGINT)(4096))); + if ((res > 0 && res < 4096)) { + __COPY(buf, val, val__len); + _o_result = 1; + __DEL(var); + return _o_result; + } else { + _o_result = 0; + __DEL(var); + return _o_result; + } + __RETCHK; +} + +void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len) +{ + __DUP(var, var__len, CHAR); + if (!Platform_getEnv(var, var__len, (void*)val, val__len)) { + val[0] = 0x00; + } + __DEL(var); +} + +void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len) +{ + Platform_ArgVec av = NIL; + if (n < Platform_ArgCount) { + av = (Platform_ArgVec)(uintptr_t)Platform_ArgVector; + __COPY(*(*av)[__X(n, ((LONGINT)(1024)))], val, val__len); + } +} + +void Platform_GetIntArg (INTEGER n, LONGINT *val) +{ + CHAR s[64]; + LONGINT k, d, i; + s[0] = 0x00; + Platform_GetArg(n, (void*)s, ((LONGINT)(64))); + i = 0; + if (s[0] == '-') { + i = 1; + } + k = 0; + d = (int)s[__X(i, ((LONGINT)(64)))] - 48; + while ((d >= 0 && d <= 9)) { + k = k * 10 + d; + i += 1; + d = (int)s[__X(i, ((LONGINT)(64)))] - 48; + } + if (s[0] == '-') { + k = -k; + i -= 1; + } + if (i > 0) { + *val = k; + } +} + +INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len) +{ + INTEGER _o_result; + INTEGER i; + CHAR arg[256]; + __DUP(s, s__len, CHAR); + i = 0; + Platform_GetArg(i, (void*)arg, ((LONGINT)(256))); + while ((i < Platform_ArgCount && __STRCMP(s, arg) != 0)) { + i += 1; + Platform_GetArg(i, (void*)arg, ((LONGINT)(256))); + } + _o_result = i; + __DEL(s); + return _o_result; +} + +void Platform_SetBadInstructionHandler (Platform_SignalHandler handler) +{ +} + +static void Platform_YMDHMStoClock (INTEGER ye, INTEGER mo, INTEGER da, INTEGER ho, INTEGER mi, INTEGER se, LONGINT *t, LONGINT *d) +{ + *d = (__ASHL((LONGINT)(int)__MOD(ye, 100), 9) + __ASHL((LONGINT)(mo + 1), 5)) + (LONGINT)da; + *t = (__ASHL((LONGINT)ho, 12) + __ASHL((LONGINT)mi, 6)) + (LONGINT)se; +} + +void Platform_GetClock (LONGINT *t, LONGINT *d) +{ + Platform_getLocalTime(); + Platform_YMDHMStoClock(Platform_styear(), Platform_stmon(), Platform_stmday(), Platform_sthour(), Platform_stmin(), Platform_stsec(), &*t, &*d); +} + +void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec) +{ + Platform_getLocalTime(); + *sec = Platform_stsec(); + *usec = (LONGINT)Platform_stmsec() * 1000; +} + +LONGINT Platform_Time (void) +{ + LONGINT _o_result; + LONGINT ms; + ms = Platform_GetTickCount(); + _o_result = __MOD(ms - Platform_TimeStart, 2147483647); + return _o_result; +} + +void Platform_Delay (LONGINT ms) +{ + while (ms > 30000) { + Platform_sleep(((LONGINT)(30000))); + ms = ms - 30000; + } + if (ms > 0) { + Platform_sleep(ms); + } +} + +INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len) +{ + INTEGER _o_result; + INTEGER result; + __DUP(cmd, cmd__len, CHAR); + result = 127; + Platform_startupInfo(); + Platform_processInfo(); + if (Platform_createProcess(cmd, cmd__len) != 0) { + if (Platform_waitForProcess() == 0) { + Platform_getExitCodeProcess(&result); + } + Platform_cleanupProcess(); + } + _o_result = __ASHL(result, 8); + __DEL(cmd); + return _o_result; +} + +INTEGER Platform_Error (void) +{ + INTEGER _o_result; + _o_result = Platform_err(); + return _o_result; +} + +INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h) +{ + INTEGER _o_result; + LONGINT fd; + fd = Platform_openro(n, n__len); + if (fd == Platform_invalidHandleValue()) { + _o_result = Platform_err(); + return _o_result; + } else { + *h = fd; + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h) +{ + INTEGER _o_result; + LONGINT fd; + fd = Platform_openrw(n, n__len); + if (fd == Platform_invalidHandleValue()) { + _o_result = Platform_err(); + return _o_result; + } else { + *h = fd; + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h) +{ + INTEGER _o_result; + LONGINT fd; + fd = Platform_opennew(n, n__len); + if (fd == Platform_invalidHandleValue()) { + _o_result = Platform_err(); + return _o_result; + } else { + *h = fd; + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Close (LONGINT h) +{ + INTEGER _o_result; + if (Platform_closeHandle(h) == 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ) +{ + INTEGER _o_result; + Platform_byHandleFileInformation(); + if (Platform_getFileInformationByHandle(h) == 0) { + _o_result = Platform_err(); + return _o_result; + } + (*identity).volume = Platform_bhfiVsn(); + (*identity).indexhigh = Platform_bhfiIndexHigh(); + (*identity).indexlow = Platform_bhfiIndexLow(); + (*identity).mtimehigh = Platform_bhfiMtimeHigh(); + (*identity).mtimelow = Platform_bhfiMtimeLow(); + _o_result = 0; + return _o_result; +} + +INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ) +{ + INTEGER _o_result; + LONGINT h; + INTEGER e, i; + __DUP(n, n__len, CHAR); + e = Platform_OldRO((void*)n, n__len, &h); + if (e != 0) { + _o_result = e; + __DEL(n); + return _o_result; + } + e = Platform_Identify(h, &*identity, identity__typ); + i = Platform_Close(h); + _o_result = e; + __DEL(n); + return _o_result; +} + +BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2) +{ + BOOLEAN _o_result; + _o_result = (((i1.indexhigh == i2.indexhigh && i1.indexlow == i2.indexlow)) && i1.volume == i2.volume); + return _o_result; +} + +BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2) +{ + BOOLEAN _o_result; + _o_result = (i1.mtimehigh == i2.mtimehigh && i1.mtimelow == i2.mtimelow); + return _o_result; +} + +void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source) +{ + (*target).mtimehigh = source.mtimehigh; + (*target).mtimelow = source.mtimelow; +} + +void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d) +{ + Platform_identityToFileTime(i); + Platform_fileTimeToSysTime(); + Platform_YMDHMStoClock(Platform_styear(), Platform_stmon(), Platform_stmday(), Platform_sthour(), Platform_stmin(), Platform_stsec(), &*t, &*d); +} + +INTEGER Platform_Size (LONGINT h, LONGINT *l) +{ + INTEGER _o_result; + Platform_largeInteger(); + if (Platform_getFileSize(h) == 0) { + _o_result = Platform_err(); + return _o_result; + } + *l = Platform_liLongint(); + _o_result = 0; + return _o_result; +} + +INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n) +{ + INTEGER _o_result; + INTEGER result; + *n = 0; + result = Platform_readfile(h, p, l, &*n); + if (result == 0) { + *n = 0; + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n) +{ + INTEGER _o_result; + INTEGER result; + *n = 0; + result = Platform_readfile(h, (LONGINT)(uintptr_t)b, b__len, &*n); + if (result == 0) { + *n = 0; + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l) +{ + INTEGER _o_result; + if (Platform_writefile(h, p, l) == 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Sync (LONGINT h) +{ + INTEGER _o_result; + if (Platform_flushFileBuffers(h) == 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Seek (LONGINT h, LONGINT o, INTEGER r) +{ + INTEGER _o_result; + INTEGER rc; + Platform_largeInteger(); + Platform_setFilePointerEx(h, o, r, &rc); + if (rc == 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Truncate (LONGINT h, LONGINT limit) +{ + INTEGER _o_result; + INTEGER rc; + LONGINT oldpos; + Platform_largeInteger(); + Platform_getFilePos(h, &oldpos, &rc); + if (rc == 0) { + _o_result = Platform_err(); + return _o_result; + } + Platform_setFilePointerEx(h, limit, Platform_seekset(), &rc); + if (rc == 0) { + _o_result = Platform_err(); + return _o_result; + } + if (Platform_setEndOfFile(h) == 0) { + _o_result = Platform_err(); + return _o_result; + } + Platform_setFilePointerEx(h, oldpos, Platform_seekset(), &rc); + if (rc == 0) { + _o_result = Platform_err(); + return _o_result; + } + _o_result = 0; + return _o_result; +} + +INTEGER Platform_Unlink (CHAR *n, LONGINT n__len) +{ + INTEGER _o_result; + if (Platform_deleteFile(n, n__len) == 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +INTEGER Platform_Chdir (CHAR *n, LONGINT n__len) +{ + INTEGER _o_result; + INTEGER r; + r = Platform_setCurrentDirectory(n, n__len); + if (r == 0) { + _o_result = Platform_err(); + return _o_result; + } + Platform_getCurrentDirectory((void*)Platform_CWD, ((LONGINT)(4096))); + _o_result = 0; + return _o_result; +} + +INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len) +{ + INTEGER _o_result; + if (Platform_moveFile(o, o__len, n, n__len) == 0) { + _o_result = Platform_err(); + return _o_result; + } else { + _o_result = 0; + return _o_result; + } + __RETCHK; +} + +void Platform_Exit (INTEGER code) +{ + Platform_exit(code); +} + +static void Platform_errch (CHAR c) +{ + Platform_errc(c); +} + +static void Platform_errln (void) +{ + Platform_errch(0x0d); + Platform_errch(0x0a); +} + +static void Platform_errposint (LONGINT l) +{ + if (l > 10) { + Platform_errposint(__DIV(l, 10)); + } + Platform_errch((CHAR)(48 + __MOD(l, 10))); +} + +static void Platform_errint (LONGINT l) +{ + if (l < 0) { + Platform_errch('-'); + l = -l; + } + Platform_errposint(l); +} + +static void Platform_DisplayHaltCode (LONGINT code) +{ + switch (code) { + case -1: + Platform_errstring((CHAR*)"Rider ReadBuf/WriteBuf transfer size longer than buffer.", (LONGINT)57); + break; + case -2: + Platform_errstring((CHAR*)"Index out of range.", (LONGINT)20); + break; + case -3: + Platform_errstring((CHAR*)"Reached end of function without reaching RETURN.", (LONGINT)49); + break; + case -4: + Platform_errstring((CHAR*)"CASE statement: no matching label and no ELSE.", (LONGINT)47); + break; + case -5: + Platform_errstring((CHAR*)"Type guard failed.", (LONGINT)19); + break; + case -6: + Platform_errstring((CHAR*)"Type equality failed.", (LONGINT)22); + break; + case -7: + Platform_errstring((CHAR*)"WITH statement type guard failed.", (LONGINT)34); + break; + case -8: + Platform_errstring((CHAR*)"SHORT: Value too large for shorter type.", (LONGINT)41); + break; + case -9: + Platform_errstring((CHAR*)"Heap interrupted while locked, but lockdepth = 0 at unlock.", (LONGINT)60); + break; + case -15: + Platform_errstring((CHAR*)"Type descriptor size mismatch.", (LONGINT)31); + break; + case -20: + Platform_errstring((CHAR*)"Too many, or negative number of, elements in dynamic array.", (LONGINT)60); + break; + default: + break; + } +} + +void Platform_Halt (LONGINT code) +{ + INTEGER e; + Platform_HaltCode = code; + if (Platform_HaltHandler != NIL) { + (*Platform_HaltHandler)(code); + } + Platform_errstring((CHAR*)"Terminated by Halt(", (LONGINT)20); + Platform_errint(code); + Platform_errstring((CHAR*)"). ", (LONGINT)4); + if (code < 0) { + Platform_DisplayHaltCode(code); + } + Platform_errln(); + Platform_exit(__VAL(INTEGER, code)); +} + +void Platform_AssertFail (LONGINT code) +{ + INTEGER e; + Platform_errstring((CHAR*)"Assertion failure.", (LONGINT)19); + if (code != 0) { + Platform_errstring((CHAR*)" ASSERT code ", (LONGINT)14); + Platform_errint(code); + Platform_errstring((CHAR*)".", (LONGINT)2); + } + Platform_errln(); + Platform_exit(__VAL(INTEGER, code)); +} + +void Platform_SetHalt (Platform_HaltProcedure p) +{ + Platform_HaltHandler = p; +} + +static void Platform_TestLittleEndian (void) +{ + INTEGER i; + i = 1; + __GET((LONGINT)(uintptr_t)&i, Platform_LittleEndian, BOOLEAN); +} + +__TDESC(Platform_FileIdentity, 1, 0) = {__TDFLDS("FileIdentity", 40), {-8}}; + +export void *Platform__init(void) +{ + __DEFMOD; + __REGMOD("Platform", 0); + __INITYP(Platform_FileIdentity, Platform_FileIdentity, 0); +/* BEGIN */ + Platform_TestLittleEndian(); + Platform_HaltCode = -128; + Platform_HaltHandler = NIL; + Platform_TimeStart = Platform_Time(); + Platform_CWD[0] = 0x00; + Platform_getCurrentDirectory((void*)Platform_CWD, ((LONGINT)(4096))); + Platform_PID = Platform_getpid(); + Platform_SeekSet = Platform_seekset(); + Platform_SeekCur = Platform_seekcur(); + Platform_SeekEnd = Platform_seekend(); + Platform_StdIn = Platform_getstdinhandle(); + Platform_StdOut = Platform_getstdouthandle(); + Platform_StdErr = Platform_getstderrhandle(); + Platform_nl[0] = 0x0d; + Platform_nl[1] = 0x0a; + Platform_nl[2] = 0x00; + __ENDMOD; +} diff --git a/bootstrap/windows-88/Platform.h b/bootstrap/windows-88/Platform.h new file mode 100644 index 00000000..c3b2dd2d --- /dev/null +++ b/bootstrap/windows-88/Platform.h @@ -0,0 +1,85 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Platform__h +#define Platform__h + +#define LARGE +#include "SYSTEM.h" + +typedef + struct Platform_FileIdentity { + LONGINT _prvt0; + char _prvt1[32]; + } Platform_FileIdentity; + +typedef + void (*Platform_HaltProcedure)(LONGINT); + +typedef + void (*Platform_SignalHandler)(INTEGER); + + +import BOOLEAN Platform_LittleEndian; +import LONGINT Platform_MainStackFrame, Platform_HaltCode; +import INTEGER Platform_PID; +import CHAR Platform_CWD[4096]; +import INTEGER Platform_ArgCount; +import LONGINT Platform_ArgVector; +import INTEGER Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd; +import LONGINT Platform_StdIn, Platform_StdOut, Platform_StdErr; +import CHAR Platform_nl[3]; + +import LONGINT *Platform_FileIdentity__typ; + +import BOOLEAN Platform_Absent (INTEGER e); +import INTEGER Platform_ArgPos (CHAR *s, LONGINT s__len); +import void Platform_AssertFail (LONGINT code); +import INTEGER Platform_Chdir (CHAR *n, LONGINT n__len); +import INTEGER Platform_Close (LONGINT h); +import BOOLEAN Platform_ConnectionFailed (INTEGER e); +import void Platform_Delay (LONGINT ms); +import BOOLEAN Platform_DifferentFilesystems (INTEGER e); +import INTEGER Platform_Error (void); +import void Platform_Exit (INTEGER code); +import void Platform_GetArg (INTEGER n, CHAR *val, LONGINT val__len); +import void Platform_GetClock (LONGINT *t, LONGINT *d); +import void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len); +import void Platform_GetIntArg (INTEGER n, LONGINT *val); +import void Platform_GetTimeOfDay (LONGINT *sec, LONGINT *usec); +import void Platform_Halt (LONGINT code); +import INTEGER Platform_Identify (LONGINT h, Platform_FileIdentity *identity, LONGINT *identity__typ); +import INTEGER Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, LONGINT *identity__typ); +import BOOLEAN Platform_Inaccessible (INTEGER e); +import void Platform_Init (INTEGER argc, LONGINT argvadr); +import void Platform_MTimeAsClock (Platform_FileIdentity i, LONGINT *t, LONGINT *d); +import INTEGER Platform_New (CHAR *n, LONGINT n__len, LONGINT *h); +import BOOLEAN Platform_NoSuchDirectory (INTEGER e); +import LONGINT Platform_OSAllocate (LONGINT size); +import void Platform_OSFree (LONGINT address); +import INTEGER Platform_OldRO (CHAR *n, LONGINT n__len, LONGINT *h); +import INTEGER Platform_OldRW (CHAR *n, LONGINT n__len, LONGINT *h); +import INTEGER Platform_Read (LONGINT h, LONGINT p, LONGINT l, LONGINT *n); +import INTEGER Platform_ReadBuf (LONGINT h, SYSTEM_BYTE *b, LONGINT b__len, LONGINT *n); +import INTEGER Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len); +import BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2); +import BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2); +import INTEGER Platform_Seek (LONGINT h, LONGINT o, INTEGER r); +import void Platform_SetBadInstructionHandler (Platform_SignalHandler handler); +import void Platform_SetHalt (Platform_HaltProcedure p); +import void Platform_SetMTime (Platform_FileIdentity *target, LONGINT *target__typ, Platform_FileIdentity source); +import INTEGER Platform_Size (LONGINT h, LONGINT *l); +import INTEGER Platform_Sync (LONGINT h); +import INTEGER Platform_System (CHAR *cmd, LONGINT cmd__len); +import LONGINT Platform_Time (void); +import BOOLEAN Platform_TimedOut (INTEGER e); +import BOOLEAN Platform_TooManyFiles (INTEGER e); +import INTEGER Platform_Truncate (LONGINT h, LONGINT limit); +import INTEGER Platform_Unlink (CHAR *n, LONGINT n__len); +import INTEGER Platform_Write (LONGINT h, LONGINT p, LONGINT l); +import BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len); +import void *Platform__init(void); + +#define Platform_SetInterruptHandler(h) SystemSetInterruptHandler((uintptr_t)h) +#define Platform_SetQuitHandler(h) SystemSetQuitHandler((uintptr_t)h) + +#endif diff --git a/bootstrap/windows-88/Reals.c b/bootstrap/windows-88/Reals.c new file mode 100644 index 00000000..edf27d40 --- /dev/null +++ b/bootstrap/windows-88/Reals.c @@ -0,0 +1,143 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" + + + + +export void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len); +export void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len); +export void Reals_ConvertHL (LONGREAL y, CHAR *d, LONGINT d__len); +export void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len); +export INTEGER Reals_Expo (REAL x); +export INTEGER Reals_ExpoL (LONGREAL x); +export REAL Reals_Ten (INTEGER e); +export LONGREAL Reals_TenL (INTEGER e); +static CHAR Reals_ToHex (INTEGER i); + + +REAL Reals_Ten (INTEGER e) +{ + REAL _o_result; + LONGREAL r, power; + r = (LONGREAL)1; + power = (LONGREAL)10; + while (e > 0) { + if (__ODD(e)) { + r = r * power; + } + power = power * power; + e = __ASHR(e, 1); + } + _o_result = r; + return _o_result; +} + +LONGREAL Reals_TenL (INTEGER e) +{ + LONGREAL _o_result; + LONGREAL r, power; + r = (LONGREAL)1; + power = (LONGREAL)10; + for (;;) { + if (__ODD(e)) { + r = r * power; + } + e = __ASHR(e, 1); + if (e <= 0) { + _o_result = r; + return _o_result; + } + power = power * power; + } + __RETCHK; +} + +INTEGER Reals_Expo (REAL x) +{ + INTEGER _o_result; + _o_result = (int)__MASK(__ASHR((LONGINT)(__VAL(INTEGER, x)), 23), -256); + return _o_result; +} + +INTEGER Reals_ExpoL (LONGREAL x) +{ + INTEGER _o_result; + INTEGER i; + LONGINT l; + __GET((LONGINT)(uintptr_t)&x + 4, i, INTEGER); + _o_result = (int)__MASK(__ASHR((LONGINT)i, 20), -2048); + return _o_result; +} + +void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len) +{ + LONGINT i, j, k; + if (x < (LONGREAL)0) { + x = -x; + } + k = 0; + i = __ENTIER(x); + while (k < (LONGINT)n) { + d[__X(k, d__len)] = (CHAR)(__MOD(i, 10) + 48); + i = __DIV(i, 10); + k += 1; + } +} + +void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len) +{ + Reals_ConvertL(x, n, (void*)d, d__len); +} + +static CHAR Reals_ToHex (INTEGER i) +{ + CHAR _o_result; + if (i < 10) { + _o_result = (CHAR)(i + 48); + return _o_result; + } else { + _o_result = (CHAR)(i + 55); + return _o_result; + } + __RETCHK; +} + +typedef + CHAR (*pc4__3)[4]; + +void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len) +{ + pc4__3 p = NIL; + INTEGER i; + p = (pc4__3)(uintptr_t)((LONGINT)(uintptr_t)&y); + i = 0; + while (i < 4) { + d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((int)(*p)[__X(i, ((LONGINT)(4)))], 4)); + d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((int)(*p)[__X(i, ((LONGINT)(4)))], -16)); + } +} + +typedef + CHAR (*pc8__5)[8]; + +void Reals_ConvertHL (LONGREAL y, CHAR *d, LONGINT d__len) +{ + pc8__5 p = NIL; + INTEGER i; + p = (pc8__5)(uintptr_t)((LONGINT)(uintptr_t)&y); + i = 0; + while (i < 8) { + d[__X(__ASHL(i, 1), d__len)] = Reals_ToHex(__ASHR((int)(*p)[__X(i, ((LONGINT)(8)))], 4)); + d[__X(__ASHL(i, 1) + 1, d__len)] = Reals_ToHex(__MASK((int)(*p)[__X(i, ((LONGINT)(8)))], -16)); + } +} + + +export void *Reals__init(void) +{ + __DEFMOD; + __REGMOD("Reals", 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/windows-88/Reals.h b/bootstrap/windows-88/Reals.h new file mode 100644 index 00000000..5febc0f1 --- /dev/null +++ b/bootstrap/windows-88/Reals.h @@ -0,0 +1,23 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Reals__h +#define Reals__h + +#define LARGE +#include "SYSTEM.h" + + + + +import void Reals_Convert (REAL x, INTEGER n, CHAR *d, LONGINT d__len); +import void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len); +import void Reals_ConvertHL (LONGREAL y, CHAR *d, LONGINT d__len); +import void Reals_ConvertL (LONGREAL x, INTEGER n, CHAR *d, LONGINT d__len); +import INTEGER Reals_Expo (REAL x); +import INTEGER Reals_ExpoL (LONGREAL x); +import REAL Reals_Ten (INTEGER e); +import LONGREAL Reals_TenL (INTEGER e); +import void *Reals__init(void); + + +#endif diff --git a/bootstrap/windows-88/SYSTEM.c b/bootstrap/windows-88/SYSTEM.c new file mode 100644 index 00000000..0fcc5ee2 --- /dev/null +++ b/bootstrap/windows-88/SYSTEM.c @@ -0,0 +1,207 @@ +/* +* The body prefix file of the voc(jet backend) runtime system, Version 1.0 +* +* Copyright (c) Software Templ, 1994, 1995 +* +* Module SYSTEM is subject to change any time without prior notification. +* Software Templ disclaims all warranties with regard to module SYSTEM, +* in particular shall Software Templ not be liable for any damage resulting +* from inappropriate use or modification of module SYSTEM. +* +* Version 1.1 jt, 24.11.95 fixes for correct pointer arithmetic on Cray computers +* jt 31.1.2007 ANSI prototypes for malloc and exit in order to avoid cc warnings +* +*/ + +#include "SYSTEM.h" +#include "stdarg.h" +#include + + +LONGINT SYSTEM_XCHK(LONGINT i, LONGINT ub) {return __X(i, ub);} +LONGINT SYSTEM_RCHK(LONGINT i, LONGINT ub) {return __R(i, ub);} +LONGINT SYSTEM_ASH (LONGINT i, LONGINT n) {return __ASH(i, n);} +LONGINT SYSTEM_ABS (LONGINT i) {return __ABS(i);} +double SYSTEM_ABSD(double i) {return __ABS(i);} + +void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0) +{ + t -= __TPROC0OFF; + t0 -= __TPROC0OFF; + while (*t0 != __EOM) {*t = *t0; t--; t0--;} +} + + +void SYSTEM_ENUMP(void *adr, LONGINT n, void (*P)()) +{ + while (n > 0) { + P((LONGINT)(uintptr_t)(*((void**)(adr)))); + adr = ((void**)adr) + 1; + n--; + } +} + +void SYSTEM_ENUMR(void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)()) +{ + LONGINT *t, off; + typ++; + while (n > 0) { + t = typ; + off = *t; + while (off >= 0) {P(*(LONGINT*)((char*)adr+off)); t++; off = *t;} + adr = ((char*)adr) + size; + n--; + } +} + +LONGINT SYSTEM_DIV(unsigned LONGINT x, unsigned LONGINT y) +{ if ((LONGINT) x >= 0) return (x / y); + else return -((y - 1 - x) / y); +} + +LONGINT SYSTEM_MOD(unsigned LONGINT x, unsigned LONGINT y) +{ unsigned LONGINT m; + if ((LONGINT) x >= 0) return (x % y); + else { m = (-x) % y; + if (m != 0) return (y - m); else return 0; + } +} + +LONGINT SYSTEM_ENTIER(double x) +{ + LONGINT y; + if (x >= 0) + return (LONGINT)x; + else { + y = (LONGINT)x; + if (y <= x) return y; else return y - 1; + } +} + +extern void Heap_Lock(); +extern void Heap_Unlock(); + +SYSTEM_PTR SYSTEM_NEWARR(LONGINT *typ, LONGINT elemsz, int elemalgn, int nofdim, int nofdyn, ...) +{ + LONGINT nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off; + va_list ap; + va_start(ap, nofdyn); + nofelems = 1; + while (nofdim > 0) { + nofelems = nofelems * va_arg(ap, LONGINT); nofdim--; + if (nofelems <= 0) __HALT(-20); + } + va_end(ap); + dataoff = nofdyn * sizeof(LONGINT); + if (elemalgn > sizeof(LONGINT)) { + n = dataoff % elemalgn; + if (n != 0) dataoff += elemalgn - n; + } + size = dataoff + nofelems * elemsz; + Heap_Lock(); + if (typ == NIL) { + /* element typ does not contain pointers */ + x = Heap_NEWBLK(size); + } + else if (typ == (LONGINT*)POINTER__typ) { + /* element type is a pointer */ + x = Heap_NEWBLK(size + nofelems * sizeof(LONGINT)); + p = (LONGINT*)(uintptr_t)x[-1]; + p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ + p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */ + while (n <= nofelems) {*p = n*sizeof(LONGINT); p++; n++;} + *p = - (nofelems + 1) * sizeof(LONGINT); /* sentinel */ + x[-1] -= nofelems * sizeof(LONGINT); + } + else { + /* element type is a record that contains pointers */ + ptab = typ + 1; nofptrs = 0; + while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */ + nptr = nofelems * nofptrs; /* total number of pointers */ + x = Heap_NEWBLK(size + nptr * sizeof(LONGINT)); + p = (LONGINT*)(uintptr_t)x[- 1]; + p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ + p -= nptr - 1; n = 0; off = dataoff; + while (n < nofelems) {i = 0; + while (i < nofptrs) {*p = off + ptab[i]; p++; i++;} + off += elemsz; n++; + } + *p = - (nptr + 1) * sizeof(LONGINT); /* sentinel */ + x[-1] -= nptr * sizeof(LONGINT); + } + if (nofdyn != 0) { + /* setup len vector for index checks */ + va_start(ap, nofdyn); + p = x; + while (nofdyn > 0) {*p = va_arg(ap, LONGINT); p++, nofdyn--;} + va_end(ap); + } + Heap_Unlock(); + return x; +} + + + + +typedef void (*SystemSignalHandler)(INTEGER); // = Platform_SignalHandler + +#ifndef _WIN32 + + SystemSignalHandler handler[3] = {0}; + + // Provide signal handling for Unix based systems + void signalHandler(int s) { + if (s >= 2 && s <= 4) handler[s-2](s); + // (Ignore other signals) + } + + void SystemSetHandler(int s, uintptr_t h) { + if (s >= 2 && s <= 4) { + int needtosetsystemhandler = handler[s-2] == 0; + handler[s-2] = (SystemSignalHandler)h; + if (needtosetsystemhandler) {signal(s, signalHandler);} + } + } + +#else + + // Provides Windows callback handlers for signal-like scenarios + #include "WindowsWrapper.h" + + SystemSignalHandler SystemInterruptHandler = 0; + SystemSignalHandler SystemQuitHandler = 0; + BOOL ConsoleCtrlHandlerSet = FALSE; + + BOOL WINAPI SystemConsoleCtrlHandler(DWORD ctrlType) { + if ((ctrlType == CTRL_C_EVENT) || (ctrlType == CTRL_BREAK_EVENT)) { + if (SystemInterruptHandler) { + SystemInterruptHandler(2); // SIGINT + return TRUE; + } + } else { // Close, logoff or shutdown + if (SystemQuitHandler) { + SystemQuitHandler(3); // SIGQUIT + return TRUE; + } + } + return FALSE; + } + + void EnsureConsoleCtrlHandler() { + if (!ConsoleCtrlHandlerSet) { + SetConsoleCtrlHandler(SystemConsoleCtrlHandler, TRUE); + ConsoleCtrlHandlerSet = TRUE; + } + } + + void SystemSetInterruptHandler(uintptr_t h) { + EnsureConsoleCtrlHandler(); + SystemInterruptHandler = (SystemSignalHandler)h; + } + + void SystemSetQuitHandler(uintptr_t h) { + EnsureConsoleCtrlHandler(); + SystemQuitHandler = (SystemSignalHandler)h; + } + +#endif diff --git a/bootstrap/windows-88/SYSTEM.h b/bootstrap/windows-88/SYSTEM.h new file mode 100644 index 00000000..f9e2f930 --- /dev/null +++ b/bootstrap/windows-88/SYSTEM.h @@ -0,0 +1,275 @@ +#ifndef SYSTEM__h +#define SYSTEM__h + +#ifndef _WIN32 + + // Building for a Unix/Linux based system + #include // For memcpy ... + #include // For uintptr_t ... + +#else + + // Building for Windows platform with either mingw under cygwin, or the MS C compiler + #ifdef _WIN64 + typedef unsigned long long size_t; + typedef unsigned long long uintptr_t; + #else + typedef unsigned int size_t; + typedef unsigned int uintptr_t; + #endif /* _WIN64 */ + + typedef unsigned int uint32_t; + void * __cdecl memcpy(void * dest, const void * source, size_t size); + +#endif + + +// The compiler uses 'import' and 'export' which translate to 'extern' and +// nothing respectively. + +#define import extern +#define export + + + +// Known constants + +#define NIL ((void*)0) +#define __MAXEXT 16 +#define POINTER__typ ((LONGINT*)(1)) // not NIL and not a valid type + + +// Oberon types + +#define BOOLEAN char +#define SYSTEM_BYTE unsigned char +#define CHAR unsigned char +#define SHORTINT signed char +#define REAL float +#define LONGREAL double +#define SYSTEM_PTR void* + +// For 32 bit builds, the size of LONGINT depends on a make option: + +#if (__SIZEOF_POINTER__ == 8) || defined(LARGE) || defined(_WIN64) + #define INTEGER int // INTEGER is 32 bit. + #define LONGINT long long // LONGINT is 64 bit. (long long is always 64 bits, while long can be 32 bits e.g. under MSC/MingW) +#else + #define INTEGER short int // INTEGER is 16 bit. + #define LONGINT long // LONGINT is 32 bit. +#endif + +#define SET unsigned LONGINT + + +// OS Memory allocation interfaces are in PlatformXXX.Mod + +extern LONGINT Platform_OSAllocate (LONGINT size); +extern void Platform_OSFree (LONGINT addr); + + +// Run time system routines in SYSTEM.c + +extern LONGINT SYSTEM_XCHK (LONGINT i, LONGINT ub); +extern LONGINT SYSTEM_RCHK (LONGINT i, LONGINT ub); +extern LONGINT SYSTEM_ASH (LONGINT i, LONGINT n); +extern LONGINT SYSTEM_ABS (LONGINT i); +extern double SYSTEM_ABSD (double i); +extern void SYSTEM_INHERIT(LONGINT *t, LONGINT *t0); +extern void SYSTEM_ENUMP (void *adr, LONGINT n, void (*P)()); +extern void SYSTEM_ENUMR (void *adr, LONGINT *typ, LONGINT size, LONGINT n, void (*P)()); +extern LONGINT SYSTEM_DIV (unsigned LONGINT x, unsigned LONGINT y); +extern LONGINT SYSTEM_MOD (unsigned LONGINT x, unsigned LONGINT y); +extern LONGINT SYSTEM_ENTIER (double x); + + +// Signal handling in SYSTEM.c + +#ifndef _WIN32 + extern void SystemSetHandler(int s, uintptr_t h); +#else + extern void SystemSetInterruptHandler(uintptr_t h); + extern void SystemSetQuitHandler (uintptr_t h); +#endif + + + +// String comparison + +static int __str_cmp(CHAR *x, CHAR *y){ + LONGINT i = 0; + CHAR ch1, ch2; + do {ch1 = x[i]; ch2 = y[i]; i++; + if (!ch1) return -(int)ch2; + } while (ch1==ch2); + return (int)ch1 - (int)ch2; +} +#define __STRCMP(a,b) __str_cmp((CHAR*)(a), (CHAR*)(b)) + + + +// Inline string, record and array copy + +#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d; LONGINT _i=0,_t=n-1; \ + while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;} +#define __DUP(x, l, t) x=(void*)memcpy((void*)(uintptr_t)Platform_OSAllocate(l*sizeof(t)),x,l*sizeof(t)) +#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t)) +#define __DEL(x) Platform_OSFree((LONGINT)(uintptr_t)x) + + + + +/* SYSTEM ops */ + +#define __VAL(t, x) ((t)(x)) +#define __VALP(t, x) ((t)(uintptr_t)(x)) + +#define __GET(a, x, t) x= *(t*)(uintptr_t)(a) +#define __PUT(a, x, t) *(t*)(uintptr_t)(a)=x +#define __LSHL(x, n, t) ((t)((unsigned t)(x)<<(n))) +#define __LSHR(x, n, t) ((t)((unsigned t)(x)>>(n))) +#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) +#define __ROTL(x, n, t) ((t)((unsigned t)(x)<<(n)|(unsigned t)(x)>>(8*sizeof(t)-(n)))) +#define __ROTR(x, n, t) ((t)((unsigned t)(x)>>(n)|(unsigned t)(x)<<(8*sizeof(t)-(n)))) +#define __LSHR(x, n, t) ((t)((unsigned t)(x)>>(n))) +#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) +#define __ROTL(x, n, t) ((t)((unsigned t)(x)<<(n)|(unsigned t)(x)>>(8*sizeof(t)-(n)))) +#define __ROTR(x, n, t) ((t)((unsigned t)(x)>>(n)|(unsigned t)(x)<<(8*sizeof(t)-(n)))) +#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t)) +#define __BIT(x, n) (*(unsigned LONGINT*)(x)>>(n)&1) +#define __MOVE(s, d, n) memcpy((char*)(uintptr_t)(d),(char*)(uintptr_t)(s),n) +#define __ASHL(x, n) ((LONGINT)(x)<<(n)) +#define __ASHR(x, n) ((LONGINT)(x)>>(n)) +#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n))) +#define __ASHF(x, n) SYSTEM_ASH((LONGINT)(x), (LONGINT)(n)) +#define __SHORT(x, y) ((int)((unsigned LONGINT)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0))) +#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y))) +#define __CHR(x) ((CHAR)__R(x, 256)) +#define __CHRF(x) ((CHAR)__RF(x, 256)) +#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y))) +#define __DIVF(x, y) SYSTEM_DIV((LONGINT)(x),(LONGINT)(y)) +#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y)) +#define __MODF(x, y) SYSTEM_MOD((LONGINT)(x),(LONGINT)(y)) +#define __ENTIER(x) SYSTEM_ENTIER(x) +#define __ABS(x) (((x)<0)?-(x):(x)) +#define __ABSF(x) SYSTEM_ABS((LONGINT)(x)) +#define __ABSFD(x) SYSTEM_ABSD((double)(x)) +#define __CAP(ch) ((CHAR)((ch)&0x5f)) +#define __ODD(x) ((x)&1) +#define __IN(x, s) (((s)>>(x))&1) +#define __SETOF(x) ((SET)1<<(x)) +#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h))) +#define __MASK(x, m) ((x)&~(m)) + + + +// Runtime checks + +#define __X(i, ub) (((unsigned LONGINT)(i)<(unsigned LONGINT)(ub))?i:(__HALT(-2),0)) +#define __XF(i, ub) SYSTEM_XCHK((LONGINT)(i), (LONGINT)(ub)) +#define __R(i, ub) (((unsigned LONGINT)(i)<(unsigned LONGINT)(ub))?i:(__HALT(-8),0)) +#define __RF(i, ub) SYSTEM_RCHK((LONGINT)(i),(LONGINT)(ub)) +#define __RETCHK __retchk: __HALT(-3); return 0; +#define __CASECHK __HALT(-4) +#define __WITHCHK __HALT(-7) + +#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p))) +#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r)))) +#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p))) +#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p) +#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p) + + + +// Module entry/registration/exit + +extern void Heap_REGCMD(); +extern SYSTEM_PTR Heap_REGMOD(); +extern void Heap_REGTYP(); +extern void Heap_INCREF(); + +#define __DEFMOD static void *m; if (m!=0) {return m;} +#define __REGCMD(name, cmd) Heap_REGCMD(m, (CHAR*)name, cmd) +#define __REGMOD(name, enum) if (m==0) {m = Heap_REGMOD((CHAR*)name,enum);} +#define __ENDMOD return m +#define __MODULE_IMPORT(name) Heap_INCREF(name##__init()) + + + +// Main module initialisation, registration and finalisation + +extern void Platform_Init(INTEGER argc, LONGINT argv); +extern void *Platform_MainModule; +extern void Heap_FINALL(); + +#define __INIT(argc, argv) static void *m; Platform_Init((INTEGER)argc, (LONGINT)(uintptr_t)&argv); +#define __REGMAIN(name, enum) m = Heap_REGMOD((CHAR*)name,enum) +#define __FINI Heap_FINALL(); return 0 + + +// Assertions and Halts + +extern void Platform_Halt(LONGINT x); +extern void Platform_AssertFail(LONGINT x); + +#define __HALT(x) Platform_Halt(x) +#define __ASSERT(cond, x) if (!(cond)) Platform_AssertFail((LONGINT)(x)) + + +// Memory allocation + +extern SYSTEM_PTR Heap_NEWBLK (LONGINT size); +extern SYSTEM_PTR Heap_NEWREC (LONGINT tag); +extern SYSTEM_PTR SYSTEM_NEWARR(LONGINT*, LONGINT, int, int, int, ...); + +#define __SYSNEW(p, len) p = Heap_NEWBLK((LONGINT)(len)) +#define __NEW(p, t) p = Heap_NEWREC((LONGINT)(uintptr_t)t##__typ) +#define __NEWARR SYSTEM_NEWARR + + + +/* Type handling */ + +#define __TDESC(t, m, n) \ + static struct t##__desc { \ + LONGINT tproc[m]; /* Proc for each ptr field */ \ + LONGINT tag; \ + LONGINT next; /* Module table type list points here */ \ + LONGINT level; \ + LONGINT module; \ + char name[24]; \ + LONGINT basep[__MAXEXT]; /* List of bases this extends */ \ + LONGINT reserved; \ + LONGINT blksz; /* xxx_typ points here */ \ + LONGINT ptr[n+1]; /* Offsets of ptrs up to -ve sentinel */ \ + } t##__desc + +#define __BASEOFF (__MAXEXT+1) // blksz as index to base. +#define __TPROC0OFF (__BASEOFF+24/sizeof(LONGINT)+5) // blksz as index to tproc IFF m=1. +#define __EOM 1 +#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size +#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (LONGINT)(n), P) +#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (LONGINT)(size), (LONGINT)(n), P) + +#define __INITYP(t, t0, level) \ + t##__typ = (LONGINT*)&t##__desc.blksz; \ + memcpy(t##__desc.basep, t0##__typ - __BASEOFF, level*sizeof(LONGINT)); \ + t##__desc.basep[level] = (LONGINT)(uintptr_t)t##__typ; \ + t##__desc.module = (LONGINT)(uintptr_t)m; \ + if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \ + t##__desc.blksz = (t##__desc.blksz+5*sizeof(LONGINT)-1)/(4*sizeof(LONGINT))*(4*sizeof(LONGINT)); \ + Heap_REGTYP(m, (LONGINT)(uintptr_t)&t##__desc.next); \ + SYSTEM_INHERIT(t##__typ, t0##__typ) + +#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(LONGINT)(uintptr_t)typ##__typ) +#define __TYPEOF(p) ((LONGINT*)(uintptr_t)(*(((LONGINT*)(p))-1))) +#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level) + +// Oberon-2 type bound procedures support +#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(LONGINT)(uintptr_t)proc +#define __SEND(typ, num, funtyp, parlist) ((funtyp)((uintptr_t)*(typ-(__TPROC0OFF+num))))parlist + + + + +#endif diff --git a/bootstrap/windows-88/Strings.c b/bootstrap/windows-88/Strings.c new file mode 100644 index 00000000..98eef9eb --- /dev/null +++ b/bootstrap/windows-88/Strings.c @@ -0,0 +1,244 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" + + + + +export void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len); +export void Strings_Cap (CHAR *s, LONGINT s__len); +export void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n); +export void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len); +export void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len); +export INTEGER Strings_Length (CHAR *s, LONGINT s__len); +export BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len); +export INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos); +export void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len); + + +INTEGER Strings_Length (CHAR *s, LONGINT s__len) +{ + INTEGER _o_result; + INTEGER i; + __DUP(s, s__len, CHAR); + i = 0; + while (((LONGINT)i < s__len && s[__X(i, s__len)] != 0x00)) { + i += 1; + } + _o_result = i; + __DEL(s); + return _o_result; +} + +void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len) +{ + INTEGER n1, n2, i; + __DUP(extra, extra__len, CHAR); + n1 = Strings_Length(dest, dest__len); + n2 = Strings_Length(extra, extra__len); + i = 0; + while ((i < n2 && (LONGINT)(i + n1) < dest__len)) { + dest[__X(i + n1, dest__len)] = extra[__X(i, extra__len)]; + i += 1; + } + if ((LONGINT)(i + n1) < dest__len) { + dest[__X(i + n1, dest__len)] = 0x00; + } + __DEL(extra); +} + +void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len) +{ + INTEGER n1, n2, i; + __DUP(source, source__len, CHAR); + n1 = Strings_Length(dest, dest__len); + n2 = Strings_Length(source, source__len); + if (pos < 0) { + pos = 0; + } + if (pos > n1) { + Strings_Append(dest, dest__len, (void*)source, source__len); + return; + } + if ((LONGINT)(pos + n2) < dest__len) { + i = n1; + while (i >= pos) { + if ((LONGINT)(i + n2) < dest__len) { + dest[__X(i + n2, dest__len)] = dest[__X(i, dest__len)]; + } + i -= 1; + } + } + i = 0; + while (i < n2) { + dest[__X(pos + i, dest__len)] = source[__X(i, source__len)]; + i += 1; + } + __DEL(source); +} + +void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n) +{ + INTEGER len, i; + len = Strings_Length(s, s__len); + if (pos < 0) { + pos = 0; + } else if (pos >= len) { + return; + } + if (pos + n < len) { + i = pos + n; + while (i < len) { + s[__X(i - n, s__len)] = s[__X(i, s__len)]; + i += 1; + } + if ((LONGINT)(i - n) < s__len) { + s[__X(i - n, s__len)] = 0x00; + } + } else { + s[__X(pos, s__len)] = 0x00; + } +} + +void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len) +{ + __DUP(source, source__len, CHAR); + Strings_Delete((void*)dest, dest__len, pos, pos + Strings_Length(source, source__len)); + Strings_Insert(source, source__len, pos, (void*)dest, dest__len); + __DEL(source); +} + +void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len) +{ + INTEGER len, destLen, i; + __DUP(source, source__len, CHAR); + len = Strings_Length(source, source__len); + destLen = (int)dest__len - 1; + if (pos < 0) { + pos = 0; + } + if (pos >= len) { + dest[0] = 0x00; + return; + } + i = 0; + while (((((LONGINT)(pos + i) <= source__len && source[__X(pos + i, source__len)] != 0x00)) && i < n)) { + if (i < destLen) { + dest[__X(i, dest__len)] = source[__X(pos + i, source__len)]; + } + i += 1; + } + dest[__X(i, dest__len)] = 0x00; + __DEL(source); +} + +INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos) +{ + INTEGER _o_result; + INTEGER n1, n2, i, j; + __DUP(pattern, pattern__len, CHAR); + __DUP(s, s__len, CHAR); + n1 = Strings_Length(s, s__len); + n2 = Strings_Length(pattern, pattern__len); + if (n2 == 0) { + _o_result = 0; + __DEL(pattern); + __DEL(s); + return _o_result; + } + i = pos; + while (i <= n1 - n2) { + if (s[__X(i, s__len)] == pattern[0]) { + j = 1; + while ((j < n2 && s[__X(i + j, s__len)] == pattern[__X(j, pattern__len)])) { + j += 1; + } + if (j == n2) { + _o_result = i; + __DEL(pattern); + __DEL(s); + return _o_result; + } + } + i += 1; + } + _o_result = -1; + __DEL(pattern); + __DEL(s); + return _o_result; +} + +void Strings_Cap (CHAR *s, LONGINT s__len) +{ + INTEGER i; + i = 0; + while (s[__X(i, s__len)] != 0x00) { + if (('a' <= s[__X(i, s__len)] && s[__X(i, s__len)] <= 'z')) { + s[__X(i, s__len)] = __CAP(s[__X(i, s__len)]); + } + i += 1; + } +} + +static struct Match__7 { + struct Match__7 *lnk; +} *Match__7_s; + +static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INTEGER n, INTEGER m); + +static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INTEGER n, INTEGER m) +{ + BOOLEAN _o_result; + while ((((n >= 0 && m >= 0)) && mask[__X(m, mask__len)] != '*')) { + if (name[__X(n, name__len)] != mask[__X(m, mask__len)]) { + _o_result = 0; + return _o_result; + } + n -= 1; + m -= 1; + } + if (m < 0) { + _o_result = n < 0; + return _o_result; + } + while ((m >= 0 && mask[__X(m, mask__len)] == '*')) { + m -= 1; + } + if (m < 0) { + _o_result = 1; + return _o_result; + } + while (n >= 0) { + if (M__8(name, name__len, mask, mask__len, n, m)) { + _o_result = 1; + return _o_result; + } + n -= 1; + } + _o_result = 0; + return _o_result; +} + +BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len) +{ + BOOLEAN _o_result; + struct Match__7 _s; + __DUP(string, string__len, CHAR); + __DUP(pattern, pattern__len, CHAR); + _s.lnk = Match__7_s; + Match__7_s = &_s; + _o_result = M__8((void*)string, string__len, (void*)pattern, pattern__len, Strings_Length(string, string__len) - 1, Strings_Length(pattern, pattern__len) - 1); + Match__7_s = _s.lnk; + __DEL(string); + __DEL(pattern); + return _o_result; +} + + +export void *Strings__init(void) +{ + __DEFMOD; + __REGMOD("Strings", 0); +/* BEGIN */ + __ENDMOD; +} diff --git a/bootstrap/windows-88/Strings.h b/bootstrap/windows-88/Strings.h new file mode 100644 index 00000000..05e86973 --- /dev/null +++ b/bootstrap/windows-88/Strings.h @@ -0,0 +1,24 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Strings__h +#define Strings__h + +#define LARGE +#include "SYSTEM.h" + + + + +import void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len); +import void Strings_Cap (CHAR *s, LONGINT s__len); +import void Strings_Delete (CHAR *s, LONGINT s__len, INTEGER pos, INTEGER n); +import void Strings_Extract (CHAR *source, LONGINT source__len, INTEGER pos, INTEGER n, CHAR *dest, LONGINT dest__len); +import void Strings_Insert (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len); +import INTEGER Strings_Length (CHAR *s, LONGINT s__len); +import BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len); +import INTEGER Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INTEGER pos); +import void Strings_Replace (CHAR *source, LONGINT source__len, INTEGER pos, CHAR *dest, LONGINT dest__len); +import void *Strings__init(void); + + +#endif diff --git a/bootstrap/windows-88/Texts.c b/bootstrap/windows-88/Texts.c new file mode 100644 index 00000000..307bec01 --- /dev/null +++ b/bootstrap/windows-88/Texts.c @@ -0,0 +1,1839 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "Files.h" +#include "Modules.h" +#include "Reals.h" + +typedef + struct Texts_RunDesc *Texts_Run; + +typedef + struct Texts_FontDesc *Texts_FontsFont; + +typedef + struct Texts_RunDesc { + Texts_Run prev, next; + LONGINT len; + Texts_FontsFont fnt; + SHORTINT col, voff; + BOOLEAN ascii; + } Texts_RunDesc; + +typedef + struct Texts_ElemDesc *Texts_Elem; + +typedef + struct Texts_ElemMsg { + char _prvt0[1]; + } Texts_ElemMsg; + +typedef + void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, LONGINT *); + +typedef + struct Texts_TextDesc *Texts_Text; + +typedef + struct Texts_ElemDesc { + Texts_Run prev, next; + LONGINT len; + Texts_FontsFont fnt; + SHORTINT col, voff; + BOOLEAN ascii; + LONGINT W, H; + Texts_Handler handle; + Texts_Text base; + } Texts_ElemDesc; + +struct Texts__1 { /* Texts_ElemDesc */ + Texts_Run prev, next; + LONGINT len; + Texts_FontsFont fnt; + SHORTINT col, voff; + BOOLEAN ascii; + LONGINT W, H; + Texts_Handler handle; + Texts_Text base; + Files_File file; + LONGINT org, span; + CHAR mod[32], proc[32]; +}; + +typedef + struct Texts__1 *Texts_Alien; + +typedef + struct Texts_BufDesc { + LONGINT len; + Texts_Run head; + } Texts_BufDesc; + +typedef + Texts_BufDesc *Texts_Buffer; + +typedef + struct Texts_CopyMsg { /* Texts_ElemMsg */ + Texts_Elem e; + } Texts_CopyMsg; + +typedef + struct Texts_FileMsg { /* Texts_ElemMsg */ + INTEGER id; + LONGINT pos; + Files_Rider r; + } Texts_FileMsg; + +typedef + struct Texts_FontDesc { + CHAR name[32]; + } Texts_FontDesc; + +typedef + struct Texts_IdentifyMsg { /* Texts_ElemMsg */ + CHAR mod[32], proc[32]; + } Texts_IdentifyMsg; + +typedef + void (*Texts_Notifier)(Texts_Text, INTEGER, LONGINT, LONGINT); + +typedef + struct Texts_PieceDesc *Texts_Piece; + +typedef + struct Texts_PieceDesc { + Texts_Run prev, next; + LONGINT len; + Texts_FontsFont fnt; + SHORTINT col, voff; + BOOLEAN ascii; + Files_File file; + LONGINT org; + } Texts_PieceDesc; + +typedef + struct Texts_Reader { + BOOLEAN eot; + Texts_FontsFont fnt; + SHORTINT col, voff; + Texts_Elem elem; + Files_Rider rider; + Texts_Run run; + LONGINT org, off; + } Texts_Reader; + +typedef + struct Texts_Scanner { /* Texts_Reader */ + BOOLEAN eot; + Texts_FontsFont fnt; + SHORTINT col, voff; + Texts_Elem elem; + Files_Rider rider; + Texts_Run run; + LONGINT org, off; + CHAR nextCh; + INTEGER line, class; + LONGINT i; + REAL x; + LONGREAL y; + CHAR c; + SHORTINT len; + CHAR s[64]; + } Texts_Scanner; + +typedef + struct Texts_TextDesc { + LONGINT len; + Texts_Notifier notify; + Texts_Run head, cache; + LONGINT corg; + } Texts_TextDesc; + +typedef + struct Texts_Writer { + Texts_Buffer buf; + Texts_FontsFont fnt; + SHORTINT col, voff; + Files_Rider rider; + Files_File file; + } Texts_Writer; + + +export Texts_Elem Texts_new; +static Texts_Buffer Texts_del; +static Texts_FontsFont Texts_FontsDefault; + +export LONGINT *Texts_FontDesc__typ; +export LONGINT *Texts_RunDesc__typ; +export LONGINT *Texts_PieceDesc__typ; +export LONGINT *Texts_ElemMsg__typ; +export LONGINT *Texts_ElemDesc__typ; +export LONGINT *Texts_FileMsg__typ; +export LONGINT *Texts_CopyMsg__typ; +export LONGINT *Texts_IdentifyMsg__typ; +export LONGINT *Texts_BufDesc__typ; +export LONGINT *Texts_TextDesc__typ; +export LONGINT *Texts_Reader__typ; +export LONGINT *Texts_Scanner__typ; +export LONGINT *Texts_Writer__typ; +export LONGINT *Texts__1__typ; + +export void Texts_Append (Texts_Text T, Texts_Buffer B); +export void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff); +static Texts_Elem Texts_CloneElem (Texts_Elem e); +static Texts_Piece Texts_ClonePiece (Texts_Piece p); +export void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len); +export void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB); +export void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE); +export void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end); +export Texts_Text Texts_ElemBase (Texts_Elem E); +export LONGINT Texts_ElemPos (Texts_Elem E); +static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org, LONGINT *off); +static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len); +static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__typ); +export void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B); +export void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v); +export void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len); +export void Texts_OpenBuf (Texts_Buffer B); +export void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos); +export void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos); +export void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ); +export LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ); +export void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch); +export void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ); +export void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ); +export void Texts_Recall (Texts_Buffer *B); +export void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B); +export void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ); +export void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col); +export void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt); +export void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff); +static void Texts_Splice (Texts_Run un, Texts_Run v, Texts_Run w, Texts_Text base); +static void Texts_Split (LONGINT off, Texts_Run *u, Texts_Run *un); +export void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +export void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch); +export void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d); +export void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e); +export void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x); +export void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n); +export void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ); +export void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n); +export void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x); +export void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n); +export void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k); +export void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x); +export void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len); + + +static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len) +{ + Texts_FontsFont _o_result; + Texts_FontsFont F = NIL; + __NEW(F, Texts_FontDesc); + __COPY(name, F->name, ((LONGINT)(32))); + _o_result = F; + return _o_result; +} + +static void Texts_Find (Texts_Text T, LONGINT *pos, Texts_Run *u, LONGINT *org, LONGINT *off) +{ + Texts_Run v = NIL; + LONGINT m; + if (*pos >= T->len) { + *pos = T->len; + *u = T->head; + *org = T->len; + *off = 0; + T->cache = T->head; + T->corg = 0; + } else { + v = T->cache->next; + m = *pos - T->corg; + if (*pos >= T->corg) { + while (m >= v->len) { + m -= v->len; + v = v->next; + } + } else { + while (m < 0) { + v = v->prev; + m += v->len; + } + } + *u = v; + *org = *pos - m; + *off = m; + T->cache = v->prev; + T->corg = *org; + } +} + +static void Texts_Split (LONGINT off, Texts_Run *u, Texts_Run *un) +{ + Texts_Piece p = NIL, U = NIL; + if (off == 0) { + *un = *u; + *u = (*un)->prev; + } else if (off >= (*u)->len) { + *un = (*u)->next; + } else { + __NEW(p, Texts_PieceDesc); + *un = (Texts_Run)p; + U = __GUARDP(*u, Texts_PieceDesc, 1); + __GUARDEQP(p, Texts_PieceDesc) = *U; + p->org += off; + p->len -= off; + U->len -= p->len; + p->ascii = (*u)->ascii; + p->prev = (Texts_Run)U; + p->next = U->next; + p->next->prev = (Texts_Run)p; + U->next = (Texts_Run)p; + } +} + +static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v) +{ + Texts_Piece p = NIL, q = NIL; + if ((((((((((__ISP(u, Texts_PieceDesc, 1) && __ISP(*v, Texts_PieceDesc, 1))) && __STRCMP(u->fnt->name, (*v)->fnt->name) == 0)) && u->col == (*v)->col)) && u->voff == (*v)->voff)) && __GUARDP(u, Texts_PieceDesc, 1)->ascii == __GUARDP(*v, Texts_PieceDesc, 1)->ascii)) { + p = __GUARDP(u, Texts_PieceDesc, 1); + q = __GUARDP(*v, Texts_PieceDesc, 1); + if ((p->file == q->file && p->org + p->len == q->org)) { + if (T->cache == u) { + T->corg += q->len; + } else if (T->cache == *v) { + T->cache = T->head; + T->corg = 0; + } + p->len += q->len; + *v = (*v)->next; + } + } +} + +static void Texts_Splice (Texts_Run un, Texts_Run v, Texts_Run w, Texts_Text base) +{ + Texts_Run u = NIL; + if (v != w->next) { + u = un->prev; + u->next = v; + v->prev = u; + un->prev = w; + w->next = un; + do { + if (__ISP(v, Texts_ElemDesc, 1)) { + __GUARDP(v, Texts_ElemDesc, 1)->base = base; + } + v = v->next; + } while (!(v == un)); + } +} + +static Texts_Piece Texts_ClonePiece (Texts_Piece p) +{ + Texts_Piece _o_result; + Texts_Piece q = NIL; + __NEW(q, Texts_PieceDesc); + __GUARDEQP(q, Texts_PieceDesc) = *p; + _o_result = q; + return _o_result; +} + +static Texts_Elem Texts_CloneElem (Texts_Elem e) +{ + Texts_Elem _o_result; + Texts_CopyMsg msg; + msg.e = NIL; + (*e->handle)(e, (void*)&msg, Texts_CopyMsg__typ); + _o_result = msg.e; + return _o_result; +} + +void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE) +{ + DE->len = SE->len; + DE->fnt = SE->fnt; + DE->col = SE->col; + DE->voff = SE->voff; + DE->W = SE->W; + DE->H = SE->H; + DE->handle = SE->handle; +} + +Texts_Text Texts_ElemBase (Texts_Elem E) +{ + Texts_Text _o_result; + _o_result = E->base; + return _o_result; +} + +LONGINT Texts_ElemPos (Texts_Elem E) +{ + LONGINT _o_result; + Texts_Run u = NIL; + LONGINT pos; + u = E->base->head->next; + pos = 0; + while (u != (void *) E) { + pos = pos + u->len; + u = u->next; + } + _o_result = pos; + return _o_result; +} + +static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, LONGINT *msg__typ) +{ + Texts_Alien e = NIL; + Files_Rider r; + LONGINT i; + CHAR ch; + if (__ISP(E, Texts__1, 2)) { + if (__IS(msg__typ, Texts_CopyMsg, 1)) { + if (__IS(msg__typ, Texts_CopyMsg, 1)) { + Texts_CopyMsg *msg__ = (void*)msg; + __NEW(e, Texts__1); + Texts_CopyElem((void*)((Texts_Alien)E), (void*)e); + e->file = ((Texts_Alien)E)->file; + e->org = ((Texts_Alien)E)->org; + e->span = ((Texts_Alien)E)->span; + __COPY(((Texts_Alien)E)->mod, e->mod, ((LONGINT)(32))); + __COPY(((Texts_Alien)E)->proc, e->proc, ((LONGINT)(32))); + (*msg__).e = (Texts_Elem)e; + } else __WITHCHK; + } else if (__IS(msg__typ, Texts_IdentifyMsg, 1)) { + if (__IS(msg__typ, Texts_IdentifyMsg, 1)) { + Texts_IdentifyMsg *msg__ = (void*)msg; + __COPY(((Texts_Alien)E)->mod, (*msg__).mod, ((LONGINT)(32))); + __COPY(((Texts_Alien)E)->proc, (*msg__).proc, ((LONGINT)(32))); + (*msg__).mod[31] = 0x01; + } else __WITHCHK; + } else if (__IS(msg__typ, Texts_FileMsg, 1)) { + if (__IS(msg__typ, Texts_FileMsg, 1)) { + Texts_FileMsg *msg__ = (void*)msg; + if ((*msg__).id == 1) { + Files_Set(&r, Files_Rider__typ, ((Texts_Alien)E)->file, ((Texts_Alien)E)->org); + i = ((Texts_Alien)E)->span; + while (i > 0) { + Files_Read(&r, Files_Rider__typ, (void*)&ch); + Files_Write(&(*msg__).r, Files_Rider__typ, ch); + i -= 1; + } + } + } else __WITHCHK; + } + } else __WITHCHK; +} + +void Texts_OpenBuf (Texts_Buffer B) +{ + Texts_Run u = NIL; + __NEW(u, Texts_RunDesc); + u->next = u; + u->prev = u; + B->head = u; + B->len = 0; +} + +void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB) +{ + Texts_Run u = NIL, v = NIL, vn = NIL; + u = SB->head->next; + v = DB->head->prev; + while (u != SB->head) { + if (__ISP(u, Texts_PieceDesc, 1)) { + vn = (Texts_Run)Texts_ClonePiece(__GUARDP(u, Texts_PieceDesc, 1)); + } else { + vn = (Texts_Run)Texts_CloneElem(__GUARDP(u, Texts_ElemDesc, 1)); + } + v->next = vn; + vn->prev = v; + v = vn; + u = u->next; + } + v->next = DB->head; + DB->head->prev = v; + DB->len += SB->len; +} + +void Texts_Recall (Texts_Buffer *B) +{ + *B = Texts_del; + Texts_del = NIL; +} + +void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B) +{ + Texts_Run u = NIL, v = NIL, w = NIL, wn = NIL; + LONGINT uo, ud, vo, vd; + Texts_Find(T, &beg, &u, &uo, &ud); + Texts_Find(T, &end, &v, &vo, &vd); + w = B->head->prev; + while (u != v) { + if (__ISP(u, Texts_PieceDesc, 1)) { + wn = (Texts_Run)Texts_ClonePiece(__GUARDP(u, Texts_PieceDesc, 1)); + wn->len -= ud; + __GUARDP(wn, Texts_PieceDesc, 1)->org += ud; + } else { + wn = (Texts_Run)Texts_CloneElem(__GUARDP(u, Texts_ElemDesc, 1)); + } + w->next = wn; + wn->prev = w; + w = wn; + u = u->next; + ud = 0; + } + if (vd > 0) { + wn = (Texts_Run)Texts_ClonePiece(__GUARDP(v, Texts_PieceDesc, 1)); + wn->len = vd - ud; + __GUARDP(wn, Texts_PieceDesc, 1)->org += ud; + w->next = wn; + wn->prev = w; + w = wn; + } + w->next = B->head; + B->head->prev = w; + B->len += end - beg; +} + +void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B) +{ + Texts_Run u = NIL, un = NIL, v = NIL; + Texts_Piece p = NIL, q = NIL; + LONGINT uo, ud, len; + Texts_Find(T, &pos, &u, &uo, &ud); + Texts_Split(ud, &u, &un); + len = B->len; + v = B->head->next; + Texts_Merge(T, u, &v); + Texts_Splice(un, v, B->head->prev, T); + T->len += len; + B->head->next = B->head; + B->head->prev = B->head; + B->len = 0; + if (T->notify != NIL) { + (*T->notify)(T, 1, pos, pos + len); + } +} + +void Texts_Append (Texts_Text T, Texts_Buffer B) +{ + Texts_Run v = NIL; + LONGINT pos, len; + pos = T->len; + len = B->len; + v = B->head->next; + Texts_Merge(T, T->head->prev, &v); + Texts_Splice(T->head, v, B->head->prev, T); + T->len += len; + B->head->next = B->head; + B->head->prev = B->head; + B->len = 0; + if (T->notify != NIL) { + (*T->notify)(T, 1, pos, pos + len); + } +} + +void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end) +{ + Texts_Run c = NIL, u = NIL, un = NIL, v = NIL, vn = NIL; + LONGINT co, uo, ud, vo, vd; + Texts_Find(T, &beg, &u, &uo, &ud); + Texts_Split(ud, &u, &un); + c = T->cache; + co = T->corg; + Texts_Find(T, &end, &v, &vo, &vd); + Texts_Split(vd, &v, &vn); + T->cache = c; + T->corg = co; + __NEW(Texts_del, Texts_BufDesc); + Texts_OpenBuf(Texts_del); + Texts_del->len = end - beg; + Texts_Splice(Texts_del->head, un, v, NIL); + Texts_Merge(T, u, &vn); + u->next = vn; + vn->prev = u; + T->len -= end - beg; + if (T->notify != NIL) { + (*T->notify)(T, 2, beg, end); + } +} + +void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff) +{ + Texts_Run c = NIL, u = NIL, un = NIL, v = NIL, vn = NIL; + LONGINT co, uo, ud, vo, vd; + Texts_Find(T, &beg, &u, &uo, &ud); + Texts_Split(ud, &u, &un); + c = T->cache; + co = T->corg; + Texts_Find(T, &end, &v, &vo, &vd); + Texts_Split(vd, &v, &vn); + T->cache = c; + T->corg = co; + while (un != vn) { + if ((__IN(0, sel) && fnt != NIL)) { + un->fnt = fnt; + } + if (__IN(1, sel)) { + un->col = col; + } + if (__IN(2, sel)) { + un->voff = voff; + } + Texts_Merge(T, u, &un); + if (u->next == un) { + u = un; + un = un->next; + } else { + u->next = un; + un->prev = u; + } + } + Texts_Merge(T, u, &un); + u->next = un; + un->prev = u; + if (T->notify != NIL) { + (*T->notify)(T, 0, beg, end); + } +} + +void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos) +{ + Texts_Run u = NIL; + if (pos >= T->len) { + pos = T->len; + } + Texts_Find(T, &pos, &u, &(*R).org, &(*R).off); + (*R).run = u; + (*R).eot = 0; + if (__ISP(u, Texts_PieceDesc, 1)) { + Files_Set(&(*R).rider, Files_Rider__typ, __GUARDP(u, Texts_PieceDesc, 1)->file, __GUARDP(u, Texts_PieceDesc, 1)->org + (*R).off); + } +} + +void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch) +{ + Texts_Run u = NIL; + LONGINT pos; + CHAR nextch; + u = (*R).run; + (*R).fnt = u->fnt; + (*R).col = u->col; + (*R).voff = u->voff; + (*R).off += 1; + if (__ISP(u, Texts_PieceDesc, 1)) { + Files_Read(&(*R).rider, Files_Rider__typ, (void*)&*ch); + (*R).elem = NIL; + if ((*ch == 0x0a && __GUARDP(u, Texts_PieceDesc, 1)->ascii)) { + *ch = 0x0d; + } else if ((*ch == 0x0d && __GUARDP(u, Texts_PieceDesc, 1)->ascii)) { + pos = Files_Pos(&(*R).rider, Files_Rider__typ); + Files_Read(&(*R).rider, Files_Rider__typ, (void*)&nextch); + if (nextch == 0x0a) { + (*R).off += 1; + } else { + Files_Set(&(*R).rider, Files_Rider__typ, __GUARDP(u, Texts_PieceDesc, 1)->file, pos); + } + } + } else if (__ISP(u, Texts_ElemDesc, 1)) { + *ch = 0x1c; + (*R).elem = __GUARDP(u, Texts_ElemDesc, 1); + } else { + *ch = 0x00; + (*R).elem = NIL; + (*R).eot = 1; + } + if ((*R).off == u->len) { + (*R).org += u->len; + u = u->next; + if (__ISP(u, Texts_PieceDesc, 1)) { + if (__ISP(u, Texts_PieceDesc, 1)) { + Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org); + } else __WITHCHK; + } + (*R).run = u; + (*R).off = 0; + } +} + +void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ) +{ + Texts_Run u = NIL, un = NIL; + u = (*R).run; + while (__ISP(u, Texts_PieceDesc, 1)) { + (*R).org += u->len; + u = u->next; + } + if (__ISP(u, Texts_ElemDesc, 1)) { + un = u->next; + (*R).run = un; + (*R).org += 1; + (*R).off = 0; + (*R).fnt = u->fnt; + (*R).col = u->col; + (*R).voff = u->voff; + (*R).elem = __GUARDP(u, Texts_ElemDesc, 1); + if (__ISP(un, Texts_PieceDesc, 1)) { + if (__ISP(un, Texts_PieceDesc, 1)) { + Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)un)->file, ((Texts_Piece)un)->org); + } else __WITHCHK; + } + } else { + (*R).eot = 1; + (*R).elem = NIL; + } +} + +void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ) +{ + Texts_Run u = NIL; + u = (*R).run->prev; + while (__ISP(u, Texts_PieceDesc, 1)) { + (*R).org -= u->len; + u = u->prev; + } + if (__ISP(u, Texts_ElemDesc, 1)) { + (*R).run = u; + (*R).org -= 1; + (*R).off = 0; + (*R).fnt = u->fnt; + (*R).col = u->col; + (*R).voff = u->voff; + (*R).elem = __GUARDP(u, Texts_ElemDesc, 1); + } else { + (*R).eot = 1; + (*R).elem = NIL; + } +} + +LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ) +{ + LONGINT _o_result; + _o_result = (*R).org + (*R).off; + return _o_result; +} + +void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos) +{ + Texts_OpenReader((void*)&*S, S__typ, T, pos); + (*S).line = 0; + (*S).nextCh = ' '; +} + +static struct Scan__31 { + Texts_Scanner *S; + LONGINT *S__typ; + CHAR *ch; + BOOLEAN *negE; + INTEGER *e; + struct Scan__31 *lnk; +} *Scan__31_s; + +static void ReadScaleFactor__32 (void); + +static void ReadScaleFactor__32 (void) +{ + Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch); + if (*Scan__31_s->ch == '-') { + *Scan__31_s->negE = 1; + Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch); + } else { + *Scan__31_s->negE = 0; + if (*Scan__31_s->ch == '+') { + Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch); + } + } + while (('0' <= *Scan__31_s->ch && *Scan__31_s->ch <= '9')) { + *Scan__31_s->e = (*Scan__31_s->e * 10 + (int)*Scan__31_s->ch) - 48; + Texts_Read((void*)&*Scan__31_s->S, Scan__31_s->S__typ, &*Scan__31_s->ch); + } +} + +void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ) +{ + CHAR ch, term; + BOOLEAN neg, negE, hex; + SHORTINT i, j, h; + INTEGER e; + LONGINT k; + REAL x, f; + LONGREAL y, g; + CHAR d[32]; + struct Scan__31 _s; + _s.S = S; _s.S__typ = S__typ; + _s.ch = &ch; + _s.negE = &negE; + _s.e = &e; + _s.lnk = Scan__31_s; + Scan__31_s = &_s; + ch = (*S).nextCh; + i = 0; + for (;;) { + if (ch == 0x0d) { + (*S).line += 1; + } else if ((ch != ' ' && ch != 0x09)) { + break; + } + Texts_Read((void*)&*S, S__typ, &ch); + } + if ((('A' <= __CAP(ch) && __CAP(ch) <= 'Z') || ch == '/') || ch == '.') { + do { + (*S).s[__X(i, ((LONGINT)(64)))] = ch; + i += 1; + Texts_Read((void*)&*S, S__typ, &ch); + } while (!((((__CAP(ch) > 'Z' && ch != '_') || ('A' > __CAP(ch) && ch > '9')) || ((('0' > ch && ch != '.')) && ch != '/')) || i == 63)); + (*S).s[__X(i, ((LONGINT)(64)))] = 0x00; + (*S).len = i; + (*S).class = 1; + } else if (ch == '\"') { + Texts_Read((void*)&*S, S__typ, &ch); + while ((((ch != '\"' && ch >= ' ')) && i != 63)) { + (*S).s[__X(i, ((LONGINT)(64)))] = ch; + i += 1; + Texts_Read((void*)&*S, S__typ, &ch); + } + (*S).s[__X(i, ((LONGINT)(64)))] = 0x00; + (*S).len = i + 1; + Texts_Read((void*)&*S, S__typ, &ch); + (*S).class = 2; + } else { + if (ch == '-') { + neg = 1; + Texts_Read((void*)&*S, S__typ, &ch); + } else { + neg = 0; + } + if (('0' <= ch && ch <= '9')) { + hex = 0; + j = 0; + for (;;) { + d[__X(i, ((LONGINT)(32)))] = ch; + i += 1; + Texts_Read((void*)&*S, S__typ, &ch); + if (ch < '0') { + break; + } + if ('9' < ch) { + if (('A' <= ch && ch <= 'F')) { + hex = 1; + ch = (CHAR)((int)ch - 7); + } else if (('a' <= ch && ch <= 'f')) { + hex = 1; + ch = (CHAR)((int)ch - 39); + } else { + break; + } + } + } + if (ch == 'H') { + Texts_Read((void*)&*S, S__typ, &ch); + (*S).class = 3; + if (i - j > 8) { + j = i - 8; + } + k = (int)d[__X(j, ((LONGINT)(32)))] - 48; + j += 1; + if ((i - j == 7 && k >= 8)) { + k -= 16; + } + while (j < i) { + k = __ASHL(k, 4) + (LONGINT)((int)d[__X(j, ((LONGINT)(32)))] - 48); + j += 1; + } + if (neg) { + (*S).i = -k; + } else { + (*S).i = k; + } + } else if (ch == '.') { + Texts_Read((void*)&*S, S__typ, &ch); + h = i; + while (('0' <= ch && ch <= '9')) { + d[__X(i, ((LONGINT)(32)))] = ch; + i += 1; + Texts_Read((void*)&*S, S__typ, &ch); + } + if (ch == 'D') { + e = 0; + y = (LONGREAL)0; + g = (LONGREAL)1; + do { + y = y * (LONGREAL)10 + ((int)d[__X(j, ((LONGINT)(32)))] - 48); + j += 1; + } while (!(j == h)); + while (j < i) { + g = g / (LONGREAL)(LONGREAL)10; + y = ((int)d[__X(j, ((LONGINT)(32)))] - 48) * g + y; + j += 1; + } + ReadScaleFactor__32(); + if (negE) { + if (e <= 308) { + y = y / (LONGREAL)Reals_TenL(e); + } else { + y = (LONGREAL)0; + } + } else if (e > 0) { + if (e <= 308) { + y = Reals_TenL(e) * y; + } else { + __HALT(40); + } + } + if (neg) { + y = -y; + } + (*S).class = 5; + (*S).y = y; + } else { + e = 0; + x = (REAL)0; + f = (REAL)1; + do { + x = x * (REAL)10 + ((int)d[__X(j, ((LONGINT)(32)))] - 48); + j += 1; + } while (!(j == h)); + while (j < i) { + f = f / (REAL)(REAL)10; + x = ((int)d[__X(j, ((LONGINT)(32)))] - 48) * f + x; + j += 1; + } + if (ch == 'E') { + ReadScaleFactor__32(); + } + if (negE) { + if (e <= 38) { + x = x / (REAL)Reals_Ten(e); + } else { + x = (REAL)0; + } + } else if (e > 0) { + if (e <= 38) { + x = Reals_Ten(e) * x; + } else { + __HALT(40); + } + } + if (neg) { + x = -x; + } + (*S).class = 4; + (*S).x = x; + } + if (hex) { + (*S).class = 0; + } + } else { + (*S).class = 3; + k = 0; + do { + k = k * 10 + (LONGINT)((int)d[__X(j, ((LONGINT)(32)))] - 48); + j += 1; + } while (!(j == i)); + if (neg) { + (*S).i = -k; + } else { + (*S).i = k; + } + if (hex) { + (*S).class = 0; + } else { + (*S).class = 3; + } + } + } else { + (*S).class = 6; + if (neg) { + (*S).c = '-'; + } else { + (*S).c = ch; + Texts_Read((void*)&*S, S__typ, &ch); + } + } + } + (*S).nextCh = ch; + Scan__31_s = _s.lnk; +} + +void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ) +{ + __NEW((*W).buf, Texts_BufDesc); + Texts_OpenBuf((*W).buf); + (*W).fnt = Texts_FontsDefault; + (*W).col = 15; + (*W).voff = 0; + (*W).file = Files_New((CHAR*)"", (LONGINT)1); + Files_Set(&(*W).rider, Files_Rider__typ, (*W).file, ((LONGINT)(0))); +} + +void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt) +{ + (*W).fnt = fnt; +} + +void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col) +{ + (*W).col = col; +} + +void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff) +{ + (*W).voff = voff; +} + +void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch) +{ + Texts_Run u = NIL, un = NIL; + Texts_Piece p = NIL; + Files_Write(&(*W).rider, Files_Rider__typ, ch); + (*W).buf->len += 1; + un = (*W).buf->head; + u = un->prev; + if ((((((((((__ISP(u, Texts_PieceDesc, 1) && __GUARDP(u, Texts_PieceDesc, 1)->file == (*W).file)) && __STRCMP(u->fnt->name, (*W).fnt->name) == 0)) && u->col == (*W).col)) && u->voff == (*W).voff)) && !__GUARDP(u, Texts_PieceDesc, 1)->ascii)) { + u->len += 1; + } else { + __NEW(p, Texts_PieceDesc); + u->next = (Texts_Run)p; + p->prev = u; + p->next = un; + un->prev = (Texts_Run)p; + p->len = 1; + p->fnt = (*W).fnt; + p->col = (*W).col; + p->voff = (*W).voff; + p->file = (*W).file; + p->org = Files_Length((*W).file) - 1; + p->ascii = 0; + } +} + +void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e) +{ + Texts_Run u = NIL, un = NIL; + if (e->base != NIL) { + __HALT(99); + } + (*W).buf->len += 1; + e->len = 1; + e->fnt = (*W).fnt; + e->col = (*W).col; + e->voff = (*W).voff; + un = (*W).buf->head; + u = un->prev; + u->next = (Texts_Run)e; + e->prev = u; + e->next = un; + un->prev = (Texts_Run)e; +} + +void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ) +{ + Texts_Write(&*W, W__typ, 0x0d); +} + +void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len) +{ + INTEGER i; + __DUP(s, s__len, CHAR); + i = 0; + while (s[__X(i, s__len)] >= ' ') { + Texts_Write(&*W, W__typ, s[__X(i, s__len)]); + i += 1; + } + __DEL(s); +} + +void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n) +{ + INTEGER i; + LONGINT x0; + CHAR a[22]; + i = 0; + if (x < 0) { + if (x == (-9223372036854775807-1)) { + Texts_WriteString(&*W, W__typ, (CHAR*)" -9223372036854775808", (LONGINT)22); + return; + } else { + n -= 1; + x0 = -x; + } + } else { + x0 = x; + } + do { + a[__X(i, ((LONGINT)(22)))] = (CHAR)(__MOD(x0, 10) + 48); + x0 = __DIV(x0, 10); + i += 1; + } while (!(x0 == 0)); + while (n > (LONGINT)i) { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } + if (x < 0) { + Texts_Write(&*W, W__typ, '-'); + } + do { + i -= 1; + Texts_Write(&*W, W__typ, a[__X(i, ((LONGINT)(22)))]); + } while (!(i == 0)); +} + +void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x) +{ + INTEGER i; + LONGINT y; + CHAR a[20]; + i = 0; + Texts_Write(&*W, W__typ, ' '); + do { + y = __MASK(x, -16); + if (y < 10) { + a[__X(i, ((LONGINT)(20)))] = (CHAR)(y + 48); + } else { + a[__X(i, ((LONGINT)(20)))] = (CHAR)(y + 55); + } + x = __ASHR(x, 4); + i += 1; + } while (!(i == 8)); + do { + i -= 1; + Texts_Write(&*W, W__typ, a[__X(i, ((LONGINT)(20)))]); + } while (!(i == 0)); +} + +void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n) +{ + INTEGER e; + REAL x0; + CHAR d[9]; + e = Reals_Expo(x); + if (e == 0) { + Texts_WriteString(&*W, W__typ, (CHAR*)" 0", (LONGINT)4); + do { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } while (!(n <= 3)); + } else if (e == 255) { + Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5); + while (n > 4) { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } + } else { + if (n <= 9) { + n = 3; + } else { + n -= 6; + } + do { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } while (!(n <= 8)); + if (x < (REAL)0) { + Texts_Write(&*W, W__typ, '-'); + x = -x; + } else { + Texts_Write(&*W, W__typ, ' '); + } + e = __ASHR((e - 127) * 77, 8); + if (e >= 0) { + x = x / (REAL)Reals_Ten(e); + } else { + x = Reals_Ten(-e) * x; + } + if (x >= (REAL)10) { + x = 1.0000000e-001 * x; + e += 1; + } + x0 = Reals_Ten(n - 1); + x = x0 * x + 5.0000000e-001; + if (x >= (REAL)10 * x0) { + x = x * 1.0000000e-001; + e += 1; + } + Reals_Convert(x, n, (void*)d, ((LONGINT)(9))); + n -= 1; + Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(9)))]); + Texts_Write(&*W, W__typ, '.'); + do { + n -= 1; + Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(9)))]); + } while (!(n == 0)); + Texts_Write(&*W, W__typ, 'E'); + if (e < 0) { + Texts_Write(&*W, W__typ, '-'); + e = -e; + } else { + Texts_Write(&*W, W__typ, '+'); + } + Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48)); + Texts_Write(&*W, W__typ, (CHAR)((int)__MOD(e, 10) + 48)); + } +} + +static struct WriteRealFix__53 { + Texts_Writer *W; + LONGINT *W__typ; + INTEGER *i; + CHAR (*d)[9]; + struct WriteRealFix__53 *lnk; +} *WriteRealFix__53_s; + +static void dig__54 (INTEGER n); +static void seq__56 (CHAR ch, INTEGER n); + +static void seq__56 (CHAR ch, INTEGER n) +{ + while (n > 0) { + Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, ch); + n -= 1; + } +} + +static void dig__54 (INTEGER n) +{ + while (n > 0) { + *WriteRealFix__53_s->i -= 1; + Texts_Write(&*WriteRealFix__53_s->W, WriteRealFix__53_s->W__typ, (*WriteRealFix__53_s->d)[__X(*WriteRealFix__53_s->i, ((LONGINT)(9)))]); + n -= 1; + } +} + +void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k) +{ + INTEGER e, i; + CHAR sign; + REAL x0; + CHAR d[9]; + struct WriteRealFix__53 _s; + _s.W = W; _s.W__typ = W__typ; + _s.i = &i; + _s.d = (void*)d; + _s.lnk = WriteRealFix__53_s; + WriteRealFix__53_s = &_s; + e = Reals_Expo(x); + if (k < 0) { + k = 0; + } + if (e == 0) { + seq__56(' ', (n - k) - 2); + Texts_Write(&*W, W__typ, '0'); + seq__56(' ', k + 1); + } else if (e == 255) { + Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5); + seq__56(' ', n - 4); + } else { + e = __ASHR((e - 127) * 77, 8); + if (x < (REAL)0) { + sign = '-'; + x = -x; + } else { + sign = ' '; + } + if (e >= 0) { + x = x / (REAL)Reals_Ten(e); + } else { + x = Reals_Ten(-e) * x; + } + if (x >= (REAL)10) { + x = 1.0000000e-001 * x; + e += 1; + } + if (k + e >= 8) { + k = 8 - e; + } else if (k + e < 0) { + k = -e; + x = (REAL)0; + } + x0 = Reals_Ten(k + e); + x = x0 * x + 5.0000000e-001; + if (x >= (REAL)10 * x0) { + e += 1; + } + e += 1; + i = k + e; + Reals_Convert(x, i, (void*)d, ((LONGINT)(9))); + if (e > 0) { + seq__56(' ', ((n - e) - k) - 2); + Texts_Write(&*W, W__typ, sign); + dig__54(e); + Texts_Write(&*W, W__typ, '.'); + dig__54(k); + } else { + seq__56(' ', (n - k) - 3); + Texts_Write(&*W, W__typ, sign); + Texts_Write(&*W, W__typ, '0'); + Texts_Write(&*W, W__typ, '.'); + seq__56('0', -e); + dig__54(k + e); + } + } + WriteRealFix__53_s = _s.lnk; +} + +void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x) +{ + INTEGER i; + CHAR d[8]; + Reals_ConvertH(x, (void*)d, ((LONGINT)(8))); + i = 0; + do { + Texts_Write(&*W, W__typ, d[__X(i, ((LONGINT)(8)))]); + i += 1; + } while (!(i == 8)); +} + +void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n) +{ + INTEGER e; + LONGREAL x0; + CHAR d[16]; + e = Reals_ExpoL(x); + if (e == 0) { + Texts_WriteString(&*W, W__typ, (CHAR*)" 0", (LONGINT)4); + do { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } while (!(n <= 3)); + } else if (e == 2047) { + Texts_WriteString(&*W, W__typ, (CHAR*)" NaN", (LONGINT)5); + while (n > 4) { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } + } else { + if (n <= 10) { + n = 3; + } else { + n -= 7; + } + do { + Texts_Write(&*W, W__typ, ' '); + n -= 1; + } while (!(n <= 16)); + if (x < (LONGREAL)0) { + Texts_Write(&*W, W__typ, '-'); + x = -x; + } else { + Texts_Write(&*W, W__typ, ' '); + } + e = (int)__ASHR((LONGINT)(e - 1023) * 77, 8); + if (e >= 0) { + x = x / (LONGREAL)Reals_TenL(e); + } else { + x = Reals_TenL(-e) * x; + } + if (x >= (LONGREAL)10) { + x = 1.00000000000000e-001 * x; + e += 1; + } + x0 = Reals_TenL(n - 1); + x = x0 * x + 5.00000000000000e-001; + if (x >= (LONGREAL)10 * x0) { + x = 1.00000000000000e-001 * x; + e += 1; + } + Reals_ConvertL(x, n, (void*)d, ((LONGINT)(16))); + n -= 1; + Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(16)))]); + Texts_Write(&*W, W__typ, '.'); + do { + n -= 1; + Texts_Write(&*W, W__typ, d[__X(n, ((LONGINT)(16)))]); + } while (!(n == 0)); + Texts_Write(&*W, W__typ, 'D'); + if (e < 0) { + Texts_Write(&*W, W__typ, '-'); + e = -e; + } else { + Texts_Write(&*W, W__typ, '+'); + } + Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 100) + 48)); + e = (int)__MOD(e, 100); + Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48)); + Texts_Write(&*W, W__typ, (CHAR)((int)__MOD(e, 10) + 48)); + } +} + +void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x) +{ + INTEGER i; + CHAR d[16]; + Reals_ConvertHL(x, (void*)d, ((LONGINT)(16))); + i = 0; + do { + Texts_Write(&*W, W__typ, d[__X(i, ((LONGINT)(16)))]); + i += 1; + } while (!(i == 16)); +} + +static struct WriteDate__43 { + Texts_Writer *W; + LONGINT *W__typ; + struct WriteDate__43 *lnk; +} *WriteDate__43_s; + +static void WritePair__44 (CHAR ch, LONGINT x); + +static void WritePair__44 (CHAR ch, LONGINT x) +{ + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, ch); + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__DIV(x, 10) + 48)); + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, (CHAR)(__MOD(x, 10) + 48)); +} + +void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d) +{ + struct WriteDate__43 _s; + _s.W = W; _s.W__typ = W__typ; + _s.lnk = WriteDate__43_s; + WriteDate__43_s = &_s; + WritePair__44(' ', __MASK(d, -32)); + WritePair__44('.', __MASK(__ASHR(d, 5), -16)); + WritePair__44('.', __MASK(__ASHR(d, 9), -128)); + WritePair__44(' ', __MASK(__ASHR(t, 12), -32)); + WritePair__44(':', __MASK(__ASHR(t, 6), -64)); + WritePair__44(':', __MASK(t, -64)); + WriteDate__43_s = _s.lnk; +} + +static struct Load0__16 { + Texts_Text *T; + SHORTINT *ecnt; + Files_File *f; + Texts_FileMsg *msg; + CHAR (*mods)[64][32], (*procs)[64][32]; + struct Load0__16 *lnk; +} *Load0__16_s; + +static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT span, Texts_Elem *e); + +static void LoadElem__17 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, LONGINT span, Texts_Elem *e) +{ + Modules_Module M = NIL; + Modules_Command Cmd; + Texts_Alien a = NIL; + LONGINT org, ew, eh; + SHORTINT eno; + Texts_new = NIL; + Files_ReadLInt(&*r, r__typ, &ew); + Files_ReadLInt(&*r, r__typ, &eh); + Files_Read(&*r, r__typ, (void*)&eno); + if (eno > *Load0__16_s->ecnt) { + *Load0__16_s->ecnt = eno; + Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32))); + Files_ReadString(&*r, r__typ, (void*)(*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32))); + } + org = Files_Pos(&*r, r__typ); + M = Modules_ThisMod((*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32))); + if (M != NIL) { + Cmd = Modules_ThisCommand(M, (*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], ((LONGINT)(32))); + if (Cmd != NIL) { + (*Cmd)(); + } + } + *e = Texts_new; + if (*e != NIL) { + (*e)->W = ew; + (*e)->H = eh; + (*e)->base = *Load0__16_s->T; + (*Load0__16_s->msg).pos = pos; + (*(*e)->handle)(*e, (void*)&*Load0__16_s->msg, Texts_FileMsg__typ); + if (Files_Pos(&*r, r__typ) != org + span) { + *e = NIL; + } + } + if (*e == NIL) { + Files_Set(&*r, r__typ, *Load0__16_s->f, org + span); + __NEW(a, Texts__1); + a->W = ew; + a->H = eh; + a->handle = Texts_HandleAlien; + a->base = *Load0__16_s->T; + a->file = *Load0__16_s->f; + a->org = org; + a->span = span; + __COPY((*Load0__16_s->mods)[__X(eno, ((LONGINT)(64)))], a->mod, ((LONGINT)(32))); + __COPY((*Load0__16_s->procs)[__X(eno, ((LONGINT)(64)))], a->proc, ((LONGINT)(32))); + *e = (Texts_Elem)a; + } +} + +static void Texts_Load0 (Files_Rider *r, LONGINT *r__typ, Texts_Text T) +{ + Texts_Run u = NIL, un = NIL; + Texts_Piece p = NIL; + Texts_Elem e = NIL; + LONGINT org, pos, hlen, plen; + SHORTINT ecnt, fno, fcnt, col, voff; + Files_File f = NIL; + Texts_FileMsg msg; + CHAR mods[64][32], procs[64][32]; + CHAR name[32]; + Texts_FontsFont fnts[32]; + struct Load0__16 _s; + _s.T = &T; + _s.ecnt = &ecnt; + _s.f = &f; + _s.msg = &msg; + _s.mods = (void*)mods; + _s.procs = (void*)procs; + _s.lnk = Load0__16_s; + Load0__16_s = &_s; + pos = Files_Pos(&*r, r__typ); + f = Files_Base(&*r, r__typ); + __NEW(u, Texts_RunDesc); + u->len = 9223372036854775807; + u->fnt = NIL; + u->col = 15; + T->head = u; + ecnt = 0; + fcnt = 0; + msg.id = 0; + msg.r = *r; + Files_ReadLInt(&msg.r, Files_Rider__typ, &hlen); + org = (pos - 2) + hlen; + pos = org; + Files_Read(&msg.r, Files_Rider__typ, (void*)&fno); + while (fno != 0) { + if (fno > fcnt) { + fcnt = fno; + Files_ReadString(&msg.r, Files_Rider__typ, (void*)name, ((LONGINT)(32))); + fnts[__X(fno, ((LONGINT)(32)))] = Texts_FontsThis((void*)name, ((LONGINT)(32))); + } + Files_Read(&msg.r, Files_Rider__typ, (void*)&col); + Files_Read(&msg.r, Files_Rider__typ, (void*)&voff); + Files_ReadLInt(&msg.r, Files_Rider__typ, &plen); + if (plen > 0) { + __NEW(p, Texts_PieceDesc); + p->file = f; + p->org = pos; + p->ascii = 0; + un = (Texts_Run)p; + un->len = plen; + } else { + LoadElem__17(&msg.r, Files_Rider__typ, pos - org, -plen, &e); + un = (Texts_Run)e; + un->len = 1; + } + un->col = col; + un->voff = voff; + pos += un->len; + u->next = un; + un->prev = u; + u = un; + Files_Read(&msg.r, Files_Rider__typ, (void*)&fno); + } + u->next = T->head; + T->head->prev = u; + T->cache = T->head; + T->corg = 0; + Files_ReadLInt(&msg.r, Files_Rider__typ, &T->len); + Files_Set(&*r, r__typ, f, Files_Pos(&msg.r, Files_Rider__typ) + T->len); + Load0__16_s = _s.lnk; +} + +void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T) +{ + INTEGER tag; + Files_ReadInt(&*r, r__typ, &tag); + if (tag != -4095) { + Files_Set(&*r, r__typ, Files_Base(&*r, r__typ), Files_Pos(&*r, r__typ) - 2); + } + Texts_Load0(&*r, r__typ, T); +} + +void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len) +{ + Files_File f = NIL; + Files_Rider r; + Texts_Run u = NIL; + Texts_Piece p = NIL; + CHAR tag, version; + LONGINT hlen; + __DUP(name, name__len, CHAR); + f = Files_Old(name, name__len); + if (f == NIL) { + f = Files_New((CHAR*)"", (LONGINT)1); + } + Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(0))); + Files_Read(&r, Files_Rider__typ, (void*)&tag); + Files_Read(&r, Files_Rider__typ, (void*)&version); + if (tag == 0xf0 || (tag == 0x01 && version == 0xf0)) { + Texts_Load0(&r, Files_Rider__typ, T); + } else { + __NEW(u, Texts_RunDesc); + u->len = 9223372036854775807; + u->fnt = NIL; + u->col = 15; + __NEW(p, Texts_PieceDesc); + if ((tag == 0xf7 && version == 0x07)) { + Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(28))); + Files_ReadLInt(&r, Files_Rider__typ, &hlen); + Files_Set(&r, Files_Rider__typ, f, 22 + hlen); + Files_ReadLInt(&r, Files_Rider__typ, &T->len); + p->org = 26 + hlen; + } else { + T->len = Files_Length(f); + p->org = 0; + } + if (T->len > 0) { + p->len = T->len; + p->fnt = Texts_FontsDefault; + p->col = 15; + p->voff = 0; + p->file = f; + p->ascii = 1; + u->next = (Texts_Run)p; + u->prev = (Texts_Run)p; + p->next = u; + p->prev = u; + } else { + u->next = u; + u->prev = u; + } + T->head = u; + T->cache = T->head; + T->corg = 0; + } + __DEL(name); +} + +static struct Store__39 { + SHORTINT *ecnt; + Texts_FileMsg *msg; + Texts_IdentifyMsg *iden; + CHAR (*mods)[64][32], (*procs)[64][32]; + struct Store__39 *lnk; +} *Store__39_s; + +static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_Elem e); + +static void StoreElem__40 (Files_Rider *r, LONGINT *r__typ, LONGINT pos, Texts_Elem e) +{ + Files_Rider r1; + LONGINT org, span; + SHORTINT eno; + __COPY((*Store__39_s->iden).mod, (*Store__39_s->mods)[__X(*Store__39_s->ecnt, ((LONGINT)(64)))], ((LONGINT)(32))); + __COPY((*Store__39_s->iden).proc, (*Store__39_s->procs)[__X(*Store__39_s->ecnt, ((LONGINT)(64)))], ((LONGINT)(32))); + eno = 1; + while (__STRCMP((*Store__39_s->mods)[__X(eno, ((LONGINT)(64)))], (*Store__39_s->iden).mod) != 0 || __STRCMP((*Store__39_s->procs)[__X(eno, ((LONGINT)(64)))], (*Store__39_s->iden).proc) != 0) { + eno += 1; + } + Files_Set(&r1, Files_Rider__typ, Files_Base(&*r, r__typ), Files_Pos(&*r, r__typ)); + Files_WriteLInt(&*r, r__typ, ((LONGINT)(0))); + Files_WriteLInt(&*r, r__typ, ((LONGINT)(0))); + Files_WriteLInt(&*r, r__typ, ((LONGINT)(0))); + Files_Write(&*r, r__typ, eno); + if (eno == *Store__39_s->ecnt) { + *Store__39_s->ecnt += 1; + Files_WriteString(&*r, r__typ, (*Store__39_s->iden).mod, ((LONGINT)(32))); + Files_WriteString(&*r, r__typ, (*Store__39_s->iden).proc, ((LONGINT)(32))); + } + (*Store__39_s->msg).pos = pos; + org = Files_Pos(&*r, r__typ); + (*e->handle)(e, (void*)&*Store__39_s->msg, Texts_FileMsg__typ); + span = Files_Pos(&*r, r__typ) - org; + Files_WriteLInt(&r1, Files_Rider__typ, -span); + Files_WriteLInt(&r1, Files_Rider__typ, e->W); + Files_WriteLInt(&r1, Files_Rider__typ, e->H); +} + +void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T) +{ + Files_Rider r1; + Texts_Run u = NIL, un = NIL; + Texts_Elem e = NIL; + LONGINT org, pos, delta, hlen, rlen; + SHORTINT ecnt, fno, fcnt; + CHAR ch; + Texts_FileMsg msg; + Texts_IdentifyMsg iden; + CHAR mods[64][32], procs[64][32]; + Texts_FontsFont fnts[32]; + CHAR block[1024]; + struct Store__39 _s; + _s.ecnt = &ecnt; + _s.msg = &msg; + _s.iden = &iden; + _s.mods = (void*)mods; + _s.procs = (void*)procs; + _s.lnk = Store__39_s; + Store__39_s = &_s; + org = Files_Pos(&*r, r__typ); + msg.id = 1; + msg.r = *r; + Files_WriteLInt(&msg.r, Files_Rider__typ, ((LONGINT)(0))); + u = T->head->next; + pos = 0; + delta = 0; + fcnt = 1; + ecnt = 1; + while (u != T->head) { + if (__ISP(u, Texts_ElemDesc, 1)) { + iden.mod[0] = 0x00; + (*__GUARDP(u, Texts_ElemDesc, 1)->handle)(__GUARDP(u, Texts_ElemDesc, 1), (void*)&iden, Texts_IdentifyMsg__typ); + } else { + iden.mod[0] = 0x01; + } + if (iden.mod[0] != 0x00) { + fnts[__X(fcnt, ((LONGINT)(32)))] = u->fnt; + fno = 1; + while (__STRCMP(fnts[__X(fno, ((LONGINT)(32)))]->name, u->fnt->name) != 0) { + fno += 1; + } + Files_Write(&msg.r, Files_Rider__typ, fno); + if (fno == fcnt) { + fcnt += 1; + Files_WriteString(&msg.r, Files_Rider__typ, u->fnt->name, ((LONGINT)(32))); + } + Files_Write(&msg.r, Files_Rider__typ, u->col); + Files_Write(&msg.r, Files_Rider__typ, u->voff); + } + if (__ISP(u, Texts_PieceDesc, 1)) { + rlen = u->len; + un = u->next; + while ((((((__ISP(un, Texts_PieceDesc, 1) && un->fnt == u->fnt)) && un->col == u->col)) && un->voff == u->voff)) { + rlen += un->len; + un = un->next; + } + Files_WriteLInt(&msg.r, Files_Rider__typ, rlen); + pos += rlen; + u = un; + } else if (iden.mod[0] != 0x00) { + StoreElem__40(&msg.r, Files_Rider__typ, pos, __GUARDP(u, Texts_ElemDesc, 1)); + pos += 1; + u = u->next; + } else { + delta += 1; + u = u->next; + } + } + Files_Write(&msg.r, Files_Rider__typ, 0); + Files_WriteLInt(&msg.r, Files_Rider__typ, T->len - delta); + hlen = (Files_Pos(&msg.r, Files_Rider__typ) - org) + 2; + Files_Set(&r1, Files_Rider__typ, Files_Base(&msg.r, Files_Rider__typ), org); + Files_WriteLInt(&r1, Files_Rider__typ, hlen); + u = T->head->next; + while (u != T->head) { + if (__ISP(u, Texts_PieceDesc, 1)) { + if (__ISP(u, Texts_PieceDesc, 1)) { + if (((Texts_Piece)u)->ascii) { + Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org); + delta = ((Texts_Piece)u)->len; + while (delta > 0) { + Files_Read(&r1, Files_Rider__typ, (void*)&ch); + delta -= 1; + if (ch == 0x0a) { + Files_Write(&msg.r, Files_Rider__typ, 0x0d); + } else { + Files_Write(&msg.r, Files_Rider__typ, ch); + } + } + } else { + Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org); + delta = ((Texts_Piece)u)->len; + while (delta > 1024) { + Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), ((LONGINT)(1024))); + Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), ((LONGINT)(1024))); + delta -= 1024; + } + Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), delta); + Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, ((LONGINT)(1024)), delta); + } + } else __WITHCHK; + } else { + iden.mod[0] = 0x00; + (*__GUARDP(u, Texts_ElemDesc, 1)->handle)(__GUARDP(u, Texts_ElemDesc, 1), (void*)&iden, Texts_IdentifyMsg__typ); + if (iden.mod[0] != 0x00) { + Files_Write(&msg.r, Files_Rider__typ, 0x1c); + } + } + u = u->next; + } + __GUARDEQR(r, r__typ, Files_Rider) = msg.r; + if (T->notify != NIL) { + (*T->notify)(T, 3, ((LONGINT)(0)), ((LONGINT)(0))); + } + Store__39_s = _s.lnk; +} + +void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len) +{ + Files_File f = NIL; + Files_Rider r; + INTEGER i, res; + CHAR bak[64]; + __DUP(name, name__len, CHAR); + f = Files_New(name, name__len); + Files_Set(&r, Files_Rider__typ, f, ((LONGINT)(0))); + Files_Write(&r, Files_Rider__typ, 0xf0); + Files_Write(&r, Files_Rider__typ, 0x01); + Texts_Store(&r, Files_Rider__typ, T); + i = 0; + while (name[__X(i, name__len)] != 0x00) { + i += 1; + } + __COPY(name, bak, ((LONGINT)(64))); + bak[__X(i, ((LONGINT)(64)))] = '.'; + bak[__X(i + 1, ((LONGINT)(64)))] = 'B'; + bak[__X(i + 2, ((LONGINT)(64)))] = 'a'; + bak[__X(i + 3, ((LONGINT)(64)))] = 'k'; + bak[__X(i + 4, ((LONGINT)(64)))] = 0x00; + Files_Rename(name, name__len, bak, ((LONGINT)(64)), &res); + Files_Register(f); + __DEL(name); +} + +static void EnumPtrs(void (*P)(void*)) +{ + P(Texts_new); + P(Texts_del); + P(Texts_FontsDefault); +} + +__TDESC(Texts_FontDesc, 1, 0) = {__TDFLDS("FontDesc", 32), {-8}}; +__TDESC(Texts_RunDesc, 1, 3) = {__TDFLDS("RunDesc", 40), {0, 8, 24, -32}}; +__TDESC(Texts_PieceDesc, 1, 4) = {__TDFLDS("PieceDesc", 56), {0, 8, 24, 40, -40}}; +__TDESC(Texts_ElemMsg, 1, 0) = {__TDFLDS("ElemMsg", 1), {-8}}; +__TDESC(Texts_ElemDesc, 1, 4) = {__TDFLDS("ElemDesc", 72), {0, 8, 24, 64, -40}}; +__TDESC(Texts_FileMsg, 1, 1) = {__TDFLDS("FileMsg", 56), {32, -16}}; +__TDESC(Texts_CopyMsg, 1, 1) = {__TDFLDS("CopyMsg", 8), {0, -16}}; +__TDESC(Texts_IdentifyMsg, 1, 0) = {__TDFLDS("IdentifyMsg", 64), {-8}}; +__TDESC(Texts_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 16), {8, -16}}; +__TDESC(Texts_TextDesc, 1, 2) = {__TDFLDS("TextDesc", 40), {16, 24, -24}}; +__TDESC(Texts_Reader, 1, 4) = {__TDFLDS("Reader", 96), {8, 24, 48, 72, -40}}; +__TDESC(Texts_Scanner, 1, 4) = {__TDFLDS("Scanner", 208), {8, 24, 48, 72, -40}}; +__TDESC(Texts_Writer, 1, 4) = {__TDFLDS("Writer", 72), {0, 8, 40, 64, -40}}; +__TDESC(Texts__1, 1, 5) = {__TDFLDS("", 160), {0, 8, 24, 64, 72, -48}}; + +export void *Texts__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Files); + __MODULE_IMPORT(Modules); + __MODULE_IMPORT(Reals); + __REGMOD("Texts", EnumPtrs); + __INITYP(Texts_FontDesc, Texts_FontDesc, 0); + __INITYP(Texts_RunDesc, Texts_RunDesc, 0); + __INITYP(Texts_PieceDesc, Texts_RunDesc, 1); + __INITYP(Texts_ElemMsg, Texts_ElemMsg, 0); + __INITYP(Texts_ElemDesc, Texts_RunDesc, 1); + __INITYP(Texts_FileMsg, Texts_ElemMsg, 1); + __INITYP(Texts_CopyMsg, Texts_ElemMsg, 1); + __INITYP(Texts_IdentifyMsg, Texts_ElemMsg, 1); + __INITYP(Texts_BufDesc, Texts_BufDesc, 0); + __INITYP(Texts_TextDesc, Texts_TextDesc, 0); + __INITYP(Texts_Reader, Texts_Reader, 0); + __INITYP(Texts_Scanner, Texts_Reader, 1); + __INITYP(Texts_Writer, Texts_Writer, 0); + __INITYP(Texts__1, Texts_ElemDesc, 2); +/* BEGIN */ + Texts_del = NIL; + __NEW(Texts_FontsDefault, Texts_FontDesc); + __MOVE("Syntax10.Scn.Fnt", Texts_FontsDefault->name, 17); + __ENDMOD; +} diff --git a/bootstrap/windows-88/Texts.h b/bootstrap/windows-88/Texts.h new file mode 100644 index 00000000..d1805878 --- /dev/null +++ b/bootstrap/windows-88/Texts.h @@ -0,0 +1,173 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef Texts__h +#define Texts__h + +#define LARGE +#include "SYSTEM.h" +#include "Files.h" + +typedef + struct Texts_BufDesc { + LONGINT len; + char _prvt0[8]; + } Texts_BufDesc; + +typedef + Texts_BufDesc *Texts_Buffer; + +typedef + struct Texts_ElemMsg { + char _prvt0[1]; + } Texts_ElemMsg; + +typedef + struct Texts_ElemDesc *Texts_Elem; + +typedef + struct Texts_CopyMsg { /* Texts_ElemMsg */ + Texts_Elem e; + } Texts_CopyMsg; + +typedef + struct Texts_RunDesc { + LONGINT _prvt0; + char _prvt1[27]; + } Texts_RunDesc; + +typedef + void (*Texts_Handler)(Texts_Elem, Texts_ElemMsg*, LONGINT *); + +typedef + struct Texts_ElemDesc { + char _prvt0[40]; + LONGINT W, H; + Texts_Handler handle; + char _prvt1[8]; + } Texts_ElemDesc; + +typedef + struct Texts_FileMsg { /* Texts_ElemMsg */ + INTEGER id; + LONGINT pos; + Files_Rider r; + } Texts_FileMsg; + +typedef + struct Texts_FontDesc { + char _prvt0[32]; + } Texts_FontDesc; + +typedef + Texts_FontDesc *Texts_FontsFont; + +typedef + struct Texts_IdentifyMsg { /* Texts_ElemMsg */ + CHAR mod[32], proc[32]; + } Texts_IdentifyMsg; + +typedef + struct Texts_TextDesc *Texts_Text; + +typedef + void (*Texts_Notifier)(Texts_Text, INTEGER, LONGINT, LONGINT); + +typedef + struct Texts_Reader { + BOOLEAN eot; + Texts_FontsFont fnt; + SHORTINT col, voff; + Texts_Elem elem; + char _prvt0[64]; + } Texts_Reader; + +typedef + struct Texts_Scanner { /* Texts_Reader */ + BOOLEAN eot; + Texts_FontsFont fnt; + SHORTINT col, voff; + Texts_Elem elem; + char _prvt0[64]; + CHAR nextCh; + INTEGER line, class; + LONGINT i; + REAL x; + LONGREAL y; + CHAR c; + SHORTINT len; + CHAR s[64]; + } Texts_Scanner; + +typedef + struct Texts_TextDesc { + LONGINT len; + Texts_Notifier notify; + char _prvt0[24]; + } Texts_TextDesc; + +typedef + struct Texts_Writer { + Texts_Buffer buf; + Texts_FontsFont fnt; + SHORTINT col, voff; + char _prvt0[54]; + } Texts_Writer; + + +import Texts_Elem Texts_new; + +import LONGINT *Texts_FontDesc__typ; +import LONGINT *Texts_RunDesc__typ; +import LONGINT *Texts_ElemMsg__typ; +import LONGINT *Texts_ElemDesc__typ; +import LONGINT *Texts_FileMsg__typ; +import LONGINT *Texts_CopyMsg__typ; +import LONGINT *Texts_IdentifyMsg__typ; +import LONGINT *Texts_BufDesc__typ; +import LONGINT *Texts_TextDesc__typ; +import LONGINT *Texts_Reader__typ; +import LONGINT *Texts_Scanner__typ; +import LONGINT *Texts_Writer__typ; + +import void Texts_Append (Texts_Text T, Texts_Buffer B); +import void Texts_ChangeLooks (Texts_Text T, LONGINT beg, LONGINT end, SET sel, Texts_FontsFont fnt, SHORTINT col, SHORTINT voff); +import void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len); +import void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB); +import void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE); +import void Texts_Delete (Texts_Text T, LONGINT beg, LONGINT end); +import Texts_Text Texts_ElemBase (Texts_Elem E); +import LONGINT Texts_ElemPos (Texts_Elem E); +import void Texts_Insert (Texts_Text T, LONGINT pos, Texts_Buffer B); +import void Texts_Load (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +import void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len); +import void Texts_OpenBuf (Texts_Buffer B); +import void Texts_OpenReader (Texts_Reader *R, LONGINT *R__typ, Texts_Text T, LONGINT pos); +import void Texts_OpenScanner (Texts_Scanner *S, LONGINT *S__typ, Texts_Text T, LONGINT pos); +import void Texts_OpenWriter (Texts_Writer *W, LONGINT *W__typ); +import LONGINT Texts_Pos (Texts_Reader *R, LONGINT *R__typ); +import void Texts_Read (Texts_Reader *R, LONGINT *R__typ, CHAR *ch); +import void Texts_ReadElem (Texts_Reader *R, LONGINT *R__typ); +import void Texts_ReadPrevElem (Texts_Reader *R, LONGINT *R__typ); +import void Texts_Recall (Texts_Buffer *B); +import void Texts_Save (Texts_Text T, LONGINT beg, LONGINT end, Texts_Buffer B); +import void Texts_Scan (Texts_Scanner *S, LONGINT *S__typ); +import void Texts_SetColor (Texts_Writer *W, LONGINT *W__typ, SHORTINT col); +import void Texts_SetFont (Texts_Writer *W, LONGINT *W__typ, Texts_FontsFont fnt); +import void Texts_SetOffset (Texts_Writer *W, LONGINT *W__typ, SHORTINT voff); +import void Texts_Store (Files_Rider *r, LONGINT *r__typ, Texts_Text T); +import void Texts_Write (Texts_Writer *W, LONGINT *W__typ, CHAR ch); +import void Texts_WriteDate (Texts_Writer *W, LONGINT *W__typ, LONGINT t, LONGINT d); +import void Texts_WriteElem (Texts_Writer *W, LONGINT *W__typ, Texts_Elem e); +import void Texts_WriteHex (Texts_Writer *W, LONGINT *W__typ, LONGINT x); +import void Texts_WriteInt (Texts_Writer *W, LONGINT *W__typ, LONGINT x, LONGINT n); +import void Texts_WriteLn (Texts_Writer *W, LONGINT *W__typ); +import void Texts_WriteLongReal (Texts_Writer *W, LONGINT *W__typ, LONGREAL x, INTEGER n); +import void Texts_WriteLongRealHex (Texts_Writer *W, LONGINT *W__typ, LONGREAL x); +import void Texts_WriteReal (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n); +import void Texts_WriteRealFix (Texts_Writer *W, LONGINT *W__typ, REAL x, INTEGER n, INTEGER k); +import void Texts_WriteRealHex (Texts_Writer *W, LONGINT *W__typ, REAL x); +import void Texts_WriteString (Texts_Writer *W, LONGINT *W__typ, CHAR *s, LONGINT s__len); +import void *Texts__init(void); + + +#endif diff --git a/bootstrap/windows-88/Vishap.c b/bootstrap/windows-88/Vishap.c new file mode 100644 index 00000000..d084e34a --- /dev/null +++ b/bootstrap/windows-88/Vishap.c @@ -0,0 +1,169 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkamSf */ +#define LARGE +#include "SYSTEM.h" +#include "Configuration.h" +#include "Heap.h" +#include "OPB.h" +#include "OPC.h" +#include "OPM.h" +#include "OPP.h" +#include "OPT.h" +#include "OPV.h" +#include "Platform.h" +#include "Strings.h" +#include "extTools.h" +#include "vt100.h" + + +static CHAR Vishap_mname[256]; + + +export void Vishap_Module (BOOLEAN *done); +static void Vishap_PropagateElementaryTypeSizes (void); +export void Vishap_Translate (void); +static void Vishap_Trap (INTEGER sig); + + +void Vishap_Module (BOOLEAN *done) +{ + BOOLEAN ext, new; + OPT_Node p = NIL; + OPP_Module(&p, OPM_opt); + if (OPM_noerr) { + OPV_Init(); + OPV_AdrAndSize(OPT_topScope); + OPT_Export(&ext, &new); + if (OPM_noerr) { + OPM_OpenFiles((void*)OPT_SelfName, ((LONGINT)(256))); + OPC_Init(); + OPV_Module(p); + if (OPM_noerr) { + if (((OPM_mainProg || OPM_mainLinkStat) && __STRCMP(OPM_modName, "SYSTEM") != 0)) { + OPM_DeleteNewSym(); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"32m", (LONGINT)4); + } + OPM_LogWStr((CHAR*)" Main program.", (LONGINT)16); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + } else { + if (new) { + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"32m", (LONGINT)4); + } + OPM_LogWStr((CHAR*)" New symbol file.", (LONGINT)19); + if (!OPM_notColorOutput) { + vt100_SetAttr((CHAR*)"0m", (LONGINT)3); + } + OPM_RegisterNewSym(); + } else if (ext) { + OPM_LogWStr((CHAR*)" Extended symbol file.", (LONGINT)24); + OPM_RegisterNewSym(); + } + } + } else { + OPM_DeleteNewSym(); + } + } + } + OPM_CloseFiles(); + OPT_Close(); + OPM_LogWLn(); + *done = OPM_noerr; +} + +static void Vishap_PropagateElementaryTypeSizes (void) +{ + OPT_bytetyp->size = OPM_ByteSize; + OPT_sysptrtyp->size = OPM_PointerSize; + OPT_chartyp->size = OPM_CharSize; + OPT_settyp->size = OPM_SetSize; + OPT_realtyp->size = OPM_RealSize; + OPT_inttyp->size = OPM_IntSize; + OPT_linttyp->size = OPM_LIntSize; + OPT_lrltyp->size = OPM_LRealSize; + OPT_sinttyp->size = OPM_SIntSize; + OPT_booltyp->size = OPM_BoolSize; +} + +void Vishap_Translate (void) +{ + BOOLEAN done; + CHAR modulesobj[2048]; + modulesobj[0] = 0x00; + if (OPM_OpenPar()) { + for (;;) { + OPM_Init(&done, (void*)Vishap_mname, ((LONGINT)(256))); + if (!done) { + return; + } + OPM_InitOptions(); + Vishap_PropagateElementaryTypeSizes(); + Heap_GC(0); + Vishap_Module(&done); + if (!done) { + OPM_LogWLn(); + OPM_LogWStr((CHAR*)"Module compilation failed.", (LONGINT)27); + OPM_LogWLn(); + Platform_Exit(1); + } + if (!OPM_dontAsm) { + if (OPM_dontLink) { + extTools_Assemble(OPM_modName, ((LONGINT)(32))); + } else { + if (!(OPM_mainProg || OPM_mainLinkStat)) { + extTools_Assemble(OPM_modName, ((LONGINT)(32))); + Strings_Append((CHAR*)" ", (LONGINT)2, (void*)modulesobj, ((LONGINT)(2048))); + Strings_Append(OPM_modName, ((LONGINT)(32)), (void*)modulesobj, ((LONGINT)(2048))); + Strings_Append((CHAR*)".o", (LONGINT)3, (void*)modulesobj, ((LONGINT)(2048))); + } else { + extTools_LinkMain((void*)OPM_modName, ((LONGINT)(32)), OPM_mainLinkStat, modulesobj, ((LONGINT)(2048))); + } + } + } + } + } +} + +static void Vishap_Trap (INTEGER sig) +{ + Heap_FINALL(); + if (sig == 3) { + Platform_Exit(0); + } else { + if ((sig == 4 && Platform_HaltCode == -15)) { + OPM_LogWStr((CHAR*)" --- Vishap Oberon: internal error", (LONGINT)35); + OPM_LogWLn(); + } + Platform_Exit(2); + } +} + + +export int main(int argc, char **argv) +{ + __INIT(argc, argv); + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Heap); + __MODULE_IMPORT(OPB); + __MODULE_IMPORT(OPC); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(OPP); + __MODULE_IMPORT(OPT); + __MODULE_IMPORT(OPV); + __MODULE_IMPORT(Platform); + __MODULE_IMPORT(Strings); + __MODULE_IMPORT(extTools); + __MODULE_IMPORT(vt100); + __REGMAIN("Vishap", 0); + __REGCMD("Translate", Vishap_Translate); +/* BEGIN */ + Platform_SetInterruptHandler(Vishap_Trap); + Platform_SetQuitHandler(Vishap_Trap); + Platform_SetBadInstructionHandler(Vishap_Trap); + OPB_typSize = OPV_TypSize; + OPT_typSize = OPV_TypSize; + Vishap_Translate(); + __FINI; +} diff --git a/bootstrap/windows-88/WindowsWrapper.h b/bootstrap/windows-88/WindowsWrapper.h new file mode 100644 index 00000000..cdb8714c --- /dev/null +++ b/bootstrap/windows-88/WindowsWrapper.h @@ -0,0 +1,9 @@ +// WindowsWrapper.h +// +// Includes Windows.h while avoiding conflicts with Oberon types. + +#undef BOOLEAN +#undef CHAR +#include +#define BOOLEAN char +#define CHAR unsigned char diff --git a/bootstrap/windows-88/errors.c b/bootstrap/windows-88/errors.c new file mode 100644 index 00000000..879f5cf7 --- /dev/null +++ b/bootstrap/windows-88/errors.c @@ -0,0 +1,199 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" + +typedef + CHAR errors_string[128]; + + +export errors_string errors_errors[350]; + + + + + +export void *errors__init(void) +{ + __DEFMOD; + __REGMOD("errors", 0); +/* BEGIN */ + __MOVE("undeclared identifier", errors_errors[0], 22); + __MOVE("multiply defined identifier", errors_errors[1], 28); + __MOVE("illegal character in number", errors_errors[2], 28); + __MOVE("illegal character in string", errors_errors[3], 28); + __MOVE("identifier does not match procedure name", errors_errors[4], 41); + __MOVE("comment not closed", errors_errors[5], 19); + errors_errors[6][0] = 0x00; + errors_errors[7][0] = 0x00; + errors_errors[8][0] = 0x00; + __MOVE("\'=\' expected", errors_errors[9], 13); + errors_errors[10][0] = 0x00; + errors_errors[11][0] = 0x00; + __MOVE("type definition starts with incorrect symbol", errors_errors[12], 45); + __MOVE("factor starts with incorrect symbol", errors_errors[13], 36); + __MOVE("statement starts with incorrect symbol", errors_errors[14], 39); + __MOVE("declaration followed by incorrect symbol", errors_errors[15], 41); + __MOVE("MODULE expected", errors_errors[16], 16); + errors_errors[17][0] = 0x00; + __MOVE("\'.\' missing", errors_errors[18], 12); + __MOVE("\',\' missing", errors_errors[19], 12); + __MOVE("\':\' missing", errors_errors[20], 12); + errors_errors[21][0] = 0x00; + __MOVE("\')\' missing", errors_errors[22], 12); + __MOVE("\']\' missing", errors_errors[23], 12); + __MOVE("\'}\' missing", errors_errors[24], 12); + __MOVE("OF missing", errors_errors[25], 11); + __MOVE("THEN missing", errors_errors[26], 13); + __MOVE("DO missing", errors_errors[27], 11); + __MOVE("TO missing", errors_errors[28], 11); + errors_errors[29][0] = 0x00; + __MOVE("\'(\' missing", errors_errors[30], 12); + errors_errors[31][0] = 0x00; + errors_errors[32][0] = 0x00; + errors_errors[33][0] = 0x00; + __MOVE("\':=\' missing", errors_errors[34], 13); + __MOVE("\',\' or OF expected", errors_errors[35], 19); + errors_errors[36][0] = 0x00; + errors_errors[37][0] = 0x00; + __MOVE("identifier expected", errors_errors[38], 20); + __MOVE("\';\' missing", errors_errors[39], 12); + errors_errors[40][0] = 0x00; + __MOVE("END missing", errors_errors[41], 12); + errors_errors[42][0] = 0x00; + errors_errors[43][0] = 0x00; + __MOVE("UNTIL missing", errors_errors[44], 14); + errors_errors[45][0] = 0x00; + __MOVE("EXIT not within loop statement", errors_errors[46], 31); + __MOVE("illegally marked identifier", errors_errors[47], 28); + errors_errors[48][0] = 0x00; + errors_errors[49][0] = 0x00; + __MOVE("expression should be constant", errors_errors[50], 30); + __MOVE("constant not an integer", errors_errors[51], 24); + __MOVE("identifier does not denote a type", errors_errors[52], 34); + __MOVE("identifier does not denote a record type", errors_errors[53], 41); + __MOVE("result type of procedure is not a basic type", errors_errors[54], 45); + __MOVE("procedure call of a function", errors_errors[55], 29); + __MOVE("assignment to non-variable", errors_errors[56], 27); + __MOVE("pointer not bound to record or array type", errors_errors[57], 42); + __MOVE("recursive type definition", errors_errors[58], 26); + __MOVE("illegal open array parameter", errors_errors[59], 29); + __MOVE("wrong type of case label", errors_errors[60], 25); + __MOVE("inadmissible type of case label", errors_errors[61], 32); + __MOVE("case label defined more than once", errors_errors[62], 34); + __MOVE("illegal value of constant", errors_errors[63], 26); + __MOVE("more actual than formal parameters", errors_errors[64], 35); + __MOVE("fewer actual than formal parameters", errors_errors[65], 36); + __MOVE("element types of actual array and formal open array differ", errors_errors[66], 59); + __MOVE("actual parameter corresponding to open array is not an array", errors_errors[67], 61); + __MOVE("control variable must be integer", errors_errors[68], 33); + __MOVE("parameter must be an integer constant", errors_errors[69], 38); + __MOVE("pointer or VAR record required as formal receiver", errors_errors[70], 50); + __MOVE("pointer expected as actual receiver", errors_errors[71], 36); + __MOVE("procedure must be bound to a record of the same scope", errors_errors[72], 54); + __MOVE("procedure must have level 0", errors_errors[73], 28); + __MOVE("procedure unknown in base type", errors_errors[74], 31); + __MOVE("invalid call of base procedure", errors_errors[75], 31); + __MOVE("this variable (field) is read only", errors_errors[76], 35); + __MOVE("object is not a record", errors_errors[77], 23); + __MOVE("dereferenced object is not a variable", errors_errors[78], 38); + __MOVE("indexed object is not a variable", errors_errors[79], 33); + __MOVE("index expression is not an integer", errors_errors[80], 35); + __MOVE("index out of specified bounds", errors_errors[81], 30); + __MOVE("indexed variable is not an array", errors_errors[82], 33); + __MOVE("undefined record field", errors_errors[83], 23); + __MOVE("dereferenced variable is not a pointer", errors_errors[84], 39); + __MOVE("guard or test type is not an extension of variable type", errors_errors[85], 56); + __MOVE("guard or testtype is not a pointer", errors_errors[86], 35); + __MOVE("guarded or tested variable is neither a pointer nor a VAR-parameter record", errors_errors[87], 75); + __MOVE("open array not allowed as variable, record field or array element", errors_errors[88], 66); + errors_errors[89][0] = 0x00; + errors_errors[90][0] = 0x00; + errors_errors[91][0] = 0x00; + __MOVE("operand of IN not an integer, or not a set", errors_errors[92], 43); + __MOVE("set element type is not an integer", errors_errors[93], 35); + __MOVE("operand of & is not of type BOOLEAN", errors_errors[94], 36); + __MOVE("operand of OR is not of type BOOLEAN", errors_errors[95], 37); + __MOVE("operand not applicable to (unary) +", errors_errors[96], 36); + __MOVE("operand not applicable to (unary) -", errors_errors[97], 36); + __MOVE("operand of ~ is not of type BOOLEAN", errors_errors[98], 36); + __MOVE("ASSERT fault", errors_errors[99], 13); + __MOVE("incompatible operands of dyadic operator", errors_errors[100], 41); + __MOVE("operand type inapplicable to *", errors_errors[101], 31); + __MOVE("operand type inapplicable to /", errors_errors[102], 31); + __MOVE("operand type inapplicable to DIV", errors_errors[103], 33); + __MOVE("operand type inapplicable to MOD", errors_errors[104], 33); + __MOVE("operand type inapplicable to +", errors_errors[105], 31); + __MOVE("operand type inapplicable to -", errors_errors[106], 31); + __MOVE("operand type inapplicable to = or #", errors_errors[107], 36); + __MOVE("operand type inapplicable to relation", errors_errors[108], 38); + __MOVE("overriding method must be exported", errors_errors[109], 35); + __MOVE("operand is not a type", errors_errors[110], 22); + __MOVE("operand inapplicable to (this) function", errors_errors[111], 40); + __MOVE("operand is not a variable", errors_errors[112], 26); + __MOVE("incompatible assignment", errors_errors[113], 24); + __MOVE("string too long to be assigned", errors_errors[114], 31); + __MOVE("parameter doesn\'t match", errors_errors[115], 24); + __MOVE("number of parameters doesn\'t match", errors_errors[116], 35); + __MOVE("result type doesn\'t match", errors_errors[117], 26); + __MOVE("export mark doesn\'t match with forward declaration", errors_errors[118], 51); + __MOVE("redefinition textually precedes procedure bound to base type", errors_errors[119], 61); + __MOVE("type of expression following IF, WHILE, UNTIL or ASSERT is not BOOLEAN", errors_errors[120], 71); + __MOVE("called object is not a procedure (or is an interrupt procedure)", errors_errors[121], 64); + __MOVE("actual VAR-parameter is not a variable", errors_errors[122], 39); + __MOVE("type of actual parameter is not identical with that of formal VAR-parameter", errors_errors[123], 76); + __MOVE("type of result expression differs from that of procedure", errors_errors[124], 57); + __MOVE("type of case expression is neither INTEGER nor CHAR", errors_errors[125], 52); + __MOVE("this expression cannot be a type or a procedure", errors_errors[126], 48); + __MOVE("illegal use of object", errors_errors[127], 22); + __MOVE("unsatisfied forward reference", errors_errors[128], 30); + __MOVE("unsatisfied forward procedure", errors_errors[129], 30); + __MOVE("WITH clause does not specify a variable", errors_errors[130], 40); + __MOVE("LEN not applied to array", errors_errors[131], 25); + __MOVE("dimension in LEN too large or negative", errors_errors[132], 39); + __MOVE("SYSTEM not imported", errors_errors[135], 20); + __MOVE("key inconsistency of imported module", errors_errors[150], 37); + __MOVE("incorrect symbol file", errors_errors[151], 22); + __MOVE("symbol file of imported module not found", errors_errors[152], 41); + __MOVE("object or symbol file not opened (disk full\?)", errors_errors[153], 46); + __MOVE("recursive import not allowed", errors_errors[154], 29); + __MOVE("generation of new symbol file not allowed", errors_errors[155], 42); + __MOVE("parameter file not found", errors_errors[156], 25); + __MOVE("syntax error in parameter file", errors_errors[157], 31); + __MOVE("not yet implemented", errors_errors[200], 20); + __MOVE("lower bound of set range greater than higher bound", errors_errors[201], 51); + __MOVE("set element greater than MAX(SET) or less than 0", errors_errors[202], 49); + __MOVE("number too large", errors_errors[203], 17); + __MOVE("product too large", errors_errors[204], 18); + __MOVE("division by zero", errors_errors[205], 17); + __MOVE("sum too large", errors_errors[206], 14); + __MOVE("difference too large", errors_errors[207], 21); + __MOVE("overflow in arithmetic shift", errors_errors[208], 29); + __MOVE("case range too large", errors_errors[209], 21); + __MOVE("too many cases in case statement", errors_errors[213], 33); + __MOVE("illegal value of parameter (0 <= p < 256)", errors_errors[218], 42); + __MOVE("machine registers cannot be accessed", errors_errors[219], 37); + __MOVE("illegal value of parameter", errors_errors[220], 27); + __MOVE("too many pointers in a record", errors_errors[221], 30); + __MOVE("too many global pointers", errors_errors[222], 25); + __MOVE("too many record types", errors_errors[223], 22); + __MOVE("too many pointer types", errors_errors[224], 23); + __MOVE("address of pointer variable too large (move forward in text)", errors_errors[225], 61); + __MOVE("too many exported procedures", errors_errors[226], 29); + __MOVE("too many imported modules", errors_errors[227], 26); + __MOVE("too many exported structures", errors_errors[228], 29); + __MOVE("too many nested records for import", errors_errors[229], 35); + __MOVE("too many constants (strings) in module", errors_errors[230], 39); + __MOVE("too many link table entries (external procedures)", errors_errors[231], 50); + __MOVE("too many commands in module", errors_errors[232], 28); + __MOVE("record extension hierarchy too high", errors_errors[233], 36); + __MOVE("export of recursive type not allowed", errors_errors[234], 37); + __MOVE("identifier too long", errors_errors[240], 20); + __MOVE("string too long", errors_errors[241], 16); + __MOVE("address overflow", errors_errors[242], 17); + __MOVE("cyclic type definition not allowed", errors_errors[244], 35); + __MOVE("guarded pointer variable may be manipulated by non-local operations; use auxiliary pointer variable", errors_errors[245], 100); + __MOVE("implicit type cast", errors_errors[301], 19); + __MOVE("inappropriate symbol file ignored", errors_errors[306], 34); + __MOVE("no ELSE symbol after CASE statement sequence may lead to trap", errors_errors[307], 62); + __ENDMOD; +} diff --git a/bootstrap/windows-88/errors.h b/bootstrap/windows-88/errors.h new file mode 100644 index 00000000..43cd79a9 --- /dev/null +++ b/bootstrap/windows-88/errors.h @@ -0,0 +1,19 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef errors__h +#define errors__h + +#define LARGE +#include "SYSTEM.h" + +typedef + CHAR errors_string[128]; + + +import errors_string errors_errors[350]; + + +import void *errors__init(void); + + +#endif diff --git a/bootstrap/windows-88/extTools.c b/bootstrap/windows-88/extTools.c new file mode 100644 index 00000000..7d1a2da9 --- /dev/null +++ b/bootstrap/windows-88/extTools.c @@ -0,0 +1,113 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "Configuration.h" +#include "Console.h" +#include "OPM.h" +#include "Platform.h" +#include "Strings.h" + + +static CHAR extTools_compilationOptions[1023], extTools_CFLAGS[1023]; + + +export void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len); +export void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len); +static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len); + + +static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len) +{ + INTEGER r, status, exitcode; + __DUP(title, title__len, CHAR); + __DUP(cmd, cmd__len, CHAR); + if (OPM_Verbose) { + Console_String(title, title__len); + Console_String(cmd, cmd__len); + Console_Ln(); + } + r = Platform_System(cmd, cmd__len); + status = __MASK(r, -128); + exitcode = __ASHR(r, 8); + if (exitcode > 127) { + exitcode = exitcode - 256; + } + if (r != 0) { + Console_String(title, title__len); + Console_String(cmd, cmd__len); + Console_Ln(); + Console_String((CHAR*)"-- failed: status ", (LONGINT)19); + Console_Int(status, ((LONGINT)(1))); + Console_String((CHAR*)", exitcode ", (LONGINT)12); + Console_Int(exitcode, ((LONGINT)(1))); + Console_String((CHAR*)".", (LONGINT)2); + Console_Ln(); + if ((status == 0 && exitcode == 127)) { + Console_String((CHAR*)"Is the C compiler in the current command path\?", (LONGINT)47); + Console_Ln(); + } + if (status != 0) { + Platform_Halt(status); + } else { + Platform_Halt(exitcode); + } + } + __DEL(title); + __DEL(cmd); +} + +void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len) +{ + CHAR cmd[1023]; + __DUP(moduleName, moduleName__len, CHAR); + __MOVE("gcc -g", cmd, 7); + Strings_Append(extTools_compilationOptions, ((LONGINT)(1023)), (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)"-c ", (LONGINT)4, (void*)cmd, ((LONGINT)(1023))); + Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)".c", (LONGINT)3, (void*)cmd, ((LONGINT)(1023))); + extTools_execute((CHAR*)"Assemble: ", (LONGINT)11, cmd, ((LONGINT)(1023))); + __DEL(moduleName); +} + +void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len) +{ + CHAR cmd[1023]; + __DUP(additionalopts, additionalopts__len, CHAR); + __MOVE("gcc -g", cmd, 7); + Strings_Append((CHAR*)" ", (LONGINT)2, (void*)cmd, ((LONGINT)(1023))); + Strings_Append(extTools_compilationOptions, ((LONGINT)(1023)), (void*)cmd, ((LONGINT)(1023))); + Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)".c ", (LONGINT)4, (void*)cmd, ((LONGINT)(1023))); + Strings_Append(additionalopts, additionalopts__len, (void*)cmd, ((LONGINT)(1023))); + if (statically) { + Strings_Append((CHAR*)"-static", (LONGINT)8, (void*)cmd, ((LONGINT)(1023))); + } + Strings_Append((CHAR*)" -o ", (LONGINT)5, (void*)cmd, ((LONGINT)(1023))); + Strings_Append(moduleName, moduleName__len, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)" -L\"", (LONGINT)5, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)"/lib\"", (LONGINT)6, (void*)cmd, ((LONGINT)(1023))); + Strings_Append((CHAR*)" -l voc", (LONGINT)8, (void*)cmd, ((LONGINT)(1023))); + extTools_execute((CHAR*)"Assemble and link: ", (LONGINT)20, cmd, ((LONGINT)(1023))); + __DEL(additionalopts); +} + + +export void *extTools__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Console); + __MODULE_IMPORT(OPM); + __MODULE_IMPORT(Platform); + __MODULE_IMPORT(Strings); + __REGMOD("extTools", 0); +/* BEGIN */ + Strings_Append((CHAR*)" -I \"", (LONGINT)6, (void*)extTools_compilationOptions, ((LONGINT)(1023))); + Strings_Append((CHAR*)"/opt/voc", (LONGINT)9, (void*)extTools_compilationOptions, ((LONGINT)(1023))); + Strings_Append((CHAR*)"/include\" ", (LONGINT)11, (void*)extTools_compilationOptions, ((LONGINT)(1023))); + Platform_GetEnv((CHAR*)"CFLAGS", (LONGINT)7, (void*)extTools_CFLAGS, ((LONGINT)(1023))); + Strings_Append(extTools_CFLAGS, ((LONGINT)(1023)), (void*)extTools_compilationOptions, ((LONGINT)(1023))); + Strings_Append((CHAR*)" ", (LONGINT)2, (void*)extTools_compilationOptions, ((LONGINT)(1023))); + __ENDMOD; +} diff --git a/bootstrap/windows-88/extTools.h b/bootstrap/windows-88/extTools.h new file mode 100644 index 00000000..61ca56e4 --- /dev/null +++ b/bootstrap/windows-88/extTools.h @@ -0,0 +1,17 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef extTools__h +#define extTools__h + +#define LARGE +#include "SYSTEM.h" + + + + +import void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len); +import void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len); +import void *extTools__init(void); + + +#endif diff --git a/bootstrap/windows-88/vt100.c b/bootstrap/windows-88/vt100.c new file mode 100644 index 00000000..88c386a8 --- /dev/null +++ b/bootstrap/windows-88/vt100.c @@ -0,0 +1,259 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ +#define LARGE +#include "SYSTEM.h" +#include "Console.h" +#include "Strings.h" + + +export CHAR vt100_CSI[5]; +static CHAR vt100_tmpstr[32]; + + +export void vt100_CHA (INTEGER n); +export void vt100_CNL (INTEGER n); +export void vt100_CPL (INTEGER n); +export void vt100_CUB (INTEGER n); +export void vt100_CUD (INTEGER n); +export void vt100_CUF (INTEGER n); +export void vt100_CUP (INTEGER n, INTEGER m); +export void vt100_CUU (INTEGER n); +export void vt100_DECTCEMh (void); +export void vt100_DECTCEMl (void); +export void vt100_DSR (INTEGER n); +export void vt100_ED (INTEGER n); +export void vt100_EL (INTEGER n); +static void vt100_EscSeq (INTEGER n, CHAR *letter, LONGINT letter__len); +static void vt100_EscSeq0 (CHAR *letter, LONGINT letter__len); +static void vt100_EscSeq2 (INTEGER n, INTEGER m, CHAR *letter, LONGINT letter__len); +static void vt100_EscSeqSwapped (INTEGER n, CHAR *letter, LONGINT letter__len); +export void vt100_HVP (INTEGER n, INTEGER m); +export void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len); +export void vt100_RCP (void); +static void vt100_Reverse0 (CHAR *str, LONGINT str__len, INTEGER start, INTEGER end); +export void vt100_SCP (void); +export void vt100_SD (INTEGER n); +export void vt100_SGR (INTEGER n); +export void vt100_SGR2 (INTEGER n, INTEGER m); +export void vt100_SU (INTEGER n); +export void vt100_SetAttr (CHAR *attr, LONGINT attr__len); + + +static void vt100_Reverse0 (CHAR *str, LONGINT str__len, INTEGER start, INTEGER end) +{ + CHAR h; + while (start < end) { + h = str[__X(start, str__len)]; + str[__X(start, str__len)] = str[__X(end, str__len)]; + str[__X(end, str__len)] = h; + start += 1; + end -= 1; + } +} + +void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len) +{ + CHAR b[21]; + INTEGER s, e; + SHORTINT maxLength; + maxLength = 20; + if (int_ == (-9223372036854775807-1)) { + __MOVE("-9223372036854775808", b, 21); + e = 20; + } else { + if (int_ < 0) { + b[0] = '-'; + int_ = -int_; + s = 1; + } else { + s = 0; + } + e = s; + do { + b[__X(e, ((LONGINT)(21)))] = (CHAR)(__MOD(int_, 10) + 48); + int_ = __DIV(int_, 10); + e += 1; + } while (!(int_ == 0)); + b[__X(e, ((LONGINT)(21)))] = 0x00; + vt100_Reverse0((void*)b, ((LONGINT)(21)), s, e - 1); + } + __COPY(b, str, str__len); +} + +static void vt100_EscSeq0 (CHAR *letter, LONGINT letter__len) +{ + CHAR cmd[9]; + __DUP(letter, letter__len, CHAR); + __COPY(vt100_CSI, cmd, ((LONGINT)(9))); + Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(9))); + Console_String(cmd, ((LONGINT)(9))); + __DEL(letter); +} + +static void vt100_EscSeq (INTEGER n, CHAR *letter, LONGINT letter__len) +{ + CHAR nstr[2]; + CHAR cmd[7]; + __DUP(letter, letter__len, CHAR); + vt100_IntToStr(n, (void*)nstr, ((LONGINT)(2))); + __COPY(vt100_CSI, cmd, ((LONGINT)(7))); + Strings_Append(nstr, ((LONGINT)(2)), (void*)cmd, ((LONGINT)(7))); + Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(7))); + Console_String(cmd, ((LONGINT)(7))); + __DEL(letter); +} + +static void vt100_EscSeqSwapped (INTEGER n, CHAR *letter, LONGINT letter__len) +{ + CHAR nstr[2]; + CHAR cmd[7]; + __DUP(letter, letter__len, CHAR); + vt100_IntToStr(n, (void*)nstr, ((LONGINT)(2))); + __COPY(vt100_CSI, cmd, ((LONGINT)(7))); + Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(7))); + Strings_Append(nstr, ((LONGINT)(2)), (void*)cmd, ((LONGINT)(7))); + Console_String(cmd, ((LONGINT)(7))); + __DEL(letter); +} + +static void vt100_EscSeq2 (INTEGER n, INTEGER m, CHAR *letter, LONGINT letter__len) +{ + CHAR nstr[5], mstr[5]; + CHAR cmd[12]; + __DUP(letter, letter__len, CHAR); + vt100_IntToStr(n, (void*)nstr, ((LONGINT)(5))); + vt100_IntToStr(m, (void*)mstr, ((LONGINT)(5))); + __COPY(vt100_CSI, cmd, ((LONGINT)(12))); + Strings_Append(nstr, ((LONGINT)(5)), (void*)cmd, ((LONGINT)(12))); + Strings_Append((CHAR*)";", (LONGINT)2, (void*)cmd, ((LONGINT)(12))); + Strings_Append(mstr, ((LONGINT)(5)), (void*)cmd, ((LONGINT)(12))); + Strings_Append(letter, letter__len, (void*)cmd, ((LONGINT)(12))); + Console_String(cmd, ((LONGINT)(12))); + __DEL(letter); +} + +void vt100_CUU (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"A", (LONGINT)2); +} + +void vt100_CUD (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"B", (LONGINT)2); +} + +void vt100_CUF (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"C", (LONGINT)2); +} + +void vt100_CUB (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"D", (LONGINT)2); +} + +void vt100_CNL (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"E", (LONGINT)2); +} + +void vt100_CPL (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"F", (LONGINT)2); +} + +void vt100_CHA (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"G", (LONGINT)2); +} + +void vt100_CUP (INTEGER n, INTEGER m) +{ + vt100_EscSeq2(n, m, (CHAR*)"H", (LONGINT)2); +} + +void vt100_ED (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"J", (LONGINT)2); +} + +void vt100_EL (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"K", (LONGINT)2); +} + +void vt100_SU (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"S", (LONGINT)2); +} + +void vt100_SD (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"T", (LONGINT)2); +} + +void vt100_HVP (INTEGER n, INTEGER m) +{ + vt100_EscSeq2(n, m, (CHAR*)"f", (LONGINT)2); +} + +void vt100_SGR (INTEGER n) +{ + vt100_EscSeq(n, (CHAR*)"m", (LONGINT)2); +} + +void vt100_SGR2 (INTEGER n, INTEGER m) +{ + vt100_EscSeq2(n, m, (CHAR*)"m", (LONGINT)2); +} + +void vt100_DSR (INTEGER n) +{ + vt100_EscSeq(6, (CHAR*)"n", (LONGINT)2); +} + +void vt100_SCP (void) +{ + vt100_EscSeq0((CHAR*)"s", (LONGINT)2); +} + +void vt100_RCP (void) +{ + vt100_EscSeq0((CHAR*)"u", (LONGINT)2); +} + +void vt100_DECTCEMl (void) +{ + vt100_EscSeq0((CHAR*)"\?25l", (LONGINT)5); +} + +void vt100_DECTCEMh (void) +{ + vt100_EscSeq0((CHAR*)"\?25h", (LONGINT)5); +} + +void vt100_SetAttr (CHAR *attr, LONGINT attr__len) +{ + CHAR tmpstr[16]; + __DUP(attr, attr__len, CHAR); + __COPY(vt100_CSI, tmpstr, ((LONGINT)(16))); + Strings_Append(attr, attr__len, (void*)tmpstr, ((LONGINT)(16))); + Console_String(tmpstr, ((LONGINT)(16))); + __DEL(attr); +} + + +export void *vt100__init(void) +{ + __DEFMOD; + __MODULE_IMPORT(Console); + __MODULE_IMPORT(Strings); + __REGMOD("vt100", 0); + __REGCMD("DECTCEMh", vt100_DECTCEMh); + __REGCMD("DECTCEMl", vt100_DECTCEMl); + __REGCMD("RCP", vt100_RCP); + __REGCMD("SCP", vt100_SCP); +/* BEGIN */ + __COPY("", vt100_CSI, ((LONGINT)(5))); + Strings_Append((CHAR*)"[", (LONGINT)2, (void*)vt100_CSI, ((LONGINT)(5))); + __ENDMOD; +} diff --git a/bootstrap/windows-88/vt100.h b/bootstrap/windows-88/vt100.h new file mode 100644 index 00000000..b124915f --- /dev/null +++ b/bootstrap/windows-88/vt100.h @@ -0,0 +1,38 @@ +/* voc 1.2 [2016/06/15] for gcc LP64 on cygwin xtspkaSfF */ + +#ifndef vt100__h +#define vt100__h + +#define LARGE +#include "SYSTEM.h" + + +import CHAR vt100_CSI[5]; + + +import void vt100_CHA (INTEGER n); +import void vt100_CNL (INTEGER n); +import void vt100_CPL (INTEGER n); +import void vt100_CUB (INTEGER n); +import void vt100_CUD (INTEGER n); +import void vt100_CUF (INTEGER n); +import void vt100_CUP (INTEGER n, INTEGER m); +import void vt100_CUU (INTEGER n); +import void vt100_DECTCEMh (void); +import void vt100_DECTCEMl (void); +import void vt100_DSR (INTEGER n); +import void vt100_ED (INTEGER n); +import void vt100_EL (INTEGER n); +import void vt100_HVP (INTEGER n, INTEGER m); +import void vt100_IntToStr (LONGINT int_, CHAR *str, LONGINT str__len); +import void vt100_RCP (void); +import void vt100_SCP (void); +import void vt100_SD (INTEGER n); +import void vt100_SGR (INTEGER n); +import void vt100_SGR2 (INTEGER n, INTEGER m); +import void vt100_SU (INTEGER n); +import void vt100_SetAttr (CHAR *attr, LONGINT attr__len); +import void *vt100__init(void); + + +#endif diff --git a/make.cmd b/make.cmd new file mode 100644 index 00000000..5ff269df --- /dev/null +++ b/make.cmd @@ -0,0 +1,429 @@ +@echo off + +:: mscmake.cmd - Build Oberon with Microsoft C compiler. + +:: Expects the path to include cl.exe. + +:: As of 10th Feb 2016 the miscrosoft c compiler and build tools +:: can be downloaded independently of the full Visual Studio IDE +:: as the 'Visual C++ Build Tools 2015'. + +:: See: https://blogs.msdn.microsoft.com/vcblog/2015/11/02/announcing-visual-c-build-tools-2015-standalone-c-tools-for-build-environments/ + +:: With this installed, from the start button select: +:: All Apps / Visual C++ Build Tools / Visual C++ x86 Native Build Tools Command Prompt + + +:: Create configuration and parameter files. + +cl -nologo -Isrc\system src\tools\make\configure.c >nul +setlocal +configure.exe >nul +del configure.obj configure.exe 2>nul + +:: Extract make variables into local environment + +for /F "delims='=' tokens=1,2" %%a in (Configuration.make) do set %%a=%%b + +set FLAVOUR=%OS%.%DATAMODEL%.%COMPILER% +set BUILDDIR=build\%FLAVOUR% +set VISHAP=%ONAME%%BINEXT% + +for /F %%d in ('cd');do set ROOTDIR=%%d + + + +:: Process target parameter + +if "%1" equ "" ( + call :usage +) else ( + call :%1 +) +endlocal +goto :eof + + + + +:usage +@echo. +@echo Usage: +@echo. +@echo. make full - Make and install compiler (from administrator prompt) +@echo. +@echo. make clean - Remove made files +@echo. make compiler - Build the compiler but not the library +@echo. make library - Build all library files and make library +@echo. make install - Install built compiler and library (from administrator prompt) +goto :eof + + + + +:full +call :clean || exit /b +call :compiler || exit /b +call :browsercmd || exit /b +call :library || exit /b +call :install || exit /b +goto :eof + + + + +:compiler +call :translate || exit /b +call :assemble || exit /b +goto :eof + + + + +:library +call :v4 || exit /b +call :ooc2 || exit /b +call :ooc || exit /b +call :ulm || exit /b +call :pow32 || exit /b +call :misc || exit /b +call :s3 || exit /b +call :librarybinary || exit /b +goto :eof + + + + +:clean +rd /s /q %BUILDDIR% 2>nul +del /q %VISHAP% 2>nul +goto :eof + + + + +:assemble +echo. +echo.make assemble - compiling Oberon compiler c source:: +echo. VERSION: %VERSION% +echo. Target characeristics: +echo. PLATFORM: %PLATFORM% +echo. OS: %OS% +echo. BUILDDIR: %BUILDDIR% +echo. Oberon characteristics: +echo. INTSIZE: %INTSIZE% +echo. ADRSIZE: %ADRSIZE% +echo. ALIGNMENT: %ALIGNMENT% +echo. C compiler: +echo. COMPILER: %COMPILER% +echo. COMPILE: %COMPILE% +echo. DATAMODEL: %DATAMODEL% + +cd %BUILDDIR% + +cl -nologo /Zi -c SYSTEM.c Configuration.c Platform.c Heap.c || exit /b +cl -nologo /Zi -c Console.c Strings.c Modules.c Files.c || exit /b +cl -nologo /Zi -c Reals.c Texts.c vt100.c errors.c || exit /b +cl -nologo /Zi -c OPM.c extTools.c OPS.c OPT.c || exit /b +cl -nologo /Zi -c OPC.c OPV.c OPB.c OPP.c || exit /b + +cl -nologo /Zi Vishap.c /Fe%ROOTDIR%\%VISHAP% ^ +SYSTEM.obj Configuration.obj Platform.obj Heap.obj ^ +Console.obj Strings.obj Modules.obj Files.obj ^ +Reals.obj Texts.obj vt100.obj errors.obj ^ +OPM.obj extTools.obj OPS.obj OPT.obj ^ +OPC.obj OPV.obj OPB.obj OPP.obj || exit /b + +echo.%VISHAP% created. +cd %ROOTDIR% +goto :eof + + + + +:compilefromsavedsource +echo.Populating clean build directory from bootstrap C sources. +mkdir %BUILDDIR% >nul 2>nul +copy bootstrap\%PLATFORM%-%ADRSIZE%%ALIGNMENT%\*.* %BUILDDIR% >nul +call :assemble || exit /b +goto :eof + + + + +:translate +:: Make sure we have an oberon compiler binary: if we built one earlier we'll use it, +:: otherwise use one of the saved sets of C sources in the bootstrap directory. +if not exist %VISHAP% call :compilefromsavedsource + +echo. +echo.make translate - translating compiler source: +echo. PLATFORM: %PLATFORM% +echo. INTSIZE: %INTSIZE% +echo. ADRSIZE: %ADRSIZE% +echo. ALIGNMENT: %ALIGNMENT% + +md %BUILDDIR% 2>nul +cd %BUILDDIR% +%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../Configuration.Mod || exit /b +%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/system/Platform%PLATFORM%.Mod || exit /b +%ROOTDIR%\%VISHAP% -SFsapx -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/system/Heap.Mod || exit /b +%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/system/Console.Mod || exit /b +%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/library/v4/Strings.Mod || exit /b +%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/library/v4/Modules.Mod || exit /b +%ROOTDIR%\%VISHAP% -SFsx -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/system/Files.Mod || exit /b +%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/library/v4/Reals.Mod || exit /b +%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/library/v4/Texts.Mod || exit /b +%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/library/misc/vt100.Mod || exit /b +%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/compiler/errors.Mod || exit /b +%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/compiler/OPM.cmdln.Mod || exit /b +%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/compiler/extTools.Mod || exit /b +%ROOTDIR%\%VISHAP% -SFsx -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/compiler/OPS.Mod || exit /b +%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/compiler/OPT.Mod || exit /b +%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/compiler/OPC.Mod || exit /b +%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/compiler/OPV.Mod || exit /b +%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/compiler/OPB.Mod || exit /b +%ROOTDIR%\%VISHAP% -SFs -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/compiler/OPP.Mod || exit /b +%ROOTDIR%\%VISHAP% -Ssm -B%INTSIZE%%ADRSIZE%%ALIGNMENT% ../../src/compiler/Vishap.Mod || exit /b +cd %ROOTDIR% +copy src\system\*.c %BUILDDIR% >nul +copy src\system\*.h %BUILDDIR% >nul +echo.%BUILDDIR% filled with compiler C source. +goto :eof + + + + +:browsercmd +echo. +echo.Making symbol browser +cd %BUILDDIR% +%ROOTDIR%/%VISHAP% -Sm ../../src/tools/browser/BrowserCmd.Mod +cl -nologo BrowserCmd.c /Feshowdef.exe ^ + Platform.obj Texts.obj OPT.obj Heap.obj Console.obj SYSTEM.obj OPM.obj OPS.obj OPV.obj ^ + Files.obj Reals.obj Modules.obj vt100.obj errors.obj Configuration.obj Strings.obj ^ + OPC.obj +cd %ROOTDIR% +goto :eof + + + + +:install +whoami /groups | find "12288" >nul +if errorlevel 1 ( +echo make install - administrator rights required. Please run under an administrator command prompt. +goto :eof +) +rmdir /s /q "%INSTALLDIR%" >nul 2>&1 +mkdir "%INSTALLDIR%" >nul 2>&1 +mkdir "%INSTALLDIR%\bin" >nul 2>&1 +mkdir "%INSTALLDIR%\include" >nul 2>&1 +mkdir "%INSTALLDIR%\sym" >nul 2>&1 +mkdir "%INSTALLDIR%\lib" >nul 2>&1 +copy %BUILDDIR%\*.h "%INSTALLDIR%\include" >nul +copy %BUILDDIR%\*.sym "%INSTALLDIR%\sym" >nul +copy %VISHAP% "%INSTALLDIR%\bin" >nul +copy %BUILDDIR%\showdef.exe "%INSTALLDIR%\bin" >nul +copy %BUILDDIR%\lib%ONAME%.lib "%INSTALLDIR%\lib" >nul +echo. +echo.Now add "%INSTALLDIR%\bin" to your path. +goto :eof + + +:uninstall +whoami /groups | find "12288" >nul +if errorlevel 1 ( +echo make uninstall - administrator rights required. Please run under an administrator command prompt. +goto :eof +) +rmdir /s /q "%INSTALLDIR%" >nul 2>&1 +goto :eof + + + + +:v4 +echo. +echo.Making V4 library +cd %BUILDDIR% +%ROOTDIR%\%VISHAP% -Fs ../../src/library/v4/Args.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/v4/Printer.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/v4/Sets.Mod || exit /b +cd %ROOTDIR% +goto :eof + +:ooc2 +echo.Making ooc2 library +cd %BUILDDIR% +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc2/ooc2Strings.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc2/ooc2Ascii.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc2/ooc2CharClass.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc2/ooc2ConvTypes.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc2/ooc2IntConv.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc2/ooc2IntStr.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc2/ooc2Real0.Mod || exit /b +cd %ROOTDIR% +goto :eof + +:ooc +echo.Making ooc library +cd %BUILDDIR% +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocLowReal.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocLowLReal.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocRealMath.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocOakMath.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocLRealMath.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocLongInts.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocComplexMath.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocLComplexMath.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocAscii.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocCharClass.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocStrings.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocConvTypes.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocLRealConv.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocLRealStr.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocRealConv.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocRealStr.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocIntConv.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocIntStr.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocMsg.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocSysClock.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocTime.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocChannel.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocStrings2.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocRts.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocFilenames.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocTextRider.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocBinaryRider.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocJulianDay.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocFilenames.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocwrapperlibc.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ooc/oocC%DATAMODEL%.Mod || exit /b +cd %ROOTDIR% +goto :eof + +:oocX11 +echo No X11 support on plain Windows - use cygwin and build with cygwin make. +goto :eof + +:ulm +echo.Making ulm library +cd %BUILDDIR% +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmObjects.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmPriorities.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmDisciplines.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmServices.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmSys.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmSYSTEM.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmEvents.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmProcess.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmResources.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmForwarders.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmRelatedEvents.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmTypes.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmStreams.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmStrings.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmSysTypes.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmTexts.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmSysConversions.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmErrors.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmSysErrors.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmSysStat.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmASCII.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmSets.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmIO.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmAssertions.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmIndirectDisciplines.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmStreamDisciplines.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmIEEE.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmMC68881.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmReals.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmPrint.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmWrite.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmConstStrings.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmPlotters.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmSysIO.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmLoader.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmNetIO.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmPersistentObjects.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmPersistentDisciplines.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmOperations.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmScales.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmTimes.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmClocks.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmTimers.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmConditions.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmStreamConditions.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmTimeConditions.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmCiphers.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmCipherOps.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmBlockCiphers.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmAsymmetricCiphers.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmConclusions.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmRandomGenerators.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmTCrypt.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/ulm/ulmIntOperations.Mod || exit /b +cd %ROOTDIR% +goto :eof + +:pow32 +echo.Making pow32 library +cd %BUILDDIR% +%ROOTDIR%\%VISHAP% -Fs ../../src/library/pow/powStrings.Mod || exit /b +cd %ROOTDIR% +goto :eof + +:misc +echo.Making misc library +cd %BUILDDIR% +%ROOTDIR%\%VISHAP% -Fs ../../src/system/Oberon.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/misc/crt.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/misc/Listen.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/misc/MersenneTwister.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/misc/MultiArrays.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/misc/MultiArrayRiders.Mod || exit /b +cd %ROOTDIR% +goto :eof + +:s3 +echo.Making s3 library +cd %BUILDDIR% +%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethBTrees.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethMD5.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethSets.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethZlib.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethZlibBuffers.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethZlibInflate.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethZlibDeflate.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethZlibReaders.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethZlibWriters.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethZip.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethRandomNumbers.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethGZReaders.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethGZWriters.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethUnicode.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethDates.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethReals.Mod || exit /b +%ROOTDIR%\%VISHAP% -Fs ../../src/library/s3/ethStrings.Mod || exit /b +cd %ROOTDIR% +goto :eof + + + + +:librarybinary +echo. +echo.Making lib%ONAME% +:: Remove objects that should not be part of the library +del /q %BUILDDIR%\Vishap.obj +:: Make static library +lib -nologo %BUILDDIR%\*.obj -out:%BUILDDIR%\lib%ONAME%.lib || exit /b +goto :eof + + + + + + + diff --git a/makefile b/makefile new file mode 100644 index 00000000..2cc4da4e --- /dev/null +++ b/makefile @@ -0,0 +1,247 @@ +# Vishap Oberon master makefile. +# +# Makes sure configuration parameters are up to date and then hands off +# to src/tools/make/vishap.make. + + + + +# To build and install the Oberon compiler and library on a Unix based +# OS (Linux/Mac/BSD etc.) or on cygwin, run: +# +# make full +# +# To override your OSs default C compiler, first run +# +# export CC=compiler +# +# Where compiler is one of: +# +# clang +# gcc +# i686-w64-mingw32-gcc (32 bit cygwin only) +# x86_64-w64-mingw32-gcc (64 bit cygwin only) +# +# (To build on native Windows use make.cmd, not this makefile. Make.cmd automatically +# assumes use of the Microsoft compiler cl.) + + + + +# C compiler data models and sizes and alignments of Oberon types. +# +# There are just three distinct data models that we build for: +# +# 44 - 32 bit pointers, 32 bit alignment +# 48 - 32 bit pointers, 64 bit alignment +# 88 - 64 bit pointers, 64 bit alignment +# +# Meaning of n bit alignment: +# +# Individual variables of up to n bits are aligned in memory to +# whole multiples of their own size, rounded up to a power of two. +# Variables larger than n bits are aligned to n bits. +# +# (n will always be a power of 2). +# +# Thus: +# +# Size 32 bit alignment 64 bit alignment +# -------- ---------------- ---------------- +# CHAR 1 byte 1 byte 1 byte +# INTEGER 4 bytes 4 bytes 4 bytes +# LONGINT 8 bytes 4 bytes 8 bytes +# +# Note that in practice for 32 and 64 bit systems, this only affects +# LONGINT. +# +# C data model names: +# +# name 32 bit types 64 bit types alignment +# --------- ------------------ ------------------------ --------- +# ILP32 int, long, pointer long long 32 or 64 +# LP64 int long, long long, pointer 64 +# LLP64 int, long long long 64 + + + + +# Default make target - explain usage +usage: + @echo "" + @echo Usage: + @echo "" + @echo " make full" + @echo "" + @echo " Does a full, clean build, installs it, and runs confidence tests." + @echo " Requires root access (for the install) except on cygwin." + @echo "" + @echo "Targets for building and installation:" + @echo " make clean - Clean out the build directory" + @echo " make compiler - Build the compiler but not the library" + @echo " make browsercmd - Build the symbol browser (showdef)" + @echo " make library - Build all library files and make library" + @echo " make install - Install built compiler and library in /opt or C:\\PROGRAM FILES*" + @echo " (Needs root access)" + @echo "" + @echo "Targets for (re)creating and reverting bootstrap C sources:" + @echo " make bootstrap - Uddate bootstrap C source directories. Always run on 64 bit." + @echo " make revertbootstrap - Use git checkout to restore bootstrap C source directories" + @echo "" + @echo "" + @echo "Multi-platform coordinated network build:" + @echo " make coordinator - Start central task to trigger builds and collect logs" + @echo " make auto - Start machine specific build server" + @echo " make autobuild - Trigger all machines running 'make auto' to start a build" + @echo " make autobuild - Terminate 'make auto' on all machines" + + + + +# Generate config files Configuration.Make and Configuartion.Mod +FORCE: + +configuration: FORCE + @$(CC) -I src/system -o a.o src/tools/make/configure.c + @./a.o + @rm a.o + + + + +reportsizes: FORCE + @$(CC) -I src/system -o a.o src/tools/make/configure.c + @./a.o report + @rm a.o + + + + +# --- Building and installation --- + + + + +# clean - clean out the bulid directory +clean: configuration + @make -f src/tools/make/vishap.make -s clean + + + + +# full: Full build of compiler and libarary. +full: configuration + @make -f src/tools/make/vishap.make -s clean + @make -f src/tools/make/vishap.make -s translate + @make -f src/tools/make/vishap.make -s assemble + @make -f src/tools/make/vishap.make -s browsercmd + @make -f src/tools/make/vishap.make -s library + @make -f src/tools/make/vishap.make -s install + @make -f src/tools/make/vishap.make -s confidence + + + + +# compile: compiler only, without cleaning +compiler: configuration + @make -f src/tools/make/vishap.make -s translate + @make -f src/tools/make/vishap.make -s assemble + + + + +# browsercmd: build the 'showdef' command +browsercmd: configuration + @make -f src/tools/make/vishap.make -s browsercmd + + + + +# library: build all directories under src/library +library: configuration + @make -f src/tools/make/vishap.make -s library + + + + +# install: Copy built files to install directory +install: configuration + @make -f src/tools/make/vishap.make -s install + +uninstall: configuration + @make -f src/tools/make/vishap.make -s uninstall + + + + +# --- Bootstrap C source generation and reversion --- + + +# bootstrap: Rebuild the bootstrap directories +bootstrap: configuration + rm -rf bootstrap/* + make -f src/tools/make/vishap.make -s translate INTSIZE=2 ADRSIZE=4 ALIGNMENT=4 PLATFORM=unix BUILDDIR=bootstrap/unix-44 && rm bootstrap/unix-44/*.sym + make -f src/tools/make/vishap.make -s translate INTSIZE=2 ADRSIZE=4 ALIGNMENT=8 PLATFORM=unix BUILDDIR=bootstrap/unix-48 && rm bootstrap/unix-48/*.sym + make -f src/tools/make/vishap.make -s translate INTSIZE=4 ADRSIZE=8 ALIGNMENT=8 PLATFORM=unix BUILDDIR=bootstrap/unix-88 && rm bootstrap/unix-88/*.sym + make -f src/tools/make/vishap.make -s translate INTSIZE=2 ADRSIZE=4 ALIGNMENT=8 PLATFORM=windows BUILDDIR=bootstrap/windows-48 && rm bootstrap/windows-48/*.sym + make -f src/tools/make/vishap.make -s translate INTSIZE=4 ADRSIZE=8 ALIGNMENT=8 PLATFORM=windows BUILDDIR=bootstrap/windows-88 && rm bootstrap/windows-88/*.sym + + + + +revertbootstrap: + @rm -rf bootstrap/* + git checkout bootstrap + + + + +# --- multi-machine multi-platform build management --- + + + +# coordinator: Start the test machine coordinator +coordinator: configuration + @make -f src/tools/make/vishap.make -s clean + @make -f src/tools/make/vishap.make -s translate + @make -f src/tools/make/vishap.make -s assemble + @make -f src/tools/make/vishap.make -s testtools + @rm -f "build/*.log" + cd build && ../testcoordinator.exe + + + + +# auto: machine specific build server +auto: configuration + @make -f src/tools/make/vishap.make -s auto + + + + +# autoonce: What auto does each time a build is triggered. +autoonce: configuration + git pull + @if make -s full; then echo \*\* Succeeded \*\*; else echo \*\* Failed \*\*;fi + + + + +# autobuild: Start test clients. +autobuild: configuration + ./testclient -c "make -s autoonce" + + + + +# autostop: Tell test clients to exit their wait loop. +autostop: configuration + ./testclient -c "exit" + + + + + + + +