diff --git a/.gitattributes b/.gitattributes index 08b0dbe0..0b277fd3 100644 --- a/.gitattributes +++ b/.gitattributes @@ -34,3 +34,7 @@ *.Mod diff=pascal *.c diff=cpp *.h diff=cpp + +# Set the language to Oberon +*.Mod linguist-language=Oberon +*.mod linguist-language=Oberon diff --git a/.gitignore b/.gitignore index cce16916..19fc1ede 100644 --- a/.gitignore +++ b/.gitignore @@ -11,6 +11,7 @@ /*.sym /*.asm /*.mod +/Errors.Txt /Errors.txt /olang /src/test/**/*.exe @@ -20,9 +21,11 @@ /src/test/**/*.obj /src/test/**/*.sym **/*.stackdump +!/src/test/confidence/**/expected /src/test/confidence/**/input /src/test/confidence/**/result /src/test/confidence/**/result-* +/src/test/confidence/**/*[^.]* /src/test/confidence/**/*.asm /src/test/confidence/**/*.s /src/test/confidence/**/*.map @@ -35,3 +38,9 @@ **/.tmp.* /*.pdb /*.ilk +/t/* +/triage/BasicTypeSize.md +/triage/Roadmap.md +triage/system/* +tags +voc diff --git a/ReadMe.md b/ReadMe.md index 3e2120a5..95d7f840 100644 --- a/ReadMe.md +++ b/ReadMe.md @@ -1,12 +1,12 @@ -[![Build status](http://brownsmeet.com/build-status.svg)](http://brownsmeet.com/log/) +![Build status](https://brownsmeet.com/githubhook/vishaps-status) # Ѵishap Oberon -[Ѵishap Oberon](http://oberon.vishap.am) is a free and open source (GPLv3) +[Ѵishap Oberon](https://vishap.oberon.am/) is a free and open source (GPLv3) implementation of the Oberon-2 language and libraries for use on conventional operating systems such as Linux, BSD, Android, Mac and Windows. -Vishap's Oberon Compiler (voc) uses a C backend (gcc, clang or msc) to compile +Vishap's Oberon Compiler (voc) uses a C backend (gcc, clang, tcc or msc) to compile Oberon programs under Unix, Mac or Windows. Vishap Oberon includes libraries from the Ulm, oo2c and Ofront Oberon compilers, as well as default libraries complying with the Oakwood Guidelines for Oberon-2 compilers. @@ -31,9 +31,11 @@ It is easy to install the Oberon compiler and libraries with the following simple steps: 1. Install pre-requisites such as git, gcc, static C libraries, diff utils. - 2. Clone the repository and run 'make full'. - 3. Optionally install to a system directory such as /opt or /usr/local/share. - 4. Set your PATH variable to include the compiler binary. + 2. Clone the repository: `git clone https://github.com/vishaps/voc`. + 3. Optionally `export CC=clang` or `export CC=tcc`. + 4. run `make full`. + 5. Optionally install to a system directory such as /opt or /usr/local/share with `make install` (might be with sudo). + 6. Set your PATH variable to include the compiler binary. These are detailed below: @@ -74,7 +76,7 @@ for your OS as follows: | ------- | -------------------------------------- | | Linux | `/opt/voc` | | BSD | `/usr/local/share/voc` | -| Windows | See [**Windows installation**](/doc/WInstallation.md) | +| Windows | See [**Windows installation**](/doc/Winstallation.md) | | Termux | `/data/data/com.termux/files/opt/voc` | `make install` updates `ldconfg` with the new library locations. @@ -95,7 +97,7 @@ For reference this will be: | Just `make full` | `export PATH="your-repository-clone/install/bin:$PATH"` | | `make install` on Linux | `export PATH="/opt/voc/bin:$PATH"` | | `make install` on BSD | `export PATH="/usr/local/share/voc/bin:$PATH"` | -| `make install` on Windows | See [**Windows installation**](/doc/WInstallation.md) | +| `make install` on Windows | See [**Windows installation**](/doc/Winstallation.md) | | `make install` on Termux | `export PATH="/data/data/com.termux/files/opt/voc/bin:$PATH"` | Also see [**Installation**](/doc/Installation.md). @@ -179,9 +181,9 @@ Most of the runtime in libVishapOberon is distributed under GPLv3 with runtime e ## Platform support and porting -Vishap Oberon supports 32 and 64 bit little-endian architectures including Intel x86 and x64, arm and ppc. +Vishap Oberon supports 32 and 64 bit little-endian architectures including Intel x86 and x86_64, 32 bit arm and aarch64. -It compiles under gcc, clang and Microsoft Visual C. +It compiles under gcc, clang, tcc and Microsoft Visual C. Installation supports GNU/Linux, MAC OSX, BSD and Windows (native and cygwin). @@ -245,9 +247,7 @@ Norayr Chilingarian forked ofront in 2013, porting extensive libraries from [ULM David Brown has worked on adding support for more platforms incuding windows using MSC, cygwin or mingw since January 2016. More recently he has generalised basic type support within the compiler to allow e.g. 64 bit LONGINT on 32 bit systems, and 32 bit LONGINT on 64 bit systems. -## Origin of the name "Ѵishap Oberon" - -#### Oberon +## Oberon Oberon is a programming language, an operating system and a graphical user interface. Originally designed and implemented by by Niklaus Wirth and @@ -266,7 +266,7 @@ of Einstein and Antoine de Saint-Exupéry: > when there is no longer anything to take away. (Antoine de Saint-Exupéry, > translated by Lewis Galantière.) -#### Ѵishap +## Origin of the name "Ѵishap Oberon" Vishaps are dragons inhabiting the Armenian Highlands. We decided to name the project “Vishap” because ties between compilers and dragons have ancient traditions. @@ -278,13 +278,13 @@ Also, Vishaps are known in tales, fiction. [This page](http://blog.fogus.me/2015 ###### Oberon - [The History of Modula-2 and Oberon](http://people.inf.ethz.ch/wirth/Articles/Modula-Oberon-June.pdf) - [The Programming Language Oberon](https://www.inf.ethz.ch/personal/wirth/Oberon/Oberon.Report.pdf) - - [Project Oberon: The Design of an Operating System and Compiler ](http://www.ethoberon.ethz.ch/WirthPubl/ProjectOberon.pdf) - - [Oberon - the Overlooked Jewel](http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.90.7173&rep=rep1&type=pdf) + - [Project Oberon: The Design of an Operating System and Compiler ](https://people.inf.ethz.ch/wirth/ProjectOberon1992.pdf) + - [Oberon - the Overlooked Jewel](http://pascal.hansotten.com/uploads/oberonpi/Oberon%20article.pdf) ###### Oberon 2 - - [Differences between Oberon and Oberon-2](http://members.home.nl/jmr272/Oberon/Oberon2.Differences.pdf) + - [Differences between Oberon and Oberon-2](https://citeseerx.ist.psu.edu/document?repid=rep1&type=pdf&doi=89e5bd3cf006bde4821599cdc57a37de5dc84bcd) - [The Programming Language Oberon-2](http://www.ssw.uni-linz.ac.at/Research/Papers/Oberon2.pdf) - - [Programming in Oberon. Steps beyond Pascal and Modula](http://www.ethoberon.ethz.ch/WirthPubl/ProgInOberonWR.pdf) + - [Programming in Oberon. Steps beyond Pascal and Modula](https://people.inf.ethz.ch/wirth/ProgInOberonWR.pdf) - [The Oakwood Guidelines for Oberon-2 Compiler Developers](http://www.math.bas.bg/bantchev/place/oberon/oakwood-guidelines.pdf) ###### Oberon 07 @@ -294,12 +294,12 @@ Also, Vishaps are known in tales, fiction. [This page](http://blog.fogus.me/2015 ###### Links - [Niklaus Wirth's personal page at ETH Zurich](https://www.inf.ethz.ch/personal/wirth/) - - [ETH Zurich's Wirth publications page](http://www.ethoberon.ethz.ch/WirthPubl/) - - [Joseph Templ's ofront on github](https://hithub.com/jtempl/ofront) + - [Selected articles by Niklaus Wirth](https://people.inf.ethz.ch/wirth/SelectedArticles.pdf) + - [ETH Oberon publications page](https://web.archive.org/web/20191207155011/http://www.ethoberon.ethz.ch/books.html) + - [Joseph Templ's ofront on github](https://github.com/jtempl/ofront) - [Software Templ OG](http://www.software-templ.com) - - [Oberon: Steps beyond Pascal and Modula](http://fruttenboel.verhoeven272.nl/Oberon/) ## History -See [**History**](/doc/History.md). \ No newline at end of file +See [**History**](/doc/History.md). diff --git a/bootstrap/SYSTEM.c b/bootstrap/SYSTEM.c index a1b2cb14..2952bb66 100644 --- a/bootstrap/SYSTEM.c +++ b/bootstrap/SYSTEM.c @@ -151,53 +151,61 @@ SYSTEM_PTR SYSTEM_NEWARR(ADDRESS *typ, ADDRESS elemsz, int elemalgn, int nofdim, return x; } - - - typedef void (*SystemSignalHandler)(INT32); // = Platform_SignalHandler #ifndef _WIN32 + // Unix signal handling + SystemSignalHandler handler[10] = {0}; // Adjust the array size to include signal 11 - SystemSignalHandler handler[3] = {0}; - - // Provide signal handling for Unix based systems + void segfaultHandler(int signal) { + __HALT(-10); + } + // Revised signal handler to accommodate additional signals like SIGSEGV void signalHandler(int s) { - if (s >= 2 && s <= 4) handler[s-2](s); - // (Ignore other signals) + if ((s >= 2 && s <= 4) || s == 11) { // Include SIGSEGV (usually signal 11) + if (handler[s-2]) { + handler[s-2](s); + } + } + // Ignore other signals } void SystemSetHandler(int s, ADDRESS h) { - if (s >= 2 && s <= 4) { + if ((s >= 2 && s <= 4) || s == 11) { int needtosetsystemhandler = handler[s-2] == 0; handler[s-2] = (SystemSignalHandler)h; - if (needtosetsystemhandler) {signal(s, signalHandler);} + if (needtosetsystemhandler) { + signal(s, signalHandler); + } } } -#else + void setupAutomaticSegfaultHandler() { + SystemSetHandler(11, (ADDRESS)segfaultHandler); // Register handler for SIGSEGV + } - // Provides Windows callback handlers for signal-like scenarios +#else + // Windows system remains as is since Windows does not use SIGSEGV in the same way #include "WindowsWrapper.h" SystemSignalHandler SystemInterruptHandler = 0; - SystemSignalHandler SystemQuitHandler = 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 + SystemInterruptHandler(2); // SIGINT return TRUE; } - } else { // Close, logoff or shutdown + } else { if (SystemQuitHandler) { - SystemQuitHandler(3); // SIGQUIT + SystemQuitHandler(3); // SIGQUIT return TRUE; } } return FALSE; } - void EnsureConsoleCtrlHandler() { if (!ConsoleCtrlHandlerSet) { SetConsoleCtrlHandler(SystemConsoleCtrlHandler, TRUE); @@ -216,3 +224,4 @@ typedef void (*SystemSignalHandler)(INT32); // = Platform_SignalHandler } #endif + diff --git a/bootstrap/SYSTEM.h b/bootstrap/SYSTEM.h index f6936068..39d594ed 100644 --- a/bootstrap/SYSTEM.h +++ b/bootstrap/SYSTEM.h @@ -19,7 +19,11 @@ typedef unsigned long size_t; #endif #else - typedef unsigned int size_t; + #if defined(__OpenBSD__) + typedef unsigned long size_t; + #else + typedef unsigned int size_t; + #endif #endif #define _SIZE_T_DECLARED // For FreeBSD @@ -112,9 +116,11 @@ extern void Modules_AssertFail(INT32 x); // Index checking -static inline INT64 __XF(UINT64 i, UINT64 ub) {if (i >= ub) {__HALT(-2);} return i;} -#define __X(i, ub) (((i)<(ub))?i:(__HALT(-2),0)) - +static inline INT64 __XF(INT64 i, UINT64 ub) { + if (i < 0 || (UINT64)i >= ub) __HALT(-2); + return i; +} +#define __X(i, ub) (((i) >= 0 && (i) < (ub)) ? (i) : (__HALT(-2),0)) // Range checking, and checked SHORT and CHR functions @@ -261,7 +267,12 @@ extern void Heap_INCREF(); extern void Modules_Init(INT32 argc, ADDRESS argv); extern void Heap_FINALL(); +extern void setupAutomaticSegfaultHandler(); +#ifndef _WIN32 +#define __INIT(argc, argv) static void *m; setupAutomaticSegfaultHandler(); Modules_Init(argc, (ADDRESS)&argv); +#else #define __INIT(argc, argv) static void *m; Modules_Init(argc, (ADDRESS)&argv); +#endif #define __REGMAIN(name, enum) m = Heap_REGMOD((CHAR*)name,enum) #define __FINI Heap_FINALL(); return 0 diff --git a/bootstrap/unix-44/Compiler.c b/bootstrap/unix-44/Compiler.c index 993c2bac..4460479d 100644 --- a/bootstrap/unix-44/Compiler.c +++ b/bootstrap/unix-44/Compiler.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspamS */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspamS */ #define SHORTINT INT8 #define INTEGER INT16 @@ -89,7 +89,7 @@ static void Compiler_PropagateElementaryTypeSizes (void) OPT_sintobj->typ = OPT_sinttyp; OPT_intobj->typ = OPT_inttyp; OPT_lintobj->typ = OPT_linttyp; - switch (OPM_LongintSize) { + switch (OPM_SetSize) { case 4: OPT_settyp = OPT_set32typ; break; diff --git a/bootstrap/unix-44/Configuration.c b/bootstrap/unix-44/Configuration.c index 80b87b1d..fa87c9de 100644 --- a/bootstrap/unix-44/Configuration.c +++ b/bootstrap/unix-44/Configuration.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -8,7 +8,7 @@ #include "SYSTEM.h" -export CHAR Configuration_versionLong[75]; +export CHAR Configuration_versionLong[76]; @@ -19,6 +19,6 @@ export void *Configuration__init(void) __DEFMOD; __REGMOD("Configuration", 0); /* BEGIN */ - __MOVE("2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75); + __MOVE("2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 76); __ENDMOD; } diff --git a/bootstrap/unix-44/Configuration.h b/bootstrap/unix-44/Configuration.h index cdc285e5..c3c54eed 100644 --- a/bootstrap/unix-44/Configuration.h +++ b/bootstrap/unix-44/Configuration.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Configuration__h #define Configuration__h @@ -6,7 +6,7 @@ #include "SYSTEM.h" -import CHAR Configuration_versionLong[75]; +import CHAR Configuration_versionLong[76]; import void *Configuration__init(void); diff --git a/bootstrap/unix-44/Files.c b/bootstrap/unix-44/Files.c index cd6f14b9..54341368 100644 --- a/bootstrap/unix-44/Files.c +++ b/bootstrap/unix-44/Files.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -26,7 +26,7 @@ typedef Files_BufDesc *Files_Buffer; typedef - CHAR Files_FileName[101]; + CHAR Files_FileName[256]; typedef struct Files_FileDesc { @@ -48,6 +48,7 @@ typedef } Files_Rider; +export INT16 Files_MaxPathLength, Files_MaxNameLength; static Files_FileDesc *Files_files; static INT16 Files_tempno; static CHAR Files_HOME[1024]; @@ -85,6 +86,7 @@ export INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ); export void Files_Purge (Files_File f); export void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); export void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x); +export void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n); export void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x); export void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x); @@ -129,17 +131,17 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode) Out_String((CHAR*)": ", 3); if (f != NIL) { if (f->registerName[0] != 0x00) { - Out_String(f->registerName, 101); + Out_String(f->registerName, 256); } else { - Out_String(f->workName, 101); + Out_String(f->workName, 256); } if (f->fd != 0) { - Out_String((CHAR*)"f.fd = ", 8); + Out_String((CHAR*)", f.fd = ", 10); Out_Int(f->fd, 1); } } if (errcode != 0) { - Out_String((CHAR*)" errcode = ", 12); + Out_String((CHAR*)", errcode = ", 13); Out_Int(errcode, 1); } Out_Ln(); @@ -149,76 +151,75 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode) static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len) { - INT16 i, j; + INT16 i, j, ld, ln; __DUP(dir, dir__len, CHAR); __DUP(name, name__len, CHAR); + ld = Strings_Length(dir, dir__len); + ln = Strings_Length(name, name__len); + while ((ld > 0 && dir[__X(ld - 1, dir__len)] == '/')) { + ld -= 1; + } + if (((ld + ln) + 2) > dest__len) { + Files_Err((CHAR*)"File name too long", 19, NIL, 0); + } i = 0; + while (i < ld) { + dest[__X(i, dest__len)] = dir[__X(i, dir__len)]; + i += 1; + } + if (i > 0) { + dest[__X(i, dest__len)] = '/'; + i += 1; + } 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]; + while (j < ln) { + dest[__X(i, dest__len)] = name[__X(j, name__len)]; i += 1; j += 1; } - dest[i] = 0x00; + dest[__X(i, dest__len)] = 0x00; __DEL(dir); __DEL(name); } static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len) { - INT32 n, i, j; + INT16 i, n; __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; - } + if (finalName[0] == '/') { + __COPY(finalName, name, name__len); + } else { + Files_MakeFileName(Platform_CWD, 256, finalName, finalName__len, (void*)name, name__len); } - j = 0; - while (finalName[j] != 0x00) { - name[i] = finalName[j]; - i += 1; - j += 1; - } - i -= 1; - while (name[i] != '/') { + i = Strings_Length(name, name__len) - 1; + while ((i > 0 && name[__X(i, name__len)] != '/')) { i -= 1; } - name[i + 1] = '.'; - name[i + 2] = 't'; - name[i + 3] = 'm'; - name[i + 4] = 'p'; - name[i + 5] = '.'; + if ((i + 16) >= name__len) { + Files_Err((CHAR*)"File name too long", 19, NIL, 0); + } + Files_tempno += 1; + n = Files_tempno; + name[__X(i + 1, name__len)] = '.'; + name[__X(i + 2, name__len)] = 't'; + name[__X(i + 3, name__len)] = 'm'; + name[__X(i + 4, name__len)] = 'p'; + name[__X(i + 5, name__len)] = '.'; i += 6; while (n > 0) { - name[i] = (CHAR)((int)__MOD(n, 10) + 48); + name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48); n = __DIV(n, 10); i += 1; } - name[i] = '.'; + name[__X(i, name__len)] = '.'; i += 1; n = Platform_PID; while (n > 0) { - name[i] = (CHAR)((int)__MOD(n, 10) + 48); + name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48); n = __DIV(n, 10); i += 1; } - name[i] = 0x00; + name[__X(i, name__len)] = 0x00; __DEL(finalName); } @@ -236,11 +237,11 @@ static void Files_Deregister (CHAR *name, ADDRESS name__len) if (osfile != NIL) { __ASSERT(!osfile->tempFile, 0); __ASSERT(osfile->fd >= 0, 0); - __MOVE(osfile->workName, osfile->registerName, 101); - Files_GetTempName(osfile->registerName, 101, (void*)osfile->workName, 101); + __MOVE(osfile->workName, osfile->registerName, 256); + Files_GetTempName(osfile->registerName, 256, (void*)osfile->workName, 256); osfile->tempFile = 1; osfile->state = 0; - error = Platform_Rename((void*)osfile->registerName, 101, (void*)osfile->workName, 101); + error = Platform_Rename((void*)osfile->registerName, 256, (void*)osfile->workName, 256); if (error != 0) { Files_Err((CHAR*)"Couldn't rename previous version of file being registered", 58, osfile, error); } @@ -256,17 +257,17 @@ static void Files_Create (Files_File f) CHAR err[32]; if (f->fd == -1) { if (f->state == 1) { - Files_GetTempName(f->registerName, 101, (void*)f->workName, 101); + Files_GetTempName(f->registerName, 256, (void*)f->workName, 256); f->tempFile = 1; } else { __ASSERT(f->state == 2, 0); - Files_Deregister(f->registerName, 101); - __MOVE(f->registerName, f->workName, 101); + Files_Deregister(f->registerName, 256); + __MOVE(f->registerName, f->workName, 256); f->registerName[0] = 0x00; f->tempFile = 0; } - error = Platform_Unlink((void*)f->workName, 101); - error = Platform_New((void*)f->workName, 101, &f->fd); + error = Platform_Unlink((void*)f->workName, 256); + error = Platform_New((void*)f->workName, 256, &f->fd); done = error == 0; if (done) { f->next = Files_files; @@ -319,8 +320,8 @@ void Files_Close (Files_File f) 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]); + while ((i < 4 && f->bufs[__X(i, 4)] != NIL)) { + Files_Flush(f->bufs[__X(i, 4)]); i += 1; } } @@ -337,7 +338,7 @@ Files_File Files_New (CHAR *name, ADDRESS name__len) __DUP(name, name__len, CHAR); __NEW(f, Files_FileDesc); f->workName[0] = 0x00; - __COPY(name, f->registerName, 101); + __COPY(name, f->registerName, 256); f->fd = -1; f->state = 1; f->len = 0; @@ -359,35 +360,35 @@ static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len) *pos += 1; } } else { - ch = (Files_SearchPath->data)[*pos]; + ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])]; while (ch == ' ' || ch == ';') { *pos += 1; - ch = (Files_SearchPath->data)[*pos]; + ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])]; } if (ch == '~') { *pos += 1; - ch = (Files_SearchPath->data)[*pos]; - while (Files_HOME[i] != 0x00) { - dir[i] = Files_HOME[i]; + ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])]; + while (Files_HOME[__X(i, 1024)] != 0x00) { + dir[__X(i, dir__len)] = Files_HOME[__X(i, 1024)]; i += 1; } if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) { - while ((i > 0 && dir[i - 1] != '/')) { + while ((i > 0 && dir[__X(i - 1, dir__len)] != '/')) { i -= 1; } } } while ((ch != 0x00 && ch != ';')) { - dir[i] = ch; + dir[__X(i, dir__len)] = ch; i += 1; *pos += 1; - ch = (Files_SearchPath->data)[*pos]; + ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])]; } - while ((i > 0 && dir[i - 1] == ' ')) { + while ((i > 0 && dir[__X(i - 1, dir__len)] == ' ')) { i -= 1; } } - dir[i] = 0x00; + dir[__X(i, dir__len)] = 0x00; } static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len) @@ -398,7 +399,7 @@ static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len) ch = name[0]; while ((ch != 0x00 && ch != '/')) { i += 1; - ch = name[i]; + ch = name[__X(i, name__len)]; } return ch == '/'; } @@ -413,9 +414,9 @@ static Files_File Files_CacheEntry (Platform_FileIdentity 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; + if (f->bufs[__X(i, 4)] != NIL) { + f->bufs[__X(i, 4)]->org = -1; + f->bufs[__X(i, 4)] = NIL; } i += 1; } @@ -482,7 +483,7 @@ Files_File Files_Old (CHAR *name, ADDRESS name__len) f->pos = 0; f->swapper = -1; error = Platform_Size(fd, &f->len); - __COPY(name, f->workName, 101); + __COPY(name, f->workName, 256); f->registerName[0] = 0x00; f->tempFile = 0; f->identity = identity; @@ -514,9 +515,9 @@ void Files_Purge (Files_File f) INT16 error; i = 0; while (i < 4) { - if (f->bufs[i] != NIL) { - f->bufs[i]->org = -1; - f->bufs[i] = NIL; + if (f->bufs[__X(i, 4)] != NIL) { + f->bufs[__X(i, 4)]->org = -1; + f->bufs[__X(i, 4)] = NIL; } i += 1; } @@ -560,22 +561,22 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos) offset = __MASK(pos, -4096); org = pos - offset; i = 0; - while ((((i < 4 && f->bufs[i] != NIL)) && org != f->bufs[i]->org)) { + while ((((i < 4 && f->bufs[__X(i, 4)] != NIL)) && org != f->bufs[__X(i, 4)]->org)) { i += 1; } if (i < 4) { - if (f->bufs[i] == NIL) { + if (f->bufs[__X(i, 4)] == NIL) { __NEW(buf, Files_BufDesc); buf->chg = 0; buf->org = -1; buf->f = f; - f->bufs[i] = buf; + f->bufs[__X(i, 4)] = buf; } else { - buf = f->bufs[i]; + buf = f->bufs[__X(i, 4)]; } } else { f->swapper = __MASK(f->swapper + 1, -4); - buf = f->bufs[f->swapper]; + buf = f->bufs[__X(f->swapper, 4)]; Files_Flush(buf); } if (buf->org != org) { @@ -622,7 +623,7 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x) } Files_Assert(offset <= buf->size); if (offset < buf->size) { - *x = buf->data[offset]; + *x = buf->data[__X(offset, 4096)]; (*r).offset = offset + 1; } else if ((*r).org + offset < buf->f->len) { Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset); @@ -634,6 +635,11 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x) } } +void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x) +{ + Files_Read(&*r, r__typ, &*x); +} + void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n) { INT32 xpos, min, restInBuf, offset; @@ -660,7 +666,7 @@ void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x } else { min = n; } - __MOVE((ADDRESS)&buf->data[offset], (ADDRESS)&x[xpos], min); + __MOVE((ADDRESS)&buf->data[__X(offset, 4096)], (ADDRESS)&x[__X(xpos, x__len)], min); offset += min; (*r).offset = offset; xpos += min; @@ -689,7 +695,7 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x) offset = (*r).offset; } Files_Assert(offset < 4096); - buf->data[offset] = x; + buf->data[__X(offset, 4096)] = x; buf->chg = 1; if (offset == buf->size) { buf->size += 1; @@ -723,7 +729,7 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS } else { min = n; } - __MOVE((ADDRESS)&x[xpos], (ADDRESS)&buf->data[offset], min); + __MOVE((ADDRESS)&x[__X(xpos, x__len)], (ADDRESS)&buf->data[__X(offset, 4096)], min); offset += min; (*r).offset = offset; Files_Assert(offset <= 4096); @@ -817,12 +823,12 @@ void Files_Register (Files_File f) } Files_Close(f); if (f->registerName[0] != 0x00) { - Files_Deregister(f->registerName, 101); - Files_Rename(f->workName, 101, f->registerName, 101, &errcode); + Files_Deregister(f->registerName, 256); + Files_Rename(f->workName, 256, f->registerName, 256, &errcode); if (errcode != 0) { Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode); } - __MOVE(f->registerName, f->workName, 101); + __MOVE(f->registerName, f->workName, 256); f->registerName[0] = 0x00; f->tempFile = 0; } @@ -843,7 +849,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *de j = 0; while (i > 0) { i -= 1; - dest[j] = src[i]; + dest[__X(j, dest__len)] = src[__X(i, src__len)]; j += 1; } } else { @@ -900,7 +906,7 @@ void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len) i = 0; do { Files_Read(&*R, R__typ, (void*)&ch); - x[i] = ch; + x[__X(i, x__len)] = ch; i += 1; } while (!(ch == 0x00)); } @@ -910,16 +916,16 @@ void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len) INT16 i; i = 0; do { - Files_Read(&*R, R__typ, (void*)&x[i]); + Files_Read(&*R, R__typ, (void*)&x[__X(i, x__len)]); i += 1; - } while (!(x[i - 1] == 0x00 || x[i - 1] == 0x0a)); - if (x[i - 1] == 0x0a) { + } while (!(x[__X(i - 1, x__len)] == 0x00 || x[__X(i - 1, x__len)] == 0x0a)); + if (x[__X(i - 1, x__len)] == 0x0a) { i -= 1; } - if ((i > 0 && x[i - 1] == 0x0d)) { + if ((i > 0 && x[__X(i - 1, x__len)] == 0x0d)) { i -= 1; } - x[i] = 0x00; + x[__X(i, x__len)] = 0x00; } void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len) @@ -947,18 +953,18 @@ void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x) void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x) { CHAR b[2]; - b[0] = (CHAR)x; - b[1] = (CHAR)__ASHR(x, 8); + b[0] = __CHR(x); + b[1] = __CHR(__ASHR(x, 8)); Files_WriteBytes(&*R, R__typ, (void*)b, 2, 2); } void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 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); + b[0] = __CHR(x); + b[1] = __CHR(__ASHR(x, 8)); + b[2] = __CHR(__ASHR(x, 16)); + b[3] = __CHR(__ASHR(x, 24)); Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4); } @@ -966,11 +972,13 @@ void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x) { CHAR b[4]; INT32 i; - i = (INT32)x; - b[0] = (CHAR)i; - b[1] = (CHAR)__ASHR(i, 8); - b[2] = (CHAR)__ASHR(i, 16); - b[3] = (CHAR)__ASHR(i, 24); + UINT64 y; + y = x; + i = __VAL(INT32, y); + b[0] = __CHR(i); + b[1] = __CHR(__ASHR(i, 8)); + b[2] = __CHR(__ASHR(i, 16)); + b[3] = __CHR(__ASHR(i, 24)); Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4); } @@ -992,7 +1000,7 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len { INT16 i; i = 0; - while (x[i] != 0x00) { + while (x[__X(i, x__len)] != 0x00) { i += 1; } Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1); @@ -1001,10 +1009,10 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x) { while (x < -64 || x > 63) { - Files_Write(&*R, R__typ, (CHAR)(__MASK(x, -128) + 128)); + Files_Write(&*R, R__typ, __CHR(__MASK(x, -128) + 128)); x = __ASHR(x, 7); } - Files_Write(&*R, R__typ, (CHAR)__MASK(x, -128)); + Files_Write(&*R, R__typ, __CHR(__MASK(x, -128))); } void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len) @@ -1041,7 +1049,7 @@ static void Files_Finalize (SYSTEM_PTR o) if (f->fd >= 0) { Files_CloseOSFile(f); if (f->tempFile) { - res = Platform_Unlink((void*)f->workName, 101); + res = Platform_Unlink((void*)f->workName, 256); } } } @@ -1063,7 +1071,7 @@ static void EnumPtrs(void (*P)(void*)) P(Files_SearchPath); } -__TDESC(Files_FileDesc, 1, 4) = {__TDFLDS("FileDesc", 252), {228, 232, 236, 240, -20}}; +__TDESC(Files_FileDesc, 1, 4) = {__TDFLDS("FileDesc", 564), {540, 544, 548, 552, -20}}; __TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4112), {0, -8}}; __TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 20), {8, -8}}; @@ -1083,5 +1091,7 @@ export void *Files__init(void) Heap_FileCount = 0; Files_HOME[0] = 0x00; Platform_GetEnv((CHAR*)"HOME", 5, (void*)Files_HOME, 1024); + Files_MaxPathLength = Platform_MaxPathLength(); + Files_MaxNameLength = Platform_MaxNameLength(); __ENDMOD; } diff --git a/bootstrap/unix-44/Files.h b/bootstrap/unix-44/Files.h index 62563e24..ccdabcc2 100644 --- a/bootstrap/unix-44/Files.h +++ b/bootstrap/unix-44/Files.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Files__h #define Files__h @@ -11,7 +11,7 @@ typedef typedef struct Files_FileDesc { INT32 _prvt0; - char _prvt1[248]; + char _prvt1[560]; } Files_FileDesc; typedef @@ -22,6 +22,7 @@ typedef } Files_Rider; +import INT16 Files_MaxPathLength, Files_MaxNameLength; import ADDRESS *Files_FileDesc__typ; import ADDRESS *Files_Rider__typ; @@ -39,6 +40,7 @@ import INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ); import void Files_Purge (Files_File f); import void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); import void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x); +import void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); import void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n); import void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x); import void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x); diff --git a/bootstrap/unix-44/Heap.c b/bootstrap/unix-44/Heap.c index c12cb722..42552415 100644 --- a/bootstrap/unix-44/Heap.c +++ b/bootstrap/unix-44/Heap.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tsSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -68,9 +68,10 @@ static INT32 Heap_freeList[10]; static INT32 Heap_bigBlocks; export INT32 Heap_allocated; static BOOLEAN Heap_firstTry; +static INT16 Heap_ldUnit; export INT32 Heap_heap; static INT32 Heap_heapMin, Heap_heapMax; -export INT32 Heap_heapsize; +export INT32 Heap_heapsize, Heap_heapMinExpand; static Heap_FinNode Heap_fin; static INT16 Heap_lockdepth; static BOOLEAN Heap_interrupted; @@ -228,10 +229,10 @@ static INT32 Heap_NewChunk (INT32 blksz) static void Heap_ExtendHeap (INT32 blksz) { INT32 size, chnk, j, next; - if (Heap_uLT(160000, blksz)) { + if (Heap_uLT(Heap_heapMinExpand, blksz)) { size = blksz; } else { - size = 160000; + size = Heap_heapMinExpand; } chnk = Heap_NewChunk(size); if (chnk != 0) { @@ -248,6 +249,8 @@ static void Heap_ExtendHeap (INT32 blksz) __PUT(chnk, next, INT32); __PUT(j, chnk, INT32); } + } else if (!Heap_firstTry) { + Heap_heapMinExpand = 16; } } @@ -257,16 +260,16 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag) SYSTEM_PTR new; Heap_Lock(); __GET(tag, blksz, INT32); - i0 = __ASHR(blksz, 4); + i0 = __LSH(blksz, -Heap_ldUnit, 32); i = i0; - if (Heap_uLT(i, 9)) { + if (i < 9) { adr = Heap_freeList[i]; while (adr == 0) { i += 1; adr = Heap_freeList[i]; } } - if (Heap_uLT(i, 9)) { + if (i < 9) { __GET(adr + 12, next, INT32); Heap_freeList[i] = next; if (i != i0) { @@ -289,16 +292,17 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag) if (Heap_firstTry) { Heap_GC(1); blksz += 16; - if (Heap_uLT(Heap_heapsize - Heap_allocated, blksz) || Heap_uLT(__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2), Heap_heapsize)) { - Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize); + t = __LSH(Heap_allocated + blksz, -(2 + Heap_ldUnit), 32) * 80; + if (Heap_uLT(Heap_heapsize, t)) { + Heap_ExtendHeap(t - 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); + Heap_ExtendHeap(blksz); new = Heap_NEWREC(tag); } + Heap_firstTry = 1; Heap_Unlock(); return new; } else { @@ -443,7 +447,7 @@ static void Heap_Scan (void) __PUT(start, start + 4, INT32); __PUT(start + 4, freesize, INT32); __PUT(start + 8, -4, INT32); - i = __ASHR(freesize, 4); + i = __LSH(freesize, -Heap_ldUnit, 32); freesize = 0; if (Heap_uLT(i, 9)) { __PUT(start + 12, Heap_freeList[i], INT32); @@ -469,7 +473,7 @@ static void Heap_Scan (void) __PUT(start, start + 4, INT32); __PUT(start + 4, freesize, INT32); __PUT(start + 8, -4, INT32); - i = __ASHR(freesize, 4); + i = __LSH(freesize, -Heap_ldUnit, 32); freesize = 0; if (Heap_uLT(i, 9)) { __PUT(start + 12, Heap_freeList[i], INT32); @@ -661,79 +665,77 @@ void Heap_GC (BOOLEAN markStack) Heap_Module m; INT32 i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23; INT32 cand[10000]; - if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) { - Heap_Lock(); - m = (Heap_Module)(ADDRESS)Heap_modules; - while (m != NIL) { - if (m->enumPtrs != NIL) { - (*m->enumPtrs)(Heap_MarkP); - } - m = m->next; + Heap_Lock(); + m = (Heap_Module)(ADDRESS)Heap_modules; + while (m != NIL) { + if (m->enumPtrs != NIL) { + (*m->enumPtrs)(Heap_MarkP); } - 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(32, (void*)cand, 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(); + 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(32, (void*)cand, 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) @@ -756,6 +758,8 @@ void Heap_InitHeap (void) Heap_heapMin = -1; Heap_heapMax = 0; Heap_bigBlocks = 0; + Heap_heapMinExpand = 128000; + Heap_ldUnit = 4; Heap_heap = Heap_NewChunk(128000); __PUT(Heap_heap, 0, INT32); Heap_firstTry = 1; diff --git a/bootstrap/unix-44/Heap.h b/bootstrap/unix-44/Heap.h index de4d17ce..3cde1c3b 100644 --- a/bootstrap/unix-44/Heap.h +++ b/bootstrap/unix-44/Heap.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tsSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */ #ifndef Heap__h #define Heap__h @@ -48,7 +48,7 @@ typedef import SYSTEM_PTR Heap_modules; import INT32 Heap_allocated; import INT32 Heap_heap; -import INT32 Heap_heapsize; +import INT32 Heap_heapsize, Heap_heapMinExpand; import INT16 Heap_FileCount; import ADDRESS *Heap_ModuleDesc__typ; diff --git a/bootstrap/unix-44/Modules.c b/bootstrap/unix-44/Modules.c index f397649b..535721e8 100644 --- a/bootstrap/unix-44/Modules.c +++ b/bootstrap/unix-44/Modules.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -404,7 +404,7 @@ static void Modules_errint (INT32 l) if (l >= 10) { Modules_errint(__DIV(l, 10)); } - Modules_errch((CHAR)((int)__MOD(l, 10) + 48)); + Modules_errch(__CHR((int)__MOD(l, 10) + 48)); } static void Modules_DisplayHaltCode (INT32 code) diff --git a/bootstrap/unix-44/Modules.h b/bootstrap/unix-44/Modules.h index 8436f089..26d86b38 100644 --- a/bootstrap/unix-44/Modules.h +++ b/bootstrap/unix-44/Modules.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Modules__h #define Modules__h diff --git a/bootstrap/unix-44/OPB.c b/bootstrap/unix-44/OPB.c index 19e40505..913fbf2d 100644 --- a/bootstrap/unix-44/OPB.c +++ b/bootstrap/unix-44/OPB.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -261,7 +261,7 @@ static void OPB_CharToString (OPT_Node n) { CHAR ch; n->typ = OPT_stringtyp; - ch = (CHAR)n->conval->intval; + ch = __CHR(n->conval->intval); n->conval->ext = OPT_NewExt(); if (ch == 0x00) { n->conval->intval2 = 1; @@ -597,7 +597,7 @@ void OPB_MOp (INT8 op, OPT_Node *x) case 22: if (f == 3) { if (z->class == 7) { - z->conval->intval = (INT16)__CAP((CHAR)z->conval->intval); + z->conval->intval = (INT16)__CAP(__CHR(z->conval->intval)); z->obj = NIL; } else { z = NewOp__29(op, typ, z); @@ -1136,7 +1136,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ) OPB_err(203); r = (LONGREAL)1; } - (*x)->conval->intval = (INT32)__ENTIER(r); + (*x)->conval->intval = __SHORT(__ENTIER(r), 2147483648LL); OPB_SetIntType(*x); } } @@ -1626,6 +1626,7 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode) if (x == y) { } else if ((((y->comp == 2 && y->BaseTyp == x->BaseTyp)) && y->n <= x->n)) { } else if ((y->comp == 3 && y->BaseTyp == x->BaseTyp)) { + OPB_err(113); } else if (x->BaseTyp == OPT_chartyp) { if (g == 8) { if (ynode->conval->intval2 > x->n) { diff --git a/bootstrap/unix-44/OPB.h b/bootstrap/unix-44/OPB.h index 71d82def..f66fcd66 100644 --- a/bootstrap/unix-44/OPB.h +++ b/bootstrap/unix-44/OPB.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPB__h #define OPB__h diff --git a/bootstrap/unix-44/OPC.c b/bootstrap/unix-44/OPC.c index a5f41a8e..7b92ccc1 100644 --- a/bootstrap/unix-44/OPC.c +++ b/bootstrap/unix-44/OPC.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -618,31 +618,33 @@ 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 __", 11); - OPC_Ident(obj); - OPC_DeclareParams(obj->link, 1); - OPM_WriteString((CHAR*)" __SEND(", 9); - if (obj->link->typ->form == 11) { - OPM_WriteString((CHAR*)"__TYPEOF(", 10); - OPC_Ident(obj->link); + if ((obj->mode == 13 && obj == OPC_BaseTProc(obj))) { + if (OPM_currFile == 1 || (OPM_currFile == 0 && obj->vis == 1)) { + OPM_WriteString((CHAR*)"#define __", 11); + OPC_Ident(obj); + OPC_DeclareParams(obj->link, 1); + OPM_WriteString((CHAR*)" __SEND(", 9); + if (obj->link->typ->form == 11) { + OPM_WriteString((CHAR*)"__TYPEOF(", 10); + OPC_Ident(obj->link); + OPM_Write(')'); + } else { + OPC_Ident(obj->link); + OPM_WriteString((CHAR*)"__typ", 6); + } + OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16)); + if (obj->typ == OPT_notyp) { + OPM_WriteString((CHAR*)"void", 5); + } else { + OPC_Ident(obj->typ->strobj); + } + OPM_WriteString((CHAR*)"(*)", 4); + OPC_AnsiParamList(obj->link, 0); + OPM_WriteString((CHAR*)", ", 3); + OPC_DeclareParams(obj->link, 1); OPM_Write(')'); - } else { - OPC_Ident(obj->link); - OPM_WriteString((CHAR*)"__typ", 6); + OPM_WriteLn(); } - OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16)); - if (obj->typ == OPT_notyp) { - OPM_WriteString((CHAR*)"void", 5); - } else { - OPC_Ident(obj->typ->strobj); - } - OPM_WriteString((CHAR*)"(*)", 4); - OPC_AnsiParamList(obj->link, 0); - OPM_WriteString((CHAR*)", ", 3); - OPC_DeclareParams(obj->link, 1); - OPM_Write(')'); - OPM_WriteLn(); } OPC_DefineTProcMacros(obj->right, &*empty); } @@ -652,7 +654,7 @@ static void OPC_DefineType (OPT_Struct str) { OPT_Object obj = NIL, field = NIL, par = NIL; BOOLEAN empty; - if (OPM_currFile == 1 || str->ref < 255) { + if ((OPM_currFile == 1 || str->ref < 255) || (((OPM_currFile == 0 && str->strobj != NIL)) && str->strobj->vis == 1)) { obj = str->strobj; if (obj == NIL || OPC_Undefined(obj)) { if (obj != NIL) { @@ -681,6 +683,10 @@ static void OPC_DefineType (OPT_Struct str) OPC_DefineType(str->BaseTyp); } } else if (__IN(str->comp, 0x0c, 32)) { + if ((str->BaseTyp->strobj != NIL && str->BaseTyp->strobj->linkadr == 1)) { + OPM_Mark(244, str->txtpos); + str->BaseTyp->strobj->linkadr = 2; + } OPC_DefineType(str->BaseTyp); } else if (str->form == 12) { if (str->BaseTyp != OPT_notyp) { @@ -715,6 +721,13 @@ static void OPC_DefineType (OPT_Struct str) if (!empty) { OPM_WriteLn(); } + } else if ((obj->typ->form == 11 && obj->typ->BaseTyp->comp == 4)) { + empty = 1; + OPC_DeclareTProcs(obj->typ->BaseTyp->link, &empty); + OPC_DefineTProcMacros(obj->typ->BaseTyp->link, &empty); + if (!empty) { + OPM_WriteLn(); + } } } } @@ -1138,7 +1151,7 @@ static void OPC_GenHeaderMsg (void) OPM_WriteString((CHAR*)"/* ", 4); OPM_WriteString((CHAR*)"voc", 4); OPM_Write(' '); - OPM_WriteString(Configuration_versionLong, 75); + OPM_WriteString(Configuration_versionLong, 76); OPM_Write(' '); i = 0; while (i <= 31) { @@ -1739,7 +1752,7 @@ static void OPC_CharacterLiteral (INT64 c) if ((c == 92 || c == 39) || c == 63) { OPM_Write('\\'); } - OPM_Write((CHAR)c); + OPM_Write(__CHR(c)); OPM_Write('\''); } } @@ -1755,16 +1768,16 @@ static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l) c = (INT16)s[__X(i, s__len)]; if (c < 32 || c > 126) { OPM_Write('\\'); - OPM_Write((CHAR)(48 + __ASHR(c, 6))); + OPM_Write(__CHR(48 + __ASHR(c, 6))); c = __MASK(c, -64); - OPM_Write((CHAR)(48 + __ASHR(c, 3))); + OPM_Write(__CHR(48 + __ASHR(c, 3))); c = __MASK(c, -8); - OPM_Write((CHAR)(48 + c)); + OPM_Write(__CHR(48 + c)); } else { if ((c == 92 || c == 34) || c == 63) { OPM_Write('\\'); } - OPM_Write((CHAR)c); + OPM_Write(__CHR(c)); } i += 1; } @@ -1830,6 +1843,12 @@ void OPC_IntLiteral (INT64 n, INT32 size) void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim) { + INT64 d; + d = dim; + while (d > 0) { + array = array->BaseTyp; + d -= 1; + } if (array->comp == 3) { OPC_CompleteIdent(obj); OPM_WriteString((CHAR*)"__len", 6); @@ -1837,10 +1856,6 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim) OPM_WriteInt(dim); } } else { - while (dim > 0) { - array = array->BaseTyp; - dim -= 1; - } OPM_WriteInt(array->n); } } diff --git a/bootstrap/unix-44/OPC.h b/bootstrap/unix-44/OPC.h index 38a2b01d..3bfd88b8 100644 --- a/bootstrap/unix-44/OPC.h +++ b/bootstrap/unix-44/OPC.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPC__h #define OPC__h diff --git a/bootstrap/unix-44/OPM.c b/bootstrap/unix-44/OPM.c index 8f903e46..bcb39247 100644 --- a/bootstrap/unix-44/OPM.c +++ b/bootstrap/unix-44/OPM.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -19,6 +19,8 @@ typedef CHAR OPM_FileName[32]; +static CHAR OPM_currentComment[256]; +static BOOLEAN OPM_hasComment; static CHAR OPM_SourceFileName[256]; static CHAR OPM_GlobalModel[10]; export CHAR OPM_Model[10]; @@ -27,7 +29,7 @@ export INT16 OPM_AddressSize; static INT16 OPM_GlobalAlignment; export INT16 OPM_Alignment; export UINT32 OPM_GlobalOptions, OPM_Options; -export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; +export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize; export INT64 OPM_MaxIndex; export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; export BOOLEAN OPM_noerr; @@ -59,6 +61,7 @@ static void OPM_FindInstallDir (void); static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos); static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len); export void OPM_Get (CHAR *ch); +export void OPM_GetComment (CHAR *text, ADDRESS text__len); export void OPM_Init (BOOLEAN *done); export void OPM_InitOptions (void); export INT16 OPM_Integer (INT64 n); @@ -82,6 +85,7 @@ static void OPM_ScanOptions (CHAR *s, ADDRESS s__len); static void OPM_ShowLine (INT64 pos); export INT64 OPM_SignedMaximum (INT32 bytecount); export INT64 OPM_SignedMinimum (INT32 bytecount); +export void OPM_StoreComment (CHAR *text, ADDRESS text__len); export void OPM_SymRCh (CHAR *ch); export INT32 OPM_SymRInt (void); export INT64 OPM_SymRInt64 (void); @@ -157,6 +161,36 @@ void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len) __DEL(modname); } +void OPM_StoreComment (CHAR *text, ADDRESS text__len) +{ + INT16 i; + __DUP(text, text__len, CHAR); + i = 0; + while ((i < 255 && text[__X(i, text__len)] != 0x00)) { + OPM_currentComment[__X(i, 256)] = text[__X(i, text__len)]; + i += 1; + } + OPM_currentComment[__X(i, 256)] = 0x00; + OPM_hasComment = 1; + __DEL(text); +} + +void OPM_GetComment (CHAR *text, ADDRESS text__len) +{ + INT16 i; + if (OPM_hasComment) { + i = 0; + while ((((i < text__len && i < 256)) && OPM_currentComment[__X(i, 256)] != 0x00)) { + text[__X(i, text__len)] = OPM_currentComment[__X(i, 256)]; + i += 1; + } + text[__X(i, text__len)] = 0x00; + OPM_hasComment = 0; + } else { + text[0] = 0x00; + } +} + INT64 OPM_SignedMaximum (INT32 bytecount) { INT64 result; @@ -272,7 +306,7 @@ BOOLEAN OPM_OpenPar (void) if (Modules_ArgCount == 1) { OPM_LogWLn(); OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20); - OPM_LogWStr(Configuration_versionLong, 75); + OPM_LogWStr(Configuration_versionLong, 76); OPM_LogW('.'); OPM_LogWLn(); OPM_LogWStr((CHAR*)"Based on Ofront by J. Templ and Software Templ OEG.", 52); @@ -338,7 +372,7 @@ BOOLEAN OPM_OpenPar (void) OPM_LogWLn(); OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95); OPM_LogWLn(); - OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); + OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER and SET, 64 bit LONGINT.", 95); OPM_LogWLn(); OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); OPM_LogWLn(); @@ -410,21 +444,25 @@ void OPM_InitOptions (void) OPM_ShortintSize = 1; OPM_IntegerSize = 2; OPM_LongintSize = 4; + OPM_SetSize = 4; break; case 'C': OPM_ShortintSize = 2; OPM_IntegerSize = 4; OPM_LongintSize = 8; + OPM_SetSize = 4; break; case 'V': OPM_ShortintSize = 1; OPM_IntegerSize = 4; OPM_LongintSize = 8; + OPM_SetSize = 8; break; default: OPM_ShortintSize = 1; OPM_IntegerSize = 2; OPM_LongintSize = 4; + OPM_SetSize = 4; break; } __MOVE(OPM_InstallDir, OPM_ResourceDir, 1024); @@ -606,7 +644,7 @@ static void OPM_ShowLine (INT64 pos) if (pos >= (INT64)OPM_ErrorLineLimitPos) { pos = OPM_ErrorLineLimitPos - 1; } - i = (INT16)OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos); + i = __SHORTF(OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos), 32768); while (i > 0) { OPM_LogW(' '); i -= 1; @@ -759,7 +797,7 @@ void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done) Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, 0); Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&tag); Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ver); - if (tag != 0xf7 || ver != 0x83) { + if (tag != 0xf7 || ver != 0x84) { if (!__IN(4, OPM_Options, 32)) { OPM_err(-306); } @@ -830,7 +868,7 @@ void OPM_NewSym (CHAR *modName, ADDRESS modName__len) if (OPM_newSFile != NIL) { Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, 0); Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7); - Files_Write(&OPM_newSF, Files_Rider__typ, 0x83); + Files_Write(&OPM_newSF, Files_Rider__typ, 0x84); } else { OPM_err(153); } @@ -865,17 +903,17 @@ void OPM_WriteHex (INT64 i) { CHAR s[3]; INT32 digit; - digit = __ASHR((INT32)i, 4); + digit = __ASHR(__SHORT(i, 2147483648LL), 4); if (digit < 10) { - s[0] = (CHAR)(48 + digit); + s[0] = __CHR(48 + digit); } else { - s[0] = (CHAR)(87 + digit); + s[0] = __CHR(87 + digit); } - digit = __MASK((INT32)i, -16); + digit = __MASK(__SHORT(i, 2147483648LL), -16); if (digit < 10) { - s[1] = (CHAR)(48 + digit); + s[1] = __CHR(48 + digit); } else { - s[1] = (CHAR)(87 + digit); + s[1] = __CHR(87 + digit); } s[2] = 0x00; OPM_WriteString(s, 3); @@ -897,11 +935,11 @@ void OPM_WriteInt (INT64 i) __MOVE("LL", s, 3); k = 2; } - s[__X(k, 26)] = (CHAR)(__MOD(i1, 10) + 48); + s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48); i1 = __DIV(i1, 10); k += 1; while (i1 > 0) { - s[__X(k, 26)] = (CHAR)(__MOD(i1, 10) + 48); + s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48); i1 = __DIV(i1, 10); k += 1; } @@ -924,13 +962,13 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx) CHAR s[32]; CHAR ch; INT16 i; - if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == ((INT32)__ENTIER(r)))) { + if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == (__SHORT(__ENTIER(r), 2147483648LL)))) { if (suffx == 'f') { OPM_WriteString((CHAR*)"(REAL)", 7); } else { OPM_WriteString((CHAR*)"(LONGREAL)", 11); } - OPM_WriteInt((INT32)__ENTIER(r)); + OPM_WriteInt(__SHORT(__ENTIER(r), 2147483648LL)); } else { Texts_OpenWriter(&W, Texts_Writer__typ); if (suffx == 'f') { @@ -1139,5 +1177,7 @@ export void *OPM__init(void) OPM_MinReal = -OPM_MaxReal; OPM_MinLReal = -OPM_MaxLReal; OPM_FindInstallDir(); + OPM_hasComment = 0; + OPM_currentComment[0] = 0x00; __ENDMOD; } diff --git a/bootstrap/unix-44/OPM.h b/bootstrap/unix-44/OPM.h index 96318bea..64c15a28 100644 --- a/bootstrap/unix-44/OPM.h +++ b/bootstrap/unix-44/OPM.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPM__h #define OPM__h @@ -9,7 +9,7 @@ import CHAR OPM_Model[10]; import INT16 OPM_AddressSize, OPM_Alignment; import UINT32 OPM_GlobalOptions, OPM_Options; -import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; +import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize; import INT64 OPM_MaxIndex; import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; import BOOLEAN OPM_noerr; @@ -30,6 +30,7 @@ import void OPM_FPrintLReal (INT32 *fp, LONGREAL val); import void OPM_FPrintReal (INT32 *fp, REAL val); import void OPM_FPrintSet (INT32 *fp, UINT64 val); import void OPM_Get (CHAR *ch); +import void OPM_GetComment (CHAR *text, ADDRESS text__len); import void OPM_Init (BOOLEAN *done); import void OPM_InitOptions (void); import INT16 OPM_Integer (INT64 n); @@ -48,6 +49,7 @@ import BOOLEAN OPM_OpenPar (void); import void OPM_RegisterNewSym (void); import INT64 OPM_SignedMaximum (INT32 bytecount); import INT64 OPM_SignedMinimum (INT32 bytecount); +import void OPM_StoreComment (CHAR *text, ADDRESS text__len); import void OPM_SymRCh (CHAR *ch); import INT32 OPM_SymRInt (void); import INT64 OPM_SymRInt64 (void); diff --git a/bootstrap/unix-44/OPP.c b/bootstrap/unix-44/OPP.c index ec4ad2be..ad4a370a 100644 --- a/bootstrap/unix-44/OPP.c +++ b/bootstrap/unix-44/OPP.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -634,7 +634,7 @@ static void OPP_StandProcCall (OPT_Node *x) OPT_Node y = NIL; INT8 m; INT16 n; - m = (INT8)((INT16)(*x)->obj->adr); + m = __SHORT(__SHORT((*x)->obj->adr, 32768), 128); n = 0; if (OPP_sym == 30) { OPS_Get(&OPP_sym); @@ -943,7 +943,7 @@ static void GetCode__19 (void) (*ext)[__X(n + 1, 256)] = OPS_str[__X(n, 256)]; n += 1; } - (*ext)[0] = (CHAR)n; + (*ext)[0] = __CHR(n); OPS_Get(&OPP_sym); } else { for (;;) { @@ -956,14 +956,14 @@ static void GetCode__19 (void) n = 1; } OPS_Get(&OPP_sym); - (*ext)[__X(n, 256)] = (CHAR)c; + (*ext)[__X(n, 256)] = __CHR(c); } if (OPP_sym == 19) { OPS_Get(&OPP_sym); } else if (OPP_sym == 35) { OPP_err(19); } else { - (*ext)[0] = (CHAR)n; + (*ext)[0] = __CHR(n); break; } } diff --git a/bootstrap/unix-44/OPP.h b/bootstrap/unix-44/OPP.h index aa076aaa..3d8cefe8 100644 --- a/bootstrap/unix-44/OPP.h +++ b/bootstrap/unix-44/OPP.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPP__h #define OPP__h diff --git a/bootstrap/unix-44/OPS.c b/bootstrap/unix-44/OPS.c index bf9f1af5..a25a2c12 100644 --- a/bootstrap/unix-44/OPS.c +++ b/bootstrap/unix-44/OPS.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -56,11 +56,11 @@ static void OPS_Str (INT8 *sym) OPS_err(241); break; } - OPS_str[i] = OPS_ch; + OPS_str[__X(i, 256)] = OPS_ch; i += 1; } OPM_Get(&OPS_ch); - OPS_str[i] = 0x00; + OPS_str[__X(i, 256)] = 0x00; OPS_intval = i + 1; if (OPS_intval == 2) { *sym = 35; @@ -76,7 +76,7 @@ static void OPS_Identifier (INT8 *sym) INT16 i; i = 0; do { - OPS_name[i] = OPS_ch; + OPS_name[__X(i, 256)] = 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)); @@ -84,7 +84,7 @@ static void OPS_Identifier (INT8 *sym) OPS_err(240); i -= 1; } - OPS_name[i] = 0x00; + OPS_name[__X(i, 256)] = 0x00; *sym = 38; } @@ -143,7 +143,7 @@ static void OPS_Number (void) 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; + dig[__X(n, 24)] = OPS_ch; n += 1; } m += 1; @@ -173,7 +173,7 @@ static void OPS_Number (void) OPS_numtyp = 1; if (n <= 2) { while (i < n) { - OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1); + OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[__X(i, 24)], 1); i += 1; } } else { @@ -187,7 +187,7 @@ static void OPS_Number (void) OPS_intval = -1; } while (i < n) { - OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1); + OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[__X(i, 24)], 1); i += 1; } } else { @@ -196,7 +196,7 @@ static void OPS_Number (void) } else { OPS_numtyp = 2; while (i < n) { - d = Ord__7(dig[i], 0); + d = Ord__7(dig[__X(i, 24)], 0); i += 1; if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) { OPS_intval = OPS_intval * 10 + (INT64)d; @@ -214,7 +214,7 @@ static void OPS_Number (void) expCh = 'E'; while (n > 0) { n -= 1; - f = (Ord__7(dig[n], 0) + f) / (LONGREAL)(LONGREAL)10; + f = (Ord__7(dig[__X(n, 24)], 0) + f) / (LONGREAL)(LONGREAL)10; } if (OPS_ch == 'E' || OPS_ch == 'D') { expCh = OPS_ch; @@ -279,32 +279,74 @@ static void Comment__2 (void); static void Comment__2 (void) { + BOOLEAN isExported; + CHAR commentText[256]; + INT16 i, nestLevel; + CHAR prevCh, nextCh; + i = 0; + while (i <= 255) { + commentText[__X(i, 256)] = 0x00; + i += 1; + } + isExported = 0; + i = 0; + nestLevel = 1; + prevCh = 0x00; OPM_Get(&OPS_ch); - for (;;) { - for (;;) { - while (OPS_ch == '(') { + if (OPS_ch == '*') { + isExported = 1; + OPM_Get(&OPS_ch); + if (OPS_ch == ')') { + commentText[0] = 0x00; + OPM_StoreComment(commentText, 256); + OPM_Get(&OPS_ch); + return; + } + } + while ((nestLevel > 0 && OPS_ch != 0x00)) { + if ((prevCh == '(' && OPS_ch == '*')) { + nestLevel += 1; + prevCh = 0x00; + } else if ((prevCh == '*' && OPS_ch == ')')) { + nestLevel -= 1; + if (nestLevel == 0) { OPM_Get(&OPS_ch); - if (OPS_ch == '*') { - Comment__2(); + } else { + prevCh = 0x00; + } + } else { + if ((((isExported && nestLevel == 1)) && prevCh != 0x00)) { + if (i < 255) { + commentText[__X(i, 256)] = prevCh; + i += 1; } } - if (OPS_ch == '*') { - OPM_Get(&OPS_ch); - break; - } - if (OPS_ch == 0x00) { - break; - } + prevCh = OPS_ch; + } + if (nestLevel > 0) { OPM_Get(&OPS_ch); } - if (OPS_ch == ')') { - OPM_Get(&OPS_ch); - break; + } + if (OPS_ch == 0x00) { + OPS_err(5); + } + if ((((((isExported && nestLevel == 0)) && prevCh != 0x00)) && prevCh != '*')) { + if (i < 255) { + commentText[__X(i, 256)] = prevCh; + i += 1; + } else { + OPM_LogWStr((CHAR*)"Truncating final comment character", 35); + OPM_LogWLn(); } - if (OPS_ch == 0x00) { - OPS_err(5); - break; + } + if (isExported) { + if (i >= 256) { + OPM_LogWStr((CHAR*)"Warning: commentText overflow", 30); + OPM_LogWLn(); + i = 255; } + commentText[__X(i, 256)] = 0x00; + OPM_StoreComment(commentText, 256); } } diff --git a/bootstrap/unix-44/OPS.h b/bootstrap/unix-44/OPS.h index 09a33705..19e222ac 100644 --- a/bootstrap/unix-44/OPS.h +++ b/bootstrap/unix-44/OPS.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPS__h #define OPS__h diff --git a/bootstrap/unix-44/OPT.c b/bootstrap/unix-44/OPT.c index 149bfd1b..72261b24 100644 --- a/bootstrap/unix-44/OPT.c +++ b/bootstrap/unix-44/OPT.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -83,6 +83,7 @@ typedef OPT_Const conval; INT32 adr, linkadr; INT16 x; + OPT_ConstExt comment; } OPT_ObjDesc; typedef @@ -173,6 +174,7 @@ 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_OutTruncatedName (CHAR *text, ADDRESS text__len); export OPT_Struct OPT_SetType (INT32 size); export OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir); export INT32 OPT_SizeAlignment (INT32 size); @@ -352,7 +354,7 @@ void OPT_TypSize (OPT_Struct typ) } typ->size = offset; typ->align = base; - typ->sysflag = __MASK(typ->sysflag, -256) + (INT16)__ASHL(offset - off0, 8); + typ->sysflag = __MASK(typ->sysflag, -256) + __SHORT(__ASHL(offset - off0, 8), 32768); } else if (c == 2) { OPT_TypSize(typ->BaseTyp); typ->size = typ->n * typ->BaseTyp->size; @@ -388,6 +390,10 @@ OPT_Object OPT_NewObj (void) { OPT_Object obj = NIL; __NEW(obj, OPT_ObjDesc); + obj->typ = NIL; + obj->conval = NIL; + obj->comment = NIL; + obj->name[0] = 0x00; return obj; } @@ -554,6 +560,8 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj) OPT_Object ob0 = NIL, ob1 = NIL; BOOLEAN left; INT8 mnolev; + CHAR commentText[256]; + INT16 j; ob0 = OPT_topScope; ob1 = ob0->right; left = 0; @@ -585,6 +593,16 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj) __COPY(name, ob1->name, 256); mnolev = OPT_topScope->mnolev; ob1->mnolev = mnolev; + OPM_GetComment((void*)commentText, 256); + if (commentText[0] != 0x00) { + ob1->comment = __NEWARR(NIL, 1, 1, 1, 0, 256); + j = 0; + while ((j < 255 && commentText[__X(j, 256)] != 0x00)) { + (*ob1->comment)[__X(j, 256)] = commentText[__X(j, 256)]; + j += 1; + } + (*ob1->comment)[__X(j, 256)] = 0x00; + } break; } } @@ -1103,6 +1121,13 @@ static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par) tag = OPM_SymRInt(); last = NIL; while (tag != 18) { + if (tag < 0 || tag > 100) { + OPM_LogWStr((CHAR*)"ERROR: Invalid tag value in InSign: ", 37); + OPM_LogWNum(tag, 0); + OPM_LogWLn(); + OPM_err(155); + return; + } new = OPT_NewObj(); new->mnolev = -mno; if (last == NIL) { @@ -1251,7 +1276,7 @@ static void OPT_InStruct (OPT_Struct *typ) obj->vis = 0; tag = OPM_SymRInt(); if (tag == 35) { - (*typ)->sysflag = (INT16)OPM_SymRInt(); + (*typ)->sysflag = __SHORTF(OPM_SymRInt(), 32768); tag = OPM_SymRInt(); } switch (tag) { @@ -1381,7 +1406,37 @@ static OPT_Object OPT_InObj (INT8 mno) OPT_Struct typ = NIL; INT32 tag; OPT_ConstExt ext = NIL; + OPS_Name commentText; + BOOLEAN hasComment; + INT16 j; + INT32 len; tag = OPT_impCtxt.nextTag; + hasComment = 0; + while (tag == 41) { + len = OPM_SymRInt(); + if (len < 0) { + len = 0; + } + if (len > 255) { + len = 255; + } + i = 0; + while (i < len) { + OPM_SymRCh(&commentText[__X(i, 256)]); + i += 1; + } + commentText[__X(i, 256)] = 0x00; + hasComment = 1; + tag = OPM_SymRInt(); + } + OPT_impCtxt.nextTag = tag; + if (tag < 0 || tag > 50) { + OPM_LogWStr((CHAR*)"ERROR: Invalid tag in InObj: ", 30); + OPM_LogWNum(tag, 0); + OPM_LogWLn(); + OPM_err(155); + return NIL; + } if (tag == 19) { OPT_InStruct(&typ); obj = typ->strobj; @@ -1397,7 +1452,7 @@ static OPT_Object OPT_InObj (INT8 mno) obj->conval = OPT_NewConst(); OPT_InConstant(tag, obj->conval); obj->typ = OPT_InTyp(tag); - } else if (tag >= 31) { + } else if ((tag >= 31 && tag <= 33)) { obj->conval = OPT_NewConst(); obj->conval->intval = -1; OPT_InSign(mno, &obj->typ, &obj->link); @@ -1412,8 +1467,8 @@ static OPT_Object OPT_InObj (INT8 mno) obj->mode = 9; ext = OPT_NewExt(); obj->conval->ext = ext; - s = (INT16)OPM_SymRInt(); - (*ext)[0] = (CHAR)s; + s = __SHORTF(OPM_SymRInt(), 32768); + (*ext)[0] = __CHR(s); i = 1; while (i <= s) { OPM_SymRCh(&(*ext)[__X(i, 256)]); @@ -1424,20 +1479,37 @@ static OPT_Object OPT_InObj (INT8 mno) OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", 32); OPM_LogWNum(tag, 0); OPM_LogWLn(); + OPM_err(155); + return NIL; break; } } else if (tag == 20) { obj->mode = 5; OPT_InStruct(&obj->typ); - } else { + } else if (tag == 21 || tag == 22) { obj->mode = 1; if (tag == 22) { obj->vis = 2; } OPT_InStruct(&obj->typ); + } else { + OPM_LogWStr((CHAR*)"ERROR: Unexpected tag in InObj: ", 33); + OPM_LogWNum(tag, 0); + OPM_LogWLn(); + OPM_err(155); + return NIL; } OPT_InName((void*)obj->name, 256); } + if ((hasComment && obj != NIL)) { + obj->comment = __NEWARR(NIL, 1, 1, 1, 0, 256); + j = 0; + while ((((j < 255 && j < len)) && commentText[__X(j, 256)] != 0x00)) { + (*obj->comment)[__X(j, 256)] = commentText[__X(j, 256)]; + j += 1; + } + (*obj->comment)[__X(j, 256)] = 0x00; + } 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); @@ -1752,7 +1824,7 @@ static void OPT_OutConstant (OPT_Object obj) OPM_SymWInt(f); switch (f) { case 2: case 3: - OPM_SymWCh((CHAR)obj->conval->intval); + OPM_SymWCh(__CHR(obj->conval->intval)); break; case 4: OPM_SymWInt(obj->conval->intval); @@ -1780,13 +1852,40 @@ static void OPT_OutConstant (OPT_Object obj) } } +static void OPT_OutTruncatedName (CHAR *text, ADDRESS text__len) +{ + INT16 i; + __DUP(text, text__len, CHAR); + i = 0; + while ((i < 255 && text[__X(i, text__len)] != 0x00)) { + OPM_SymWCh(text[__X(i, text__len)]); + i += 1; + } + OPM_SymWCh(0x00); + __DEL(text); +} + static void OPT_OutObj (OPT_Object obj) { INT16 i, j; OPT_ConstExt ext = NIL; + INT16 k, l; if (obj != NIL) { OPT_OutObj(obj->left); if (__IN(obj->mode, 0x06ea, 32)) { + if (obj->comment != NIL) { + OPM_SymWInt(41); + k = 0; + while ((k < 255 && (*obj->comment)[__X(k, 256)] != 0x00)) { + k += 1; + } + OPM_SymWInt(k); + l = 0; + while (l < k) { + OPM_SymWCh((*obj->comment)[__X(l, 256)]); + l += 1; + } + } if (obj->history == 4) { OPT_FPrintErr(obj, 250); } else if (obj->vis != 0) { @@ -2026,7 +2125,7 @@ static void EnumPtrs(void (*P)(void*)) } __TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 32), {0, -8}}; -__TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 304), {0, 4, 8, 12, 284, 288, -28}}; +__TDESC(OPT_ObjDesc, 1, 7) = {__TDFLDS("ObjDesc", 308), {0, 4, 8, 12, 284, 288, 304, -32}}; __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, diff --git a/bootstrap/unix-44/OPT.h b/bootstrap/unix-44/OPT.h index 63bf2070..cf456af5 100644 --- a/bootstrap/unix-44/OPT.h +++ b/bootstrap/unix-44/OPT.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPT__h #define OPT__h @@ -61,6 +61,7 @@ typedef OPT_Const conval; INT32 adr, linkadr; INT16 x; + OPT_ConstExt comment; } OPT_ObjDesc; typedef diff --git a/bootstrap/unix-44/OPV.c b/bootstrap/unix-44/OPV.c index 8b095ff5..0425b2e0 100644 --- a/bootstrap/unix-44/OPV.c +++ b/bootstrap/unix-44/OPV.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -112,7 +112,7 @@ static void OPV_Stamp (OPS_Name s) i += 2; k = 0; do { - n[__X(k, 10)] = (CHAR)((int)__MOD(j, 10) + 48); + n[__X(k, 10)] = __CHR((int)__MOD(j, 10) + 48); j = __DIV(j, 10); k += 1; } while (!(j == 0)); @@ -317,15 +317,27 @@ static INT16 OPV_Precedence (INT16 class, INT16 subclass, INT16 form, INT16 comp static void OPV_Len (OPT_Node n, INT64 dim) { + INT64 d; + OPT_Struct array = NIL; 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[", 7); - OPM_WriteInt(dim); - OPM_Write(']'); + d = dim; + array = n->typ; + while (d > 0) { + array = array->BaseTyp; + d -= 1; + } + if (array->comp == 3) { + OPV_design(n->left, 10); + OPM_WriteString((CHAR*)"->len[", 7); + OPM_WriteInt(dim); + OPM_Write(']'); + } else { + OPM_WriteInt(array->n); + } } else { OPC_Len(n->obj, n->typ, dim); } @@ -370,6 +382,7 @@ static void OPV_SizeCast (OPT_Node n, INT32 to) OPM_WriteInt(__ASHL(to, 3)); OPM_WriteString((CHAR*)")", 2); } + OPV_Entier(n, 9); } } @@ -381,7 +394,6 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec) if (to == 7) { if (from == 7) { OPV_SizeCast(n, newtype->size); - OPV_Entier(n, 9); } else { OPM_WriteString((CHAR*)"__SETOF(", 9); OPV_Entier(n, -1); @@ -391,7 +403,6 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec) } } else if (to == 4) { OPV_SizeCast(n, newtype->size); - OPV_Entier(n, 9); } else if (to == 3) { if (__IN(2, OPM_Options, 32)) { OPM_WriteString((CHAR*)"__CHR", 6); @@ -1183,7 +1194,7 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x) base = base->BaseTyp; } if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) { - OPC_Ident(base->strobj); + OPC_Andent(base); OPM_WriteString((CHAR*)"__typ", 6); } else if (base->form == 11) { OPM_WriteString((CHAR*)"POINTER__typ", 13); diff --git a/bootstrap/unix-44/OPV.h b/bootstrap/unix-44/OPV.h index c6a107b6..fbabd8f4 100644 --- a/bootstrap/unix-44/OPV.h +++ b/bootstrap/unix-44/OPV.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPV__h #define OPV__h diff --git a/bootstrap/unix-44/Out.c b/bootstrap/unix-44/Out.c index 23d917c7..ce936589 100644 --- a/bootstrap/unix-44/Out.c +++ b/bootstrap/unix-44/Out.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -80,7 +80,7 @@ void Out_String (CHAR *str, ADDRESS str__len) error = Platform_Write(1, (ADDRESS)str, l); } else { __MOVE((ADDRESS)str, (ADDRESS)&Out_buf[__X(Out_in, 128)], l); - Out_in += (INT16)l; + Out_in += __SHORT(l, 32768); } __DEL(str); } @@ -98,11 +98,11 @@ void Out_Int (INT64 x, INT64 n) if (x < 0) { x = -x; } - s[0] = (CHAR)(48 + __MOD(x, 10)); + s[0] = __CHR(48 + __MOD(x, 10)); x = __DIV(x, 10); i = 1; while (x != 0) { - s[__X(i, 22)] = (CHAR)(48 + __MOD(x, 10)); + s[__X(i, 22)] = __CHR(48 + __MOD(x, 10)); x = __DIV(x, 10); i += 1; } @@ -138,9 +138,9 @@ void Out_Hex (INT64 x, INT64 n) x = __ROTL(x, 4, 64); n -= 1; if (__MASK(x, -16) < 10) { - Out_Char((CHAR)(__MASK(x, -16) + 48)); + Out_Char(__CHR(__MASK(x, -16) + 48)); } else { - Out_Char((CHAR)((__MASK(x, -16) - 10) + 65)); + Out_Char(__CHR((__MASK(x, -16) - 10) + 65)); } } } @@ -154,7 +154,7 @@ void Out_Ln (void) static void Out_digit (INT64 n, CHAR *s, ADDRESS s__len, INT16 *i) { *i -= 1; - s[__X(*i, s__len)] = (CHAR)(__MOD(n, 10) + 48); + s[__X(*i, s__len)] = __CHR(__MOD(n, 10) + 48); } static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i) @@ -166,7 +166,7 @@ static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 if (l > *i) { l = *i; } - *i -= (INT16)l; + *i -= __SHORT(l, 32768); j = 0; while (j < l) { s[__X(*i + j, s__len)] = t[__X(j, t__len)]; @@ -248,7 +248,7 @@ static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_) if (nn) { x = -x; } - e = (INT16)__ASHR((e - 1023) * 77, 8); + e = __SHORT(__ASHR((e - 1023) * 77, 8), 32768); if (e >= 0) { x = x / (LONGREAL)Out_Ten(e); } else { diff --git a/bootstrap/unix-44/Out.h b/bootstrap/unix-44/Out.h index e1285046..a72547f4 100644 --- a/bootstrap/unix-44/Out.h +++ b/bootstrap/unix-44/Out.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Out__h #define Out__h diff --git a/bootstrap/unix-44/Platform.c b/bootstrap/unix-44/Platform.c index fa5fada1..befa6033 100644 --- a/bootstrap/unix-44/Platform.c +++ b/bootstrap/unix-44/Platform.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -42,6 +42,8 @@ export BOOLEAN Platform_Inaccessible (INT16 e); export BOOLEAN Platform_Interrupted (INT16 e); export BOOLEAN Platform_IsConsole (INT32 h); export void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d); +export INT16 Platform_MaxNameLength (void); +export INT16 Platform_MaxPathLength (void); export INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h); export BOOLEAN Platform_NoSuchDirectory (INT16 e); export INT32 Platform_OSAllocate (INT32 size); @@ -79,6 +81,7 @@ export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS #include #include #include +#include #include #include #define Platform_EACCES() EACCES @@ -94,6 +97,8 @@ export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS #define Platform_EROFS() EROFS #define Platform_ETIMEDOUT() ETIMEDOUT #define Platform_EXDEV() EXDEV +#define Platform_NAMEMAX() NAME_MAX +#define Platform_PATHMAX() PATH_MAX #define Platform_allocate(size) (ADDRESS)((void*)malloc((size_t)size)) #define Platform_chdir(n, n__len) chdir((char*)n) #define Platform_closefile(fd) close(fd) @@ -178,6 +183,16 @@ BOOLEAN Platform_Interrupted (INT16 e) return e == Platform_EINTR(); } +INT16 Platform_MaxNameLength (void) +{ + return Platform_NAMEMAX(); +} + +INT16 Platform_MaxPathLength (void) +{ + return Platform_PATHMAX(); +} + INT32 Platform_OSAllocate (INT32 size) { return Platform_allocate(size); @@ -189,13 +204,13 @@ void Platform_OSFree (INT32 address) } typedef - CHAR (*EnvPtr__78)[1024]; + CHAR (*EnvPtr__83)[1024]; BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len) { - EnvPtr__78 p = NIL; + EnvPtr__83 p = NIL; __DUP(var, var__len, CHAR); - p = (EnvPtr__78)(ADDRESS)Platform_getenv(var, var__len); + p = (EnvPtr__83)(ADDRESS)Platform_getenv(var, var__len); if (p != NIL) { __COPY(*p, val, val__len); } diff --git a/bootstrap/unix-44/Platform.h b/bootstrap/unix-44/Platform.h index 0b98d7bb..fbeef8c7 100644 --- a/bootstrap/unix-44/Platform.h +++ b/bootstrap/unix-44/Platform.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Platform__h #define Platform__h @@ -40,6 +40,8 @@ import BOOLEAN Platform_Inaccessible (INT16 e); import BOOLEAN Platform_Interrupted (INT16 e); import BOOLEAN Platform_IsConsole (INT32 h); import void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d); +import INT16 Platform_MaxNameLength (void); +import INT16 Platform_MaxPathLength (void); import INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h); import BOOLEAN Platform_NoSuchDirectory (INT16 e); import INT32 Platform_OSAllocate (INT32 size); diff --git a/bootstrap/unix-44/Reals.c b/bootstrap/unix-44/Reals.c index d1eb72f6..512ec2c4 100644 --- a/bootstrap/unix-44/Reals.c +++ b/bootstrap/unix-44/Reals.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -67,9 +67,9 @@ void Reals_SetExpo (REAL *x, INT16 ex) { CHAR c; __GET((ADDRESS)x + 3, c, CHAR); - __PUT((ADDRESS)x + 3, (CHAR)(__ASHL(__ASHR((INT16)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR); + __PUT((ADDRESS)x + 3, __CHR(__ASHL(__ASHR((INT16)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR); __GET((ADDRESS)x + 2, c, CHAR); - __PUT((ADDRESS)x + 2, (CHAR)(__MASK((INT16)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR); + __PUT((ADDRESS)x + 2, __CHR(__MASK((INT16)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR); } INT16 Reals_ExpoL (LONGREAL x) @@ -87,21 +87,21 @@ void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len) } k = 0; if (n > 9) { - i = (INT32)__ENTIER(x / (LONGREAL)(LONGREAL)1000000000); - j = (INT32)__ENTIER(x - i * (LONGREAL)1000000000); + i = __SHORT(__ENTIER(x / (LONGREAL)(LONGREAL)1000000000), 2147483648LL); + j = __SHORT(__ENTIER(x - i * (LONGREAL)1000000000), 2147483648LL); if (j < 0) { j = 0; } while (k < 9) { - d[__X(k, d__len)] = (CHAR)((int)__MOD(j, 10) + 48); + d[__X(k, d__len)] = __CHR((int)__MOD(j, 10) + 48); j = __DIV(j, 10); k += 1; } } else { - i = (INT32)__ENTIER(x); + i = __SHORT(__ENTIER(x), 2147483648LL); } while (k < n) { - d[__X(k, d__len)] = (CHAR)((int)__MOD(i, 10) + 48); + d[__X(k, d__len)] = __CHR((int)__MOD(i, 10) + 48); i = __DIV(i, 10); k += 1; } @@ -115,9 +115,9 @@ void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len) static CHAR Reals_ToHex (INT16 i) { if (i < 10) { - return (CHAR)(i + 48); + return __CHR(i + 48); } else { - return (CHAR)(i + 55); + return __CHR(i + 55); } __RETCHK; } diff --git a/bootstrap/unix-44/Reals.h b/bootstrap/unix-44/Reals.h index 170d1785..93e7fa75 100644 --- a/bootstrap/unix-44/Reals.h +++ b/bootstrap/unix-44/Reals.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Reals__h #define Reals__h diff --git a/bootstrap/unix-44/Strings.c b/bootstrap/unix-44/Strings.c index 225bd40a..4b18812f 100644 --- a/bootstrap/unix-44/Strings.c +++ b/bootstrap/unix-44/Strings.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -6,6 +6,7 @@ #define SET UINT32 #include "SYSTEM.h" +#include "Reals.h" @@ -19,6 +20,8 @@ export INT16 Strings_Length (CHAR *s, ADDRESS s__len); export BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len); export INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos); export void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len); +export void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r); +export void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r); INT16 Strings_Length (CHAR *s, ADDRESS s__len) @@ -31,7 +34,7 @@ INT16 Strings_Length (CHAR *s, ADDRESS s__len) } if (i <= 32767) { __DEL(s); - return (INT16)i; + return __SHORT(i, 32768); } else { __DEL(s); return 32767; @@ -123,7 +126,7 @@ void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHA INT16 len, destLen, i; __DUP(source, source__len, CHAR); len = Strings_Length(source, source__len); - destLen = (INT16)dest__len - 1; + destLen = __SHORT(dest__len, 32768) - 1; if (pos < 0) { pos = 0; } @@ -236,10 +239,135 @@ BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS return __retval; } +void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r) +{ + INT16 p, e; + REAL y, g; + BOOLEAN neg, negE; + __DUP(s, s__len, CHAR); + p = 0; + while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { + p += 1; + } + if (s[__X(p, s__len)] == '-') { + neg = 1; + p += 1; + } else { + neg = 0; + } + while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { + p += 1; + } + y = (REAL)0; + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + y = y * (REAL)10 + ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + if (s[__X(p, s__len)] == '.') { + p += 1; + g = (REAL)1; + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + g = g / (REAL)(REAL)10; + y = y + g * ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + } + if (s[__X(p, s__len)] == 'D' || s[__X(p, s__len)] == 'E') { + p += 1; + e = 0; + if (s[__X(p, s__len)] == '-') { + negE = 1; + p += 1; + } else { + negE = 0; + } + while (s[__X(p, s__len)] == '0') { + p += 1; + } + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + e = e * 10 + ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + if (negE) { + y = y / (REAL)Reals_Ten(e); + } else { + y = y * Reals_Ten(e); + } + } + if (neg) { + y = -y; + } + *r = y; + __DEL(s); +} + +void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r) +{ + INT16 p, e; + LONGREAL y, g; + BOOLEAN neg, negE; + __DUP(s, s__len, CHAR); + p = 0; + while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { + p += 1; + } + if (s[__X(p, s__len)] == '-') { + neg = 1; + p += 1; + } else { + neg = 0; + } + while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { + p += 1; + } + y = (LONGREAL)0; + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + y = y * (LONGREAL)10 + ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + if (s[__X(p, s__len)] == '.') { + p += 1; + g = (LONGREAL)1; + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + g = g / (LONGREAL)(LONGREAL)10; + y = y + g * ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + } + if (s[__X(p, s__len)] == 'D' || s[__X(p, s__len)] == 'E') { + p += 1; + e = 0; + if (s[__X(p, s__len)] == '-') { + negE = 1; + p += 1; + } else { + negE = 0; + } + while (s[__X(p, s__len)] == '0') { + p += 1; + } + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + e = e * 10 + ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + if (negE) { + y = y / (LONGREAL)Reals_Ten(e); + } else { + y = y * Reals_Ten(e); + } + } + if (neg) { + y = -y; + } + *r = y; + __DEL(s); +} + export void *Strings__init(void) { __DEFMOD; + __MODULE_IMPORT(Reals); __REGMOD("Strings", 0); /* BEGIN */ __ENDMOD; diff --git a/bootstrap/unix-44/Strings.h b/bootstrap/unix-44/Strings.h index 4d98f1a3..f0e3ae34 100644 --- a/bootstrap/unix-44/Strings.h +++ b/bootstrap/unix-44/Strings.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Strings__h #define Strings__h @@ -17,6 +17,8 @@ import INT16 Strings_Length (CHAR *s, ADDRESS s__len); import BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len); import INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos); import void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len); +import void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r); +import void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r); import void *Strings__init(void); diff --git a/bootstrap/unix-44/Texts.c b/bootstrap/unix-44/Texts.c index a6913b51..7e7522c2 100644 --- a/bootstrap/unix-44/Texts.c +++ b/bootstrap/unix-44/Texts.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -8,7 +8,6 @@ #include "SYSTEM.h" #include "Files.h" #include "Modules.h" -#include "Out.h" #include "Reals.h" typedef @@ -813,10 +812,10 @@ void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ) if ('9' < ch) { if (('A' <= ch && ch <= 'F')) { hex = 1; - ch = (CHAR)((INT16)ch - 7); + ch = __CHR((INT16)ch - 7); } else if (('a' <= ch && ch <= 'f')) { hex = 1; - ch = (CHAR)((INT16)ch - 39); + ch = __CHR((INT16)ch - 39); } else { break; } @@ -1058,7 +1057,7 @@ void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n) x0 = x; } do { - a[__X(i, 24)] = (CHAR)(__MOD(x0, 10) + 48); + a[__X(i, 24)] = __CHR(__MOD(x0, 10) + 48); x0 = __DIV(x0, 10); i += 1; } while (!(x0 == 0)); @@ -1085,9 +1084,9 @@ void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x) do { y = __MASK(x, -16); if (y < 10) { - a[__X(i, 20)] = (CHAR)(y + 48); + a[__X(i, 20)] = __CHR(y + 48); } else { - a[__X(i, 20)] = (CHAR)(y + 55); + a[__X(i, 20)] = __CHR(y + 55); } x = __ASHR(x, 4); i += 1; @@ -1163,8 +1162,8 @@ void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n) } 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)); + Texts_Write(&*W, W__typ, __CHR(__DIV(e, 10) + 48)); + Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48)); } } @@ -1314,7 +1313,7 @@ void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n) } else { Texts_Write(&*W, W__typ, ' '); } - e = (INT16)__ASHR((e - 1023) * 77, 8); + e = __SHORT(__ASHR((e - 1023) * 77, 8), 32768); if (e >= 0) { x = x / (LONGREAL)Reals_TenL(e); } else { @@ -1345,10 +1344,10 @@ void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n) } else { Texts_Write(&*W, W__typ, '+'); } - Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 100) + 48)); + Texts_Write(&*W, W__typ, __CHR(__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)); + Texts_Write(&*W, W__typ, __CHR(__DIV(e, 10) + 48)); + Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48)); } } @@ -1375,8 +1374,8 @@ static void WritePair__44 (CHAR ch, INT32 x); static void WritePair__44 (CHAR ch, INT32 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)((int)__MOD(x, 10) + 48)); + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, __CHR(__DIV(x, 10) + 48)); + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, __CHR((int)__MOD(x, 10) + 48)); } void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d) @@ -1810,7 +1809,6 @@ export void *Texts__init(void) __DEFMOD; __MODULE_IMPORT(Files); __MODULE_IMPORT(Modules); - __MODULE_IMPORT(Out); __MODULE_IMPORT(Reals); __REGMOD("Texts", EnumPtrs); __INITYP(Texts_FontDesc, Texts_FontDesc, 0); diff --git a/bootstrap/unix-44/Texts.h b/bootstrap/unix-44/Texts.h index bad71689..dc569fa9 100644 --- a/bootstrap/unix-44/Texts.h +++ b/bootstrap/unix-44/Texts.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Texts__h #define Texts__h diff --git a/bootstrap/unix-44/VT100.c b/bootstrap/unix-44/VT100.c index 9cd5cf4d..346fb37b 100644 --- a/bootstrap/unix-44/VT100.c +++ b/bootstrap/unix-44/VT100.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -34,6 +34,7 @@ static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len); export void VT100_HVP (INT16 n, INT16 m); export void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len); export void VT100_RCP (void); +export void VT100_Reset (void); static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end); export void VT100_SCP (void); export void VT100_SD (INT16 n); @@ -74,7 +75,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len) } e = s; do { - b[__X(e, 21)] = (CHAR)((int)__MOD(int_, 10) + 48); + b[__X(e, 21)] = __CHR((int)__MOD(int_, 10) + 48); int_ = __DIV(int_, 10); e += 1; } while (!(int_ == 0)); @@ -136,6 +137,15 @@ static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len) __DEL(letter); } +void VT100_Reset (void) +{ + CHAR cmd[6]; + __COPY("\033", cmd, 6); + Strings_Append((CHAR*)"c", 2, (void*)cmd, 6); + Out_String(cmd, 6); + Out_Ln(); +} + void VT100_CUU (INT16 n) { VT100_EscSeq(n, (CHAR*)"A", 2); @@ -256,6 +266,7 @@ export void *VT100__init(void) __REGCMD("DECTCEMh", VT100_DECTCEMh); __REGCMD("DECTCEMl", VT100_DECTCEMl); __REGCMD("RCP", VT100_RCP); + __REGCMD("Reset", VT100_Reset); __REGCMD("SCP", VT100_SCP); /* BEGIN */ __COPY("\033", VT100_CSI, 5); diff --git a/bootstrap/unix-44/VT100.h b/bootstrap/unix-44/VT100.h index 8f60c652..4e708647 100644 --- a/bootstrap/unix-44/VT100.h +++ b/bootstrap/unix-44/VT100.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef VT100__h #define VT100__h @@ -25,6 +25,7 @@ import void VT100_EL (INT16 n); import void VT100_HVP (INT16 n, INT16 m); import void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len); import void VT100_RCP (void); +import void VT100_Reset (void); import void VT100_SCP (void); import void VT100_SD (INT16 n); import void VT100_SGR (INT16 n); diff --git a/bootstrap/unix-44/extTools.c b/bootstrap/unix-44/extTools.c index fa840303..ce2fc413 100644 --- a/bootstrap/unix-44/extTools.c +++ b/bootstrap/unix-44/extTools.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -7,18 +7,22 @@ #include "SYSTEM.h" #include "Configuration.h" +#include "Heap.h" #include "Modules.h" #include "OPM.h" #include "Out.h" #include "Platform.h" #include "Strings.h" +typedef + CHAR extTools_CommandString[4096]; -static CHAR extTools_CFLAGS[1023]; + +static extTools_CommandString extTools_CFLAGS; export void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len); -static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len); +static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len, CHAR *additionalopts, ADDRESS additionalopts__len); export void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len); static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRESS cmd__len); @@ -26,14 +30,17 @@ static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRES static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRESS cmd__len) { INT16 r, status, exitcode; + extTools_CommandString fullcmd; __DUP(title, title__len, CHAR); __DUP(cmd, cmd__len, CHAR); if (__IN(18, OPM_Options, 32)) { - Out_String(title, title__len); + Out_String((CHAR*)" ", 3); Out_String(cmd, cmd__len); Out_Ln(); } - r = Platform_System(cmd, cmd__len); + __COPY(cmd, fullcmd, 4096); + Heap_GC(0); + r = Platform_System(fullcmd, 4096); status = __MASK(r, -128); exitcode = __ASHR(r, 8); if (exitcode > 127) { @@ -63,50 +70,55 @@ static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRES __DEL(cmd); } -static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len) +static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len, CHAR *additionalopts, ADDRESS additionalopts__len) { - __COPY("gcc -g", s, s__len); + __DUP(additionalopts, additionalopts__len, CHAR); + __COPY("gcc -fPIC -g -Wno-stringop-overflow", s, s__len); Strings_Append((CHAR*)" -I \"", 6, (void*)s, s__len); Strings_Append(OPM_ResourceDir, 1024, (void*)s, s__len); Strings_Append((CHAR*)"/include\" ", 11, (void*)s, s__len); - Platform_GetEnv((CHAR*)"CFLAGS", 7, (void*)extTools_CFLAGS, 1023); - Strings_Append(extTools_CFLAGS, 1023, (void*)s, s__len); + Strings_Append(additionalopts, additionalopts__len, (void*)s, s__len); Strings_Append((CHAR*)" ", 2, (void*)s, s__len); + Platform_GetEnv((CHAR*)"CFLAGS", 7, (void*)extTools_CFLAGS, 4096); + Strings_Append(extTools_CFLAGS, 4096, (void*)s, s__len); + Strings_Append((CHAR*)" ", 2, (void*)s, s__len); + __DEL(additionalopts); } void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len) { - CHAR cmd[1023]; + extTools_CommandString cmd; __DUP(moduleName, moduleName__len, CHAR); - extTools_InitialiseCompilerCommand((void*)cmd, 1023); - Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 1023); - Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023); - Strings_Append((CHAR*)".c", 3, (void*)cmd, 1023); - extTools_execute((CHAR*)"C compile: ", 12, cmd, 1023); + extTools_InitialiseCompilerCommand((void*)cmd, 4096, (CHAR*)"", 1); + Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 4096); + Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096); + Strings_Append((CHAR*)".c", 3, (void*)cmd, 4096); + extTools_execute((CHAR*)"C compile: ", 12, cmd, 4096); __DEL(moduleName); } void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len) { - CHAR cmd[1023]; + extTools_CommandString cmd; __DUP(additionalopts, additionalopts__len, CHAR); - extTools_InitialiseCompilerCommand((void*)cmd, 1023); - Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023); - Strings_Append((CHAR*)".c ", 4, (void*)cmd, 1023); - Strings_Append(additionalopts, additionalopts__len, (void*)cmd, 1023); + extTools_InitialiseCompilerCommand((void*)cmd, 4096, additionalopts, additionalopts__len); + Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096); + Strings_Append((CHAR*)".c ", 4, (void*)cmd, 4096); if (statically) { - Strings_Append((CHAR*)" -static", 9, (void*)cmd, 1023); + Strings_Append((CHAR*)" -static", 9, (void*)cmd, 4096); } - Strings_Append((CHAR*)" -o ", 5, (void*)cmd, 1023); - Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023); - Strings_Append((CHAR*)" -L\"", 5, (void*)cmd, 1023); - Strings_Append(OPM_InstallDir, 1024, (void*)cmd, 1023); - Strings_Append((CHAR*)"/lib\"", 6, (void*)cmd, 1023); - Strings_Append((CHAR*)" -l voc", 8, (void*)cmd, 1023); - Strings_Append((CHAR*)"-O", 3, (void*)cmd, 1023); - Strings_Append(OPM_Model, 10, (void*)cmd, 1023); - Strings_Append((CHAR*)"", 1, (void*)cmd, 1023); - extTools_execute((CHAR*)"C compile and link: ", 21, cmd, 1023); + Strings_Append((CHAR*)" -o ", 5, (void*)cmd, 4096); + Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096); + if (!statically || 1) { + Strings_Append((CHAR*)" -L\"", 5, (void*)cmd, 4096); + Strings_Append(OPM_InstallDir, 1024, (void*)cmd, 4096); + Strings_Append((CHAR*)"/lib\"", 6, (void*)cmd, 4096); + Strings_Append((CHAR*)" -lvoc", 7, (void*)cmd, 4096); + Strings_Append((CHAR*)"-O", 3, (void*)cmd, 4096); + Strings_Append(OPM_Model, 10, (void*)cmd, 4096); + Strings_Append((CHAR*)"", 1, (void*)cmd, 4096); + } + extTools_execute((CHAR*)"C compile and link: ", 21, cmd, 4096); __DEL(additionalopts); } @@ -115,6 +127,7 @@ export void *extTools__init(void) { __DEFMOD; __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Heap); __MODULE_IMPORT(Modules); __MODULE_IMPORT(OPM); __MODULE_IMPORT(Out); diff --git a/bootstrap/unix-44/extTools.h b/bootstrap/unix-44/extTools.h index a93b6c85..686f0b4e 100644 --- a/bootstrap/unix-44/extTools.h +++ b/bootstrap/unix-44/extTools.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef extTools__h #define extTools__h diff --git a/bootstrap/unix-48/Compiler.c b/bootstrap/unix-48/Compiler.c index 993c2bac..4460479d 100644 --- a/bootstrap/unix-48/Compiler.c +++ b/bootstrap/unix-48/Compiler.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspamS */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspamS */ #define SHORTINT INT8 #define INTEGER INT16 @@ -89,7 +89,7 @@ static void Compiler_PropagateElementaryTypeSizes (void) OPT_sintobj->typ = OPT_sinttyp; OPT_intobj->typ = OPT_inttyp; OPT_lintobj->typ = OPT_linttyp; - switch (OPM_LongintSize) { + switch (OPM_SetSize) { case 4: OPT_settyp = OPT_set32typ; break; diff --git a/bootstrap/unix-48/Configuration.c b/bootstrap/unix-48/Configuration.c index 80b87b1d..fa87c9de 100644 --- a/bootstrap/unix-48/Configuration.c +++ b/bootstrap/unix-48/Configuration.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -8,7 +8,7 @@ #include "SYSTEM.h" -export CHAR Configuration_versionLong[75]; +export CHAR Configuration_versionLong[76]; @@ -19,6 +19,6 @@ export void *Configuration__init(void) __DEFMOD; __REGMOD("Configuration", 0); /* BEGIN */ - __MOVE("2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75); + __MOVE("2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 76); __ENDMOD; } diff --git a/bootstrap/unix-48/Configuration.h b/bootstrap/unix-48/Configuration.h index cdc285e5..c3c54eed 100644 --- a/bootstrap/unix-48/Configuration.h +++ b/bootstrap/unix-48/Configuration.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Configuration__h #define Configuration__h @@ -6,7 +6,7 @@ #include "SYSTEM.h" -import CHAR Configuration_versionLong[75]; +import CHAR Configuration_versionLong[76]; import void *Configuration__init(void); diff --git a/bootstrap/unix-48/Files.c b/bootstrap/unix-48/Files.c index cd6f14b9..54341368 100644 --- a/bootstrap/unix-48/Files.c +++ b/bootstrap/unix-48/Files.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -26,7 +26,7 @@ typedef Files_BufDesc *Files_Buffer; typedef - CHAR Files_FileName[101]; + CHAR Files_FileName[256]; typedef struct Files_FileDesc { @@ -48,6 +48,7 @@ typedef } Files_Rider; +export INT16 Files_MaxPathLength, Files_MaxNameLength; static Files_FileDesc *Files_files; static INT16 Files_tempno; static CHAR Files_HOME[1024]; @@ -85,6 +86,7 @@ export INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ); export void Files_Purge (Files_File f); export void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); export void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x); +export void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n); export void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x); export void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x); @@ -129,17 +131,17 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode) Out_String((CHAR*)": ", 3); if (f != NIL) { if (f->registerName[0] != 0x00) { - Out_String(f->registerName, 101); + Out_String(f->registerName, 256); } else { - Out_String(f->workName, 101); + Out_String(f->workName, 256); } if (f->fd != 0) { - Out_String((CHAR*)"f.fd = ", 8); + Out_String((CHAR*)", f.fd = ", 10); Out_Int(f->fd, 1); } } if (errcode != 0) { - Out_String((CHAR*)" errcode = ", 12); + Out_String((CHAR*)", errcode = ", 13); Out_Int(errcode, 1); } Out_Ln(); @@ -149,76 +151,75 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode) static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len) { - INT16 i, j; + INT16 i, j, ld, ln; __DUP(dir, dir__len, CHAR); __DUP(name, name__len, CHAR); + ld = Strings_Length(dir, dir__len); + ln = Strings_Length(name, name__len); + while ((ld > 0 && dir[__X(ld - 1, dir__len)] == '/')) { + ld -= 1; + } + if (((ld + ln) + 2) > dest__len) { + Files_Err((CHAR*)"File name too long", 19, NIL, 0); + } i = 0; + while (i < ld) { + dest[__X(i, dest__len)] = dir[__X(i, dir__len)]; + i += 1; + } + if (i > 0) { + dest[__X(i, dest__len)] = '/'; + i += 1; + } 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]; + while (j < ln) { + dest[__X(i, dest__len)] = name[__X(j, name__len)]; i += 1; j += 1; } - dest[i] = 0x00; + dest[__X(i, dest__len)] = 0x00; __DEL(dir); __DEL(name); } static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len) { - INT32 n, i, j; + INT16 i, n; __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; - } + if (finalName[0] == '/') { + __COPY(finalName, name, name__len); + } else { + Files_MakeFileName(Platform_CWD, 256, finalName, finalName__len, (void*)name, name__len); } - j = 0; - while (finalName[j] != 0x00) { - name[i] = finalName[j]; - i += 1; - j += 1; - } - i -= 1; - while (name[i] != '/') { + i = Strings_Length(name, name__len) - 1; + while ((i > 0 && name[__X(i, name__len)] != '/')) { i -= 1; } - name[i + 1] = '.'; - name[i + 2] = 't'; - name[i + 3] = 'm'; - name[i + 4] = 'p'; - name[i + 5] = '.'; + if ((i + 16) >= name__len) { + Files_Err((CHAR*)"File name too long", 19, NIL, 0); + } + Files_tempno += 1; + n = Files_tempno; + name[__X(i + 1, name__len)] = '.'; + name[__X(i + 2, name__len)] = 't'; + name[__X(i + 3, name__len)] = 'm'; + name[__X(i + 4, name__len)] = 'p'; + name[__X(i + 5, name__len)] = '.'; i += 6; while (n > 0) { - name[i] = (CHAR)((int)__MOD(n, 10) + 48); + name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48); n = __DIV(n, 10); i += 1; } - name[i] = '.'; + name[__X(i, name__len)] = '.'; i += 1; n = Platform_PID; while (n > 0) { - name[i] = (CHAR)((int)__MOD(n, 10) + 48); + name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48); n = __DIV(n, 10); i += 1; } - name[i] = 0x00; + name[__X(i, name__len)] = 0x00; __DEL(finalName); } @@ -236,11 +237,11 @@ static void Files_Deregister (CHAR *name, ADDRESS name__len) if (osfile != NIL) { __ASSERT(!osfile->tempFile, 0); __ASSERT(osfile->fd >= 0, 0); - __MOVE(osfile->workName, osfile->registerName, 101); - Files_GetTempName(osfile->registerName, 101, (void*)osfile->workName, 101); + __MOVE(osfile->workName, osfile->registerName, 256); + Files_GetTempName(osfile->registerName, 256, (void*)osfile->workName, 256); osfile->tempFile = 1; osfile->state = 0; - error = Platform_Rename((void*)osfile->registerName, 101, (void*)osfile->workName, 101); + error = Platform_Rename((void*)osfile->registerName, 256, (void*)osfile->workName, 256); if (error != 0) { Files_Err((CHAR*)"Couldn't rename previous version of file being registered", 58, osfile, error); } @@ -256,17 +257,17 @@ static void Files_Create (Files_File f) CHAR err[32]; if (f->fd == -1) { if (f->state == 1) { - Files_GetTempName(f->registerName, 101, (void*)f->workName, 101); + Files_GetTempName(f->registerName, 256, (void*)f->workName, 256); f->tempFile = 1; } else { __ASSERT(f->state == 2, 0); - Files_Deregister(f->registerName, 101); - __MOVE(f->registerName, f->workName, 101); + Files_Deregister(f->registerName, 256); + __MOVE(f->registerName, f->workName, 256); f->registerName[0] = 0x00; f->tempFile = 0; } - error = Platform_Unlink((void*)f->workName, 101); - error = Platform_New((void*)f->workName, 101, &f->fd); + error = Platform_Unlink((void*)f->workName, 256); + error = Platform_New((void*)f->workName, 256, &f->fd); done = error == 0; if (done) { f->next = Files_files; @@ -319,8 +320,8 @@ void Files_Close (Files_File f) 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]); + while ((i < 4 && f->bufs[__X(i, 4)] != NIL)) { + Files_Flush(f->bufs[__X(i, 4)]); i += 1; } } @@ -337,7 +338,7 @@ Files_File Files_New (CHAR *name, ADDRESS name__len) __DUP(name, name__len, CHAR); __NEW(f, Files_FileDesc); f->workName[0] = 0x00; - __COPY(name, f->registerName, 101); + __COPY(name, f->registerName, 256); f->fd = -1; f->state = 1; f->len = 0; @@ -359,35 +360,35 @@ static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len) *pos += 1; } } else { - ch = (Files_SearchPath->data)[*pos]; + ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])]; while (ch == ' ' || ch == ';') { *pos += 1; - ch = (Files_SearchPath->data)[*pos]; + ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])]; } if (ch == '~') { *pos += 1; - ch = (Files_SearchPath->data)[*pos]; - while (Files_HOME[i] != 0x00) { - dir[i] = Files_HOME[i]; + ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])]; + while (Files_HOME[__X(i, 1024)] != 0x00) { + dir[__X(i, dir__len)] = Files_HOME[__X(i, 1024)]; i += 1; } if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) { - while ((i > 0 && dir[i - 1] != '/')) { + while ((i > 0 && dir[__X(i - 1, dir__len)] != '/')) { i -= 1; } } } while ((ch != 0x00 && ch != ';')) { - dir[i] = ch; + dir[__X(i, dir__len)] = ch; i += 1; *pos += 1; - ch = (Files_SearchPath->data)[*pos]; + ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])]; } - while ((i > 0 && dir[i - 1] == ' ')) { + while ((i > 0 && dir[__X(i - 1, dir__len)] == ' ')) { i -= 1; } } - dir[i] = 0x00; + dir[__X(i, dir__len)] = 0x00; } static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len) @@ -398,7 +399,7 @@ static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len) ch = name[0]; while ((ch != 0x00 && ch != '/')) { i += 1; - ch = name[i]; + ch = name[__X(i, name__len)]; } return ch == '/'; } @@ -413,9 +414,9 @@ static Files_File Files_CacheEntry (Platform_FileIdentity 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; + if (f->bufs[__X(i, 4)] != NIL) { + f->bufs[__X(i, 4)]->org = -1; + f->bufs[__X(i, 4)] = NIL; } i += 1; } @@ -482,7 +483,7 @@ Files_File Files_Old (CHAR *name, ADDRESS name__len) f->pos = 0; f->swapper = -1; error = Platform_Size(fd, &f->len); - __COPY(name, f->workName, 101); + __COPY(name, f->workName, 256); f->registerName[0] = 0x00; f->tempFile = 0; f->identity = identity; @@ -514,9 +515,9 @@ void Files_Purge (Files_File f) INT16 error; i = 0; while (i < 4) { - if (f->bufs[i] != NIL) { - f->bufs[i]->org = -1; - f->bufs[i] = NIL; + if (f->bufs[__X(i, 4)] != NIL) { + f->bufs[__X(i, 4)]->org = -1; + f->bufs[__X(i, 4)] = NIL; } i += 1; } @@ -560,22 +561,22 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos) offset = __MASK(pos, -4096); org = pos - offset; i = 0; - while ((((i < 4 && f->bufs[i] != NIL)) && org != f->bufs[i]->org)) { + while ((((i < 4 && f->bufs[__X(i, 4)] != NIL)) && org != f->bufs[__X(i, 4)]->org)) { i += 1; } if (i < 4) { - if (f->bufs[i] == NIL) { + if (f->bufs[__X(i, 4)] == NIL) { __NEW(buf, Files_BufDesc); buf->chg = 0; buf->org = -1; buf->f = f; - f->bufs[i] = buf; + f->bufs[__X(i, 4)] = buf; } else { - buf = f->bufs[i]; + buf = f->bufs[__X(i, 4)]; } } else { f->swapper = __MASK(f->swapper + 1, -4); - buf = f->bufs[f->swapper]; + buf = f->bufs[__X(f->swapper, 4)]; Files_Flush(buf); } if (buf->org != org) { @@ -622,7 +623,7 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x) } Files_Assert(offset <= buf->size); if (offset < buf->size) { - *x = buf->data[offset]; + *x = buf->data[__X(offset, 4096)]; (*r).offset = offset + 1; } else if ((*r).org + offset < buf->f->len) { Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset); @@ -634,6 +635,11 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x) } } +void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x) +{ + Files_Read(&*r, r__typ, &*x); +} + void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n) { INT32 xpos, min, restInBuf, offset; @@ -660,7 +666,7 @@ void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x } else { min = n; } - __MOVE((ADDRESS)&buf->data[offset], (ADDRESS)&x[xpos], min); + __MOVE((ADDRESS)&buf->data[__X(offset, 4096)], (ADDRESS)&x[__X(xpos, x__len)], min); offset += min; (*r).offset = offset; xpos += min; @@ -689,7 +695,7 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x) offset = (*r).offset; } Files_Assert(offset < 4096); - buf->data[offset] = x; + buf->data[__X(offset, 4096)] = x; buf->chg = 1; if (offset == buf->size) { buf->size += 1; @@ -723,7 +729,7 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS } else { min = n; } - __MOVE((ADDRESS)&x[xpos], (ADDRESS)&buf->data[offset], min); + __MOVE((ADDRESS)&x[__X(xpos, x__len)], (ADDRESS)&buf->data[__X(offset, 4096)], min); offset += min; (*r).offset = offset; Files_Assert(offset <= 4096); @@ -817,12 +823,12 @@ void Files_Register (Files_File f) } Files_Close(f); if (f->registerName[0] != 0x00) { - Files_Deregister(f->registerName, 101); - Files_Rename(f->workName, 101, f->registerName, 101, &errcode); + Files_Deregister(f->registerName, 256); + Files_Rename(f->workName, 256, f->registerName, 256, &errcode); if (errcode != 0) { Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode); } - __MOVE(f->registerName, f->workName, 101); + __MOVE(f->registerName, f->workName, 256); f->registerName[0] = 0x00; f->tempFile = 0; } @@ -843,7 +849,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *de j = 0; while (i > 0) { i -= 1; - dest[j] = src[i]; + dest[__X(j, dest__len)] = src[__X(i, src__len)]; j += 1; } } else { @@ -900,7 +906,7 @@ void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len) i = 0; do { Files_Read(&*R, R__typ, (void*)&ch); - x[i] = ch; + x[__X(i, x__len)] = ch; i += 1; } while (!(ch == 0x00)); } @@ -910,16 +916,16 @@ void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len) INT16 i; i = 0; do { - Files_Read(&*R, R__typ, (void*)&x[i]); + Files_Read(&*R, R__typ, (void*)&x[__X(i, x__len)]); i += 1; - } while (!(x[i - 1] == 0x00 || x[i - 1] == 0x0a)); - if (x[i - 1] == 0x0a) { + } while (!(x[__X(i - 1, x__len)] == 0x00 || x[__X(i - 1, x__len)] == 0x0a)); + if (x[__X(i - 1, x__len)] == 0x0a) { i -= 1; } - if ((i > 0 && x[i - 1] == 0x0d)) { + if ((i > 0 && x[__X(i - 1, x__len)] == 0x0d)) { i -= 1; } - x[i] = 0x00; + x[__X(i, x__len)] = 0x00; } void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len) @@ -947,18 +953,18 @@ void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x) void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x) { CHAR b[2]; - b[0] = (CHAR)x; - b[1] = (CHAR)__ASHR(x, 8); + b[0] = __CHR(x); + b[1] = __CHR(__ASHR(x, 8)); Files_WriteBytes(&*R, R__typ, (void*)b, 2, 2); } void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 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); + b[0] = __CHR(x); + b[1] = __CHR(__ASHR(x, 8)); + b[2] = __CHR(__ASHR(x, 16)); + b[3] = __CHR(__ASHR(x, 24)); Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4); } @@ -966,11 +972,13 @@ void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x) { CHAR b[4]; INT32 i; - i = (INT32)x; - b[0] = (CHAR)i; - b[1] = (CHAR)__ASHR(i, 8); - b[2] = (CHAR)__ASHR(i, 16); - b[3] = (CHAR)__ASHR(i, 24); + UINT64 y; + y = x; + i = __VAL(INT32, y); + b[0] = __CHR(i); + b[1] = __CHR(__ASHR(i, 8)); + b[2] = __CHR(__ASHR(i, 16)); + b[3] = __CHR(__ASHR(i, 24)); Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4); } @@ -992,7 +1000,7 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len { INT16 i; i = 0; - while (x[i] != 0x00) { + while (x[__X(i, x__len)] != 0x00) { i += 1; } Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1); @@ -1001,10 +1009,10 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x) { while (x < -64 || x > 63) { - Files_Write(&*R, R__typ, (CHAR)(__MASK(x, -128) + 128)); + Files_Write(&*R, R__typ, __CHR(__MASK(x, -128) + 128)); x = __ASHR(x, 7); } - Files_Write(&*R, R__typ, (CHAR)__MASK(x, -128)); + Files_Write(&*R, R__typ, __CHR(__MASK(x, -128))); } void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len) @@ -1041,7 +1049,7 @@ static void Files_Finalize (SYSTEM_PTR o) if (f->fd >= 0) { Files_CloseOSFile(f); if (f->tempFile) { - res = Platform_Unlink((void*)f->workName, 101); + res = Platform_Unlink((void*)f->workName, 256); } } } @@ -1063,7 +1071,7 @@ static void EnumPtrs(void (*P)(void*)) P(Files_SearchPath); } -__TDESC(Files_FileDesc, 1, 4) = {__TDFLDS("FileDesc", 252), {228, 232, 236, 240, -20}}; +__TDESC(Files_FileDesc, 1, 4) = {__TDFLDS("FileDesc", 564), {540, 544, 548, 552, -20}}; __TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4112), {0, -8}}; __TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 20), {8, -8}}; @@ -1083,5 +1091,7 @@ export void *Files__init(void) Heap_FileCount = 0; Files_HOME[0] = 0x00; Platform_GetEnv((CHAR*)"HOME", 5, (void*)Files_HOME, 1024); + Files_MaxPathLength = Platform_MaxPathLength(); + Files_MaxNameLength = Platform_MaxNameLength(); __ENDMOD; } diff --git a/bootstrap/unix-48/Files.h b/bootstrap/unix-48/Files.h index 62563e24..ccdabcc2 100644 --- a/bootstrap/unix-48/Files.h +++ b/bootstrap/unix-48/Files.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Files__h #define Files__h @@ -11,7 +11,7 @@ typedef typedef struct Files_FileDesc { INT32 _prvt0; - char _prvt1[248]; + char _prvt1[560]; } Files_FileDesc; typedef @@ -22,6 +22,7 @@ typedef } Files_Rider; +import INT16 Files_MaxPathLength, Files_MaxNameLength; import ADDRESS *Files_FileDesc__typ; import ADDRESS *Files_Rider__typ; @@ -39,6 +40,7 @@ import INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ); import void Files_Purge (Files_File f); import void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); import void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x); +import void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); import void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n); import void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x); import void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x); diff --git a/bootstrap/unix-48/Heap.c b/bootstrap/unix-48/Heap.c index c12cb722..42552415 100644 --- a/bootstrap/unix-48/Heap.c +++ b/bootstrap/unix-48/Heap.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tsSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -68,9 +68,10 @@ static INT32 Heap_freeList[10]; static INT32 Heap_bigBlocks; export INT32 Heap_allocated; static BOOLEAN Heap_firstTry; +static INT16 Heap_ldUnit; export INT32 Heap_heap; static INT32 Heap_heapMin, Heap_heapMax; -export INT32 Heap_heapsize; +export INT32 Heap_heapsize, Heap_heapMinExpand; static Heap_FinNode Heap_fin; static INT16 Heap_lockdepth; static BOOLEAN Heap_interrupted; @@ -228,10 +229,10 @@ static INT32 Heap_NewChunk (INT32 blksz) static void Heap_ExtendHeap (INT32 blksz) { INT32 size, chnk, j, next; - if (Heap_uLT(160000, blksz)) { + if (Heap_uLT(Heap_heapMinExpand, blksz)) { size = blksz; } else { - size = 160000; + size = Heap_heapMinExpand; } chnk = Heap_NewChunk(size); if (chnk != 0) { @@ -248,6 +249,8 @@ static void Heap_ExtendHeap (INT32 blksz) __PUT(chnk, next, INT32); __PUT(j, chnk, INT32); } + } else if (!Heap_firstTry) { + Heap_heapMinExpand = 16; } } @@ -257,16 +260,16 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag) SYSTEM_PTR new; Heap_Lock(); __GET(tag, blksz, INT32); - i0 = __ASHR(blksz, 4); + i0 = __LSH(blksz, -Heap_ldUnit, 32); i = i0; - if (Heap_uLT(i, 9)) { + if (i < 9) { adr = Heap_freeList[i]; while (adr == 0) { i += 1; adr = Heap_freeList[i]; } } - if (Heap_uLT(i, 9)) { + if (i < 9) { __GET(adr + 12, next, INT32); Heap_freeList[i] = next; if (i != i0) { @@ -289,16 +292,17 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag) if (Heap_firstTry) { Heap_GC(1); blksz += 16; - if (Heap_uLT(Heap_heapsize - Heap_allocated, blksz) || Heap_uLT(__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2), Heap_heapsize)) { - Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize); + t = __LSH(Heap_allocated + blksz, -(2 + Heap_ldUnit), 32) * 80; + if (Heap_uLT(Heap_heapsize, t)) { + Heap_ExtendHeap(t - 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); + Heap_ExtendHeap(blksz); new = Heap_NEWREC(tag); } + Heap_firstTry = 1; Heap_Unlock(); return new; } else { @@ -443,7 +447,7 @@ static void Heap_Scan (void) __PUT(start, start + 4, INT32); __PUT(start + 4, freesize, INT32); __PUT(start + 8, -4, INT32); - i = __ASHR(freesize, 4); + i = __LSH(freesize, -Heap_ldUnit, 32); freesize = 0; if (Heap_uLT(i, 9)) { __PUT(start + 12, Heap_freeList[i], INT32); @@ -469,7 +473,7 @@ static void Heap_Scan (void) __PUT(start, start + 4, INT32); __PUT(start + 4, freesize, INT32); __PUT(start + 8, -4, INT32); - i = __ASHR(freesize, 4); + i = __LSH(freesize, -Heap_ldUnit, 32); freesize = 0; if (Heap_uLT(i, 9)) { __PUT(start + 12, Heap_freeList[i], INT32); @@ -661,79 +665,77 @@ void Heap_GC (BOOLEAN markStack) Heap_Module m; INT32 i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23; INT32 cand[10000]; - if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) { - Heap_Lock(); - m = (Heap_Module)(ADDRESS)Heap_modules; - while (m != NIL) { - if (m->enumPtrs != NIL) { - (*m->enumPtrs)(Heap_MarkP); - } - m = m->next; + Heap_Lock(); + m = (Heap_Module)(ADDRESS)Heap_modules; + while (m != NIL) { + if (m->enumPtrs != NIL) { + (*m->enumPtrs)(Heap_MarkP); } - 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(32, (void*)cand, 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(); + 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(32, (void*)cand, 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) @@ -756,6 +758,8 @@ void Heap_InitHeap (void) Heap_heapMin = -1; Heap_heapMax = 0; Heap_bigBlocks = 0; + Heap_heapMinExpand = 128000; + Heap_ldUnit = 4; Heap_heap = Heap_NewChunk(128000); __PUT(Heap_heap, 0, INT32); Heap_firstTry = 1; diff --git a/bootstrap/unix-48/Heap.h b/bootstrap/unix-48/Heap.h index de4d17ce..3cde1c3b 100644 --- a/bootstrap/unix-48/Heap.h +++ b/bootstrap/unix-48/Heap.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tsSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */ #ifndef Heap__h #define Heap__h @@ -48,7 +48,7 @@ typedef import SYSTEM_PTR Heap_modules; import INT32 Heap_allocated; import INT32 Heap_heap; -import INT32 Heap_heapsize; +import INT32 Heap_heapsize, Heap_heapMinExpand; import INT16 Heap_FileCount; import ADDRESS *Heap_ModuleDesc__typ; diff --git a/bootstrap/unix-48/Modules.c b/bootstrap/unix-48/Modules.c index f397649b..535721e8 100644 --- a/bootstrap/unix-48/Modules.c +++ b/bootstrap/unix-48/Modules.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -404,7 +404,7 @@ static void Modules_errint (INT32 l) if (l >= 10) { Modules_errint(__DIV(l, 10)); } - Modules_errch((CHAR)((int)__MOD(l, 10) + 48)); + Modules_errch(__CHR((int)__MOD(l, 10) + 48)); } static void Modules_DisplayHaltCode (INT32 code) diff --git a/bootstrap/unix-48/Modules.h b/bootstrap/unix-48/Modules.h index 8436f089..26d86b38 100644 --- a/bootstrap/unix-48/Modules.h +++ b/bootstrap/unix-48/Modules.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Modules__h #define Modules__h diff --git a/bootstrap/unix-48/OPB.c b/bootstrap/unix-48/OPB.c index 19e40505..913fbf2d 100644 --- a/bootstrap/unix-48/OPB.c +++ b/bootstrap/unix-48/OPB.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -261,7 +261,7 @@ static void OPB_CharToString (OPT_Node n) { CHAR ch; n->typ = OPT_stringtyp; - ch = (CHAR)n->conval->intval; + ch = __CHR(n->conval->intval); n->conval->ext = OPT_NewExt(); if (ch == 0x00) { n->conval->intval2 = 1; @@ -597,7 +597,7 @@ void OPB_MOp (INT8 op, OPT_Node *x) case 22: if (f == 3) { if (z->class == 7) { - z->conval->intval = (INT16)__CAP((CHAR)z->conval->intval); + z->conval->intval = (INT16)__CAP(__CHR(z->conval->intval)); z->obj = NIL; } else { z = NewOp__29(op, typ, z); @@ -1136,7 +1136,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ) OPB_err(203); r = (LONGREAL)1; } - (*x)->conval->intval = (INT32)__ENTIER(r); + (*x)->conval->intval = __SHORT(__ENTIER(r), 2147483648LL); OPB_SetIntType(*x); } } @@ -1626,6 +1626,7 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode) if (x == y) { } else if ((((y->comp == 2 && y->BaseTyp == x->BaseTyp)) && y->n <= x->n)) { } else if ((y->comp == 3 && y->BaseTyp == x->BaseTyp)) { + OPB_err(113); } else if (x->BaseTyp == OPT_chartyp) { if (g == 8) { if (ynode->conval->intval2 > x->n) { diff --git a/bootstrap/unix-48/OPB.h b/bootstrap/unix-48/OPB.h index 71d82def..f66fcd66 100644 --- a/bootstrap/unix-48/OPB.h +++ b/bootstrap/unix-48/OPB.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPB__h #define OPB__h diff --git a/bootstrap/unix-48/OPC.c b/bootstrap/unix-48/OPC.c index a5f41a8e..7b92ccc1 100644 --- a/bootstrap/unix-48/OPC.c +++ b/bootstrap/unix-48/OPC.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -618,31 +618,33 @@ 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 __", 11); - OPC_Ident(obj); - OPC_DeclareParams(obj->link, 1); - OPM_WriteString((CHAR*)" __SEND(", 9); - if (obj->link->typ->form == 11) { - OPM_WriteString((CHAR*)"__TYPEOF(", 10); - OPC_Ident(obj->link); + if ((obj->mode == 13 && obj == OPC_BaseTProc(obj))) { + if (OPM_currFile == 1 || (OPM_currFile == 0 && obj->vis == 1)) { + OPM_WriteString((CHAR*)"#define __", 11); + OPC_Ident(obj); + OPC_DeclareParams(obj->link, 1); + OPM_WriteString((CHAR*)" __SEND(", 9); + if (obj->link->typ->form == 11) { + OPM_WriteString((CHAR*)"__TYPEOF(", 10); + OPC_Ident(obj->link); + OPM_Write(')'); + } else { + OPC_Ident(obj->link); + OPM_WriteString((CHAR*)"__typ", 6); + } + OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16)); + if (obj->typ == OPT_notyp) { + OPM_WriteString((CHAR*)"void", 5); + } else { + OPC_Ident(obj->typ->strobj); + } + OPM_WriteString((CHAR*)"(*)", 4); + OPC_AnsiParamList(obj->link, 0); + OPM_WriteString((CHAR*)", ", 3); + OPC_DeclareParams(obj->link, 1); OPM_Write(')'); - } else { - OPC_Ident(obj->link); - OPM_WriteString((CHAR*)"__typ", 6); + OPM_WriteLn(); } - OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16)); - if (obj->typ == OPT_notyp) { - OPM_WriteString((CHAR*)"void", 5); - } else { - OPC_Ident(obj->typ->strobj); - } - OPM_WriteString((CHAR*)"(*)", 4); - OPC_AnsiParamList(obj->link, 0); - OPM_WriteString((CHAR*)", ", 3); - OPC_DeclareParams(obj->link, 1); - OPM_Write(')'); - OPM_WriteLn(); } OPC_DefineTProcMacros(obj->right, &*empty); } @@ -652,7 +654,7 @@ static void OPC_DefineType (OPT_Struct str) { OPT_Object obj = NIL, field = NIL, par = NIL; BOOLEAN empty; - if (OPM_currFile == 1 || str->ref < 255) { + if ((OPM_currFile == 1 || str->ref < 255) || (((OPM_currFile == 0 && str->strobj != NIL)) && str->strobj->vis == 1)) { obj = str->strobj; if (obj == NIL || OPC_Undefined(obj)) { if (obj != NIL) { @@ -681,6 +683,10 @@ static void OPC_DefineType (OPT_Struct str) OPC_DefineType(str->BaseTyp); } } else if (__IN(str->comp, 0x0c, 32)) { + if ((str->BaseTyp->strobj != NIL && str->BaseTyp->strobj->linkadr == 1)) { + OPM_Mark(244, str->txtpos); + str->BaseTyp->strobj->linkadr = 2; + } OPC_DefineType(str->BaseTyp); } else if (str->form == 12) { if (str->BaseTyp != OPT_notyp) { @@ -715,6 +721,13 @@ static void OPC_DefineType (OPT_Struct str) if (!empty) { OPM_WriteLn(); } + } else if ((obj->typ->form == 11 && obj->typ->BaseTyp->comp == 4)) { + empty = 1; + OPC_DeclareTProcs(obj->typ->BaseTyp->link, &empty); + OPC_DefineTProcMacros(obj->typ->BaseTyp->link, &empty); + if (!empty) { + OPM_WriteLn(); + } } } } @@ -1138,7 +1151,7 @@ static void OPC_GenHeaderMsg (void) OPM_WriteString((CHAR*)"/* ", 4); OPM_WriteString((CHAR*)"voc", 4); OPM_Write(' '); - OPM_WriteString(Configuration_versionLong, 75); + OPM_WriteString(Configuration_versionLong, 76); OPM_Write(' '); i = 0; while (i <= 31) { @@ -1739,7 +1752,7 @@ static void OPC_CharacterLiteral (INT64 c) if ((c == 92 || c == 39) || c == 63) { OPM_Write('\\'); } - OPM_Write((CHAR)c); + OPM_Write(__CHR(c)); OPM_Write('\''); } } @@ -1755,16 +1768,16 @@ static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l) c = (INT16)s[__X(i, s__len)]; if (c < 32 || c > 126) { OPM_Write('\\'); - OPM_Write((CHAR)(48 + __ASHR(c, 6))); + OPM_Write(__CHR(48 + __ASHR(c, 6))); c = __MASK(c, -64); - OPM_Write((CHAR)(48 + __ASHR(c, 3))); + OPM_Write(__CHR(48 + __ASHR(c, 3))); c = __MASK(c, -8); - OPM_Write((CHAR)(48 + c)); + OPM_Write(__CHR(48 + c)); } else { if ((c == 92 || c == 34) || c == 63) { OPM_Write('\\'); } - OPM_Write((CHAR)c); + OPM_Write(__CHR(c)); } i += 1; } @@ -1830,6 +1843,12 @@ void OPC_IntLiteral (INT64 n, INT32 size) void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim) { + INT64 d; + d = dim; + while (d > 0) { + array = array->BaseTyp; + d -= 1; + } if (array->comp == 3) { OPC_CompleteIdent(obj); OPM_WriteString((CHAR*)"__len", 6); @@ -1837,10 +1856,6 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim) OPM_WriteInt(dim); } } else { - while (dim > 0) { - array = array->BaseTyp; - dim -= 1; - } OPM_WriteInt(array->n); } } diff --git a/bootstrap/unix-48/OPC.h b/bootstrap/unix-48/OPC.h index 38a2b01d..3bfd88b8 100644 --- a/bootstrap/unix-48/OPC.h +++ b/bootstrap/unix-48/OPC.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPC__h #define OPC__h diff --git a/bootstrap/unix-48/OPM.c b/bootstrap/unix-48/OPM.c index 8f903e46..bcb39247 100644 --- a/bootstrap/unix-48/OPM.c +++ b/bootstrap/unix-48/OPM.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -19,6 +19,8 @@ typedef CHAR OPM_FileName[32]; +static CHAR OPM_currentComment[256]; +static BOOLEAN OPM_hasComment; static CHAR OPM_SourceFileName[256]; static CHAR OPM_GlobalModel[10]; export CHAR OPM_Model[10]; @@ -27,7 +29,7 @@ export INT16 OPM_AddressSize; static INT16 OPM_GlobalAlignment; export INT16 OPM_Alignment; export UINT32 OPM_GlobalOptions, OPM_Options; -export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; +export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize; export INT64 OPM_MaxIndex; export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; export BOOLEAN OPM_noerr; @@ -59,6 +61,7 @@ static void OPM_FindInstallDir (void); static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos); static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len); export void OPM_Get (CHAR *ch); +export void OPM_GetComment (CHAR *text, ADDRESS text__len); export void OPM_Init (BOOLEAN *done); export void OPM_InitOptions (void); export INT16 OPM_Integer (INT64 n); @@ -82,6 +85,7 @@ static void OPM_ScanOptions (CHAR *s, ADDRESS s__len); static void OPM_ShowLine (INT64 pos); export INT64 OPM_SignedMaximum (INT32 bytecount); export INT64 OPM_SignedMinimum (INT32 bytecount); +export void OPM_StoreComment (CHAR *text, ADDRESS text__len); export void OPM_SymRCh (CHAR *ch); export INT32 OPM_SymRInt (void); export INT64 OPM_SymRInt64 (void); @@ -157,6 +161,36 @@ void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len) __DEL(modname); } +void OPM_StoreComment (CHAR *text, ADDRESS text__len) +{ + INT16 i; + __DUP(text, text__len, CHAR); + i = 0; + while ((i < 255 && text[__X(i, text__len)] != 0x00)) { + OPM_currentComment[__X(i, 256)] = text[__X(i, text__len)]; + i += 1; + } + OPM_currentComment[__X(i, 256)] = 0x00; + OPM_hasComment = 1; + __DEL(text); +} + +void OPM_GetComment (CHAR *text, ADDRESS text__len) +{ + INT16 i; + if (OPM_hasComment) { + i = 0; + while ((((i < text__len && i < 256)) && OPM_currentComment[__X(i, 256)] != 0x00)) { + text[__X(i, text__len)] = OPM_currentComment[__X(i, 256)]; + i += 1; + } + text[__X(i, text__len)] = 0x00; + OPM_hasComment = 0; + } else { + text[0] = 0x00; + } +} + INT64 OPM_SignedMaximum (INT32 bytecount) { INT64 result; @@ -272,7 +306,7 @@ BOOLEAN OPM_OpenPar (void) if (Modules_ArgCount == 1) { OPM_LogWLn(); OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20); - OPM_LogWStr(Configuration_versionLong, 75); + OPM_LogWStr(Configuration_versionLong, 76); OPM_LogW('.'); OPM_LogWLn(); OPM_LogWStr((CHAR*)"Based on Ofront by J. Templ and Software Templ OEG.", 52); @@ -338,7 +372,7 @@ BOOLEAN OPM_OpenPar (void) OPM_LogWLn(); OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95); OPM_LogWLn(); - OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); + OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER and SET, 64 bit LONGINT.", 95); OPM_LogWLn(); OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); OPM_LogWLn(); @@ -410,21 +444,25 @@ void OPM_InitOptions (void) OPM_ShortintSize = 1; OPM_IntegerSize = 2; OPM_LongintSize = 4; + OPM_SetSize = 4; break; case 'C': OPM_ShortintSize = 2; OPM_IntegerSize = 4; OPM_LongintSize = 8; + OPM_SetSize = 4; break; case 'V': OPM_ShortintSize = 1; OPM_IntegerSize = 4; OPM_LongintSize = 8; + OPM_SetSize = 8; break; default: OPM_ShortintSize = 1; OPM_IntegerSize = 2; OPM_LongintSize = 4; + OPM_SetSize = 4; break; } __MOVE(OPM_InstallDir, OPM_ResourceDir, 1024); @@ -606,7 +644,7 @@ static void OPM_ShowLine (INT64 pos) if (pos >= (INT64)OPM_ErrorLineLimitPos) { pos = OPM_ErrorLineLimitPos - 1; } - i = (INT16)OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos); + i = __SHORTF(OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos), 32768); while (i > 0) { OPM_LogW(' '); i -= 1; @@ -759,7 +797,7 @@ void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done) Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, 0); Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&tag); Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ver); - if (tag != 0xf7 || ver != 0x83) { + if (tag != 0xf7 || ver != 0x84) { if (!__IN(4, OPM_Options, 32)) { OPM_err(-306); } @@ -830,7 +868,7 @@ void OPM_NewSym (CHAR *modName, ADDRESS modName__len) if (OPM_newSFile != NIL) { Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, 0); Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7); - Files_Write(&OPM_newSF, Files_Rider__typ, 0x83); + Files_Write(&OPM_newSF, Files_Rider__typ, 0x84); } else { OPM_err(153); } @@ -865,17 +903,17 @@ void OPM_WriteHex (INT64 i) { CHAR s[3]; INT32 digit; - digit = __ASHR((INT32)i, 4); + digit = __ASHR(__SHORT(i, 2147483648LL), 4); if (digit < 10) { - s[0] = (CHAR)(48 + digit); + s[0] = __CHR(48 + digit); } else { - s[0] = (CHAR)(87 + digit); + s[0] = __CHR(87 + digit); } - digit = __MASK((INT32)i, -16); + digit = __MASK(__SHORT(i, 2147483648LL), -16); if (digit < 10) { - s[1] = (CHAR)(48 + digit); + s[1] = __CHR(48 + digit); } else { - s[1] = (CHAR)(87 + digit); + s[1] = __CHR(87 + digit); } s[2] = 0x00; OPM_WriteString(s, 3); @@ -897,11 +935,11 @@ void OPM_WriteInt (INT64 i) __MOVE("LL", s, 3); k = 2; } - s[__X(k, 26)] = (CHAR)(__MOD(i1, 10) + 48); + s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48); i1 = __DIV(i1, 10); k += 1; while (i1 > 0) { - s[__X(k, 26)] = (CHAR)(__MOD(i1, 10) + 48); + s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48); i1 = __DIV(i1, 10); k += 1; } @@ -924,13 +962,13 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx) CHAR s[32]; CHAR ch; INT16 i; - if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == ((INT32)__ENTIER(r)))) { + if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == (__SHORT(__ENTIER(r), 2147483648LL)))) { if (suffx == 'f') { OPM_WriteString((CHAR*)"(REAL)", 7); } else { OPM_WriteString((CHAR*)"(LONGREAL)", 11); } - OPM_WriteInt((INT32)__ENTIER(r)); + OPM_WriteInt(__SHORT(__ENTIER(r), 2147483648LL)); } else { Texts_OpenWriter(&W, Texts_Writer__typ); if (suffx == 'f') { @@ -1139,5 +1177,7 @@ export void *OPM__init(void) OPM_MinReal = -OPM_MaxReal; OPM_MinLReal = -OPM_MaxLReal; OPM_FindInstallDir(); + OPM_hasComment = 0; + OPM_currentComment[0] = 0x00; __ENDMOD; } diff --git a/bootstrap/unix-48/OPM.h b/bootstrap/unix-48/OPM.h index 96318bea..64c15a28 100644 --- a/bootstrap/unix-48/OPM.h +++ b/bootstrap/unix-48/OPM.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPM__h #define OPM__h @@ -9,7 +9,7 @@ import CHAR OPM_Model[10]; import INT16 OPM_AddressSize, OPM_Alignment; import UINT32 OPM_GlobalOptions, OPM_Options; -import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; +import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize; import INT64 OPM_MaxIndex; import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; import BOOLEAN OPM_noerr; @@ -30,6 +30,7 @@ import void OPM_FPrintLReal (INT32 *fp, LONGREAL val); import void OPM_FPrintReal (INT32 *fp, REAL val); import void OPM_FPrintSet (INT32 *fp, UINT64 val); import void OPM_Get (CHAR *ch); +import void OPM_GetComment (CHAR *text, ADDRESS text__len); import void OPM_Init (BOOLEAN *done); import void OPM_InitOptions (void); import INT16 OPM_Integer (INT64 n); @@ -48,6 +49,7 @@ import BOOLEAN OPM_OpenPar (void); import void OPM_RegisterNewSym (void); import INT64 OPM_SignedMaximum (INT32 bytecount); import INT64 OPM_SignedMinimum (INT32 bytecount); +import void OPM_StoreComment (CHAR *text, ADDRESS text__len); import void OPM_SymRCh (CHAR *ch); import INT32 OPM_SymRInt (void); import INT64 OPM_SymRInt64 (void); diff --git a/bootstrap/unix-48/OPP.c b/bootstrap/unix-48/OPP.c index ec4ad2be..ad4a370a 100644 --- a/bootstrap/unix-48/OPP.c +++ b/bootstrap/unix-48/OPP.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -634,7 +634,7 @@ static void OPP_StandProcCall (OPT_Node *x) OPT_Node y = NIL; INT8 m; INT16 n; - m = (INT8)((INT16)(*x)->obj->adr); + m = __SHORT(__SHORT((*x)->obj->adr, 32768), 128); n = 0; if (OPP_sym == 30) { OPS_Get(&OPP_sym); @@ -943,7 +943,7 @@ static void GetCode__19 (void) (*ext)[__X(n + 1, 256)] = OPS_str[__X(n, 256)]; n += 1; } - (*ext)[0] = (CHAR)n; + (*ext)[0] = __CHR(n); OPS_Get(&OPP_sym); } else { for (;;) { @@ -956,14 +956,14 @@ static void GetCode__19 (void) n = 1; } OPS_Get(&OPP_sym); - (*ext)[__X(n, 256)] = (CHAR)c; + (*ext)[__X(n, 256)] = __CHR(c); } if (OPP_sym == 19) { OPS_Get(&OPP_sym); } else if (OPP_sym == 35) { OPP_err(19); } else { - (*ext)[0] = (CHAR)n; + (*ext)[0] = __CHR(n); break; } } diff --git a/bootstrap/unix-48/OPP.h b/bootstrap/unix-48/OPP.h index aa076aaa..3d8cefe8 100644 --- a/bootstrap/unix-48/OPP.h +++ b/bootstrap/unix-48/OPP.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPP__h #define OPP__h diff --git a/bootstrap/unix-48/OPS.c b/bootstrap/unix-48/OPS.c index bf9f1af5..a25a2c12 100644 --- a/bootstrap/unix-48/OPS.c +++ b/bootstrap/unix-48/OPS.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -56,11 +56,11 @@ static void OPS_Str (INT8 *sym) OPS_err(241); break; } - OPS_str[i] = OPS_ch; + OPS_str[__X(i, 256)] = OPS_ch; i += 1; } OPM_Get(&OPS_ch); - OPS_str[i] = 0x00; + OPS_str[__X(i, 256)] = 0x00; OPS_intval = i + 1; if (OPS_intval == 2) { *sym = 35; @@ -76,7 +76,7 @@ static void OPS_Identifier (INT8 *sym) INT16 i; i = 0; do { - OPS_name[i] = OPS_ch; + OPS_name[__X(i, 256)] = 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)); @@ -84,7 +84,7 @@ static void OPS_Identifier (INT8 *sym) OPS_err(240); i -= 1; } - OPS_name[i] = 0x00; + OPS_name[__X(i, 256)] = 0x00; *sym = 38; } @@ -143,7 +143,7 @@ static void OPS_Number (void) 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; + dig[__X(n, 24)] = OPS_ch; n += 1; } m += 1; @@ -173,7 +173,7 @@ static void OPS_Number (void) OPS_numtyp = 1; if (n <= 2) { while (i < n) { - OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1); + OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[__X(i, 24)], 1); i += 1; } } else { @@ -187,7 +187,7 @@ static void OPS_Number (void) OPS_intval = -1; } while (i < n) { - OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1); + OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[__X(i, 24)], 1); i += 1; } } else { @@ -196,7 +196,7 @@ static void OPS_Number (void) } else { OPS_numtyp = 2; while (i < n) { - d = Ord__7(dig[i], 0); + d = Ord__7(dig[__X(i, 24)], 0); i += 1; if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) { OPS_intval = OPS_intval * 10 + (INT64)d; @@ -214,7 +214,7 @@ static void OPS_Number (void) expCh = 'E'; while (n > 0) { n -= 1; - f = (Ord__7(dig[n], 0) + f) / (LONGREAL)(LONGREAL)10; + f = (Ord__7(dig[__X(n, 24)], 0) + f) / (LONGREAL)(LONGREAL)10; } if (OPS_ch == 'E' || OPS_ch == 'D') { expCh = OPS_ch; @@ -279,32 +279,74 @@ static void Comment__2 (void); static void Comment__2 (void) { + BOOLEAN isExported; + CHAR commentText[256]; + INT16 i, nestLevel; + CHAR prevCh, nextCh; + i = 0; + while (i <= 255) { + commentText[__X(i, 256)] = 0x00; + i += 1; + } + isExported = 0; + i = 0; + nestLevel = 1; + prevCh = 0x00; OPM_Get(&OPS_ch); - for (;;) { - for (;;) { - while (OPS_ch == '(') { + if (OPS_ch == '*') { + isExported = 1; + OPM_Get(&OPS_ch); + if (OPS_ch == ')') { + commentText[0] = 0x00; + OPM_StoreComment(commentText, 256); + OPM_Get(&OPS_ch); + return; + } + } + while ((nestLevel > 0 && OPS_ch != 0x00)) { + if ((prevCh == '(' && OPS_ch == '*')) { + nestLevel += 1; + prevCh = 0x00; + } else if ((prevCh == '*' && OPS_ch == ')')) { + nestLevel -= 1; + if (nestLevel == 0) { OPM_Get(&OPS_ch); - if (OPS_ch == '*') { - Comment__2(); + } else { + prevCh = 0x00; + } + } else { + if ((((isExported && nestLevel == 1)) && prevCh != 0x00)) { + if (i < 255) { + commentText[__X(i, 256)] = prevCh; + i += 1; } } - if (OPS_ch == '*') { - OPM_Get(&OPS_ch); - break; - } - if (OPS_ch == 0x00) { - break; - } + prevCh = OPS_ch; + } + if (nestLevel > 0) { OPM_Get(&OPS_ch); } - if (OPS_ch == ')') { - OPM_Get(&OPS_ch); - break; + } + if (OPS_ch == 0x00) { + OPS_err(5); + } + if ((((((isExported && nestLevel == 0)) && prevCh != 0x00)) && prevCh != '*')) { + if (i < 255) { + commentText[__X(i, 256)] = prevCh; + i += 1; + } else { + OPM_LogWStr((CHAR*)"Truncating final comment character", 35); + OPM_LogWLn(); } - if (OPS_ch == 0x00) { - OPS_err(5); - break; + } + if (isExported) { + if (i >= 256) { + OPM_LogWStr((CHAR*)"Warning: commentText overflow", 30); + OPM_LogWLn(); + i = 255; } + commentText[__X(i, 256)] = 0x00; + OPM_StoreComment(commentText, 256); } } diff --git a/bootstrap/unix-48/OPS.h b/bootstrap/unix-48/OPS.h index 09a33705..19e222ac 100644 --- a/bootstrap/unix-48/OPS.h +++ b/bootstrap/unix-48/OPS.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPS__h #define OPS__h diff --git a/bootstrap/unix-48/OPT.c b/bootstrap/unix-48/OPT.c index 0002aa51..ebb47dd8 100644 --- a/bootstrap/unix-48/OPT.c +++ b/bootstrap/unix-48/OPT.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -83,6 +83,7 @@ typedef OPT_Const conval; INT32 adr, linkadr; INT16 x; + OPT_ConstExt comment; } OPT_ObjDesc; typedef @@ -173,6 +174,7 @@ 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_OutTruncatedName (CHAR *text, ADDRESS text__len); export OPT_Struct OPT_SetType (INT32 size); export OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir); export INT32 OPT_SizeAlignment (INT32 size); @@ -352,7 +354,7 @@ void OPT_TypSize (OPT_Struct typ) } typ->size = offset; typ->align = base; - typ->sysflag = __MASK(typ->sysflag, -256) + (INT16)__ASHL(offset - off0, 8); + typ->sysflag = __MASK(typ->sysflag, -256) + __SHORT(__ASHL(offset - off0, 8), 32768); } else if (c == 2) { OPT_TypSize(typ->BaseTyp); typ->size = typ->n * typ->BaseTyp->size; @@ -388,6 +390,10 @@ OPT_Object OPT_NewObj (void) { OPT_Object obj = NIL; __NEW(obj, OPT_ObjDesc); + obj->typ = NIL; + obj->conval = NIL; + obj->comment = NIL; + obj->name[0] = 0x00; return obj; } @@ -554,6 +560,8 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj) OPT_Object ob0 = NIL, ob1 = NIL; BOOLEAN left; INT8 mnolev; + CHAR commentText[256]; + INT16 j; ob0 = OPT_topScope; ob1 = ob0->right; left = 0; @@ -585,6 +593,16 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj) __COPY(name, ob1->name, 256); mnolev = OPT_topScope->mnolev; ob1->mnolev = mnolev; + OPM_GetComment((void*)commentText, 256); + if (commentText[0] != 0x00) { + ob1->comment = __NEWARR(NIL, 1, 1, 1, 0, 256); + j = 0; + while ((j < 255 && commentText[__X(j, 256)] != 0x00)) { + (*ob1->comment)[__X(j, 256)] = commentText[__X(j, 256)]; + j += 1; + } + (*ob1->comment)[__X(j, 256)] = 0x00; + } break; } } @@ -1103,6 +1121,13 @@ static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par) tag = OPM_SymRInt(); last = NIL; while (tag != 18) { + if (tag < 0 || tag > 100) { + OPM_LogWStr((CHAR*)"ERROR: Invalid tag value in InSign: ", 37); + OPM_LogWNum(tag, 0); + OPM_LogWLn(); + OPM_err(155); + return; + } new = OPT_NewObj(); new->mnolev = -mno; if (last == NIL) { @@ -1251,7 +1276,7 @@ static void OPT_InStruct (OPT_Struct *typ) obj->vis = 0; tag = OPM_SymRInt(); if (tag == 35) { - (*typ)->sysflag = (INT16)OPM_SymRInt(); + (*typ)->sysflag = __SHORTF(OPM_SymRInt(), 32768); tag = OPM_SymRInt(); } switch (tag) { @@ -1381,7 +1406,37 @@ static OPT_Object OPT_InObj (INT8 mno) OPT_Struct typ = NIL; INT32 tag; OPT_ConstExt ext = NIL; + OPS_Name commentText; + BOOLEAN hasComment; + INT16 j; + INT32 len; tag = OPT_impCtxt.nextTag; + hasComment = 0; + while (tag == 41) { + len = OPM_SymRInt(); + if (len < 0) { + len = 0; + } + if (len > 255) { + len = 255; + } + i = 0; + while (i < len) { + OPM_SymRCh(&commentText[__X(i, 256)]); + i += 1; + } + commentText[__X(i, 256)] = 0x00; + hasComment = 1; + tag = OPM_SymRInt(); + } + OPT_impCtxt.nextTag = tag; + if (tag < 0 || tag > 50) { + OPM_LogWStr((CHAR*)"ERROR: Invalid tag in InObj: ", 30); + OPM_LogWNum(tag, 0); + OPM_LogWLn(); + OPM_err(155); + return NIL; + } if (tag == 19) { OPT_InStruct(&typ); obj = typ->strobj; @@ -1397,7 +1452,7 @@ static OPT_Object OPT_InObj (INT8 mno) obj->conval = OPT_NewConst(); OPT_InConstant(tag, obj->conval); obj->typ = OPT_InTyp(tag); - } else if (tag >= 31) { + } else if ((tag >= 31 && tag <= 33)) { obj->conval = OPT_NewConst(); obj->conval->intval = -1; OPT_InSign(mno, &obj->typ, &obj->link); @@ -1412,8 +1467,8 @@ static OPT_Object OPT_InObj (INT8 mno) obj->mode = 9; ext = OPT_NewExt(); obj->conval->ext = ext; - s = (INT16)OPM_SymRInt(); - (*ext)[0] = (CHAR)s; + s = __SHORTF(OPM_SymRInt(), 32768); + (*ext)[0] = __CHR(s); i = 1; while (i <= s) { OPM_SymRCh(&(*ext)[__X(i, 256)]); @@ -1424,20 +1479,37 @@ static OPT_Object OPT_InObj (INT8 mno) OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", 32); OPM_LogWNum(tag, 0); OPM_LogWLn(); + OPM_err(155); + return NIL; break; } } else if (tag == 20) { obj->mode = 5; OPT_InStruct(&obj->typ); - } else { + } else if (tag == 21 || tag == 22) { obj->mode = 1; if (tag == 22) { obj->vis = 2; } OPT_InStruct(&obj->typ); + } else { + OPM_LogWStr((CHAR*)"ERROR: Unexpected tag in InObj: ", 33); + OPM_LogWNum(tag, 0); + OPM_LogWLn(); + OPM_err(155); + return NIL; } OPT_InName((void*)obj->name, 256); } + if ((hasComment && obj != NIL)) { + obj->comment = __NEWARR(NIL, 1, 1, 1, 0, 256); + j = 0; + while ((((j < 255 && j < len)) && commentText[__X(j, 256)] != 0x00)) { + (*obj->comment)[__X(j, 256)] = commentText[__X(j, 256)]; + j += 1; + } + (*obj->comment)[__X(j, 256)] = 0x00; + } 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); @@ -1752,7 +1824,7 @@ static void OPT_OutConstant (OPT_Object obj) OPM_SymWInt(f); switch (f) { case 2: case 3: - OPM_SymWCh((CHAR)obj->conval->intval); + OPM_SymWCh(__CHR(obj->conval->intval)); break; case 4: OPM_SymWInt(obj->conval->intval); @@ -1780,13 +1852,40 @@ static void OPT_OutConstant (OPT_Object obj) } } +static void OPT_OutTruncatedName (CHAR *text, ADDRESS text__len) +{ + INT16 i; + __DUP(text, text__len, CHAR); + i = 0; + while ((i < 255 && text[__X(i, text__len)] != 0x00)) { + OPM_SymWCh(text[__X(i, text__len)]); + i += 1; + } + OPM_SymWCh(0x00); + __DEL(text); +} + static void OPT_OutObj (OPT_Object obj) { INT16 i, j; OPT_ConstExt ext = NIL; + INT16 k, l; if (obj != NIL) { OPT_OutObj(obj->left); if (__IN(obj->mode, 0x06ea, 32)) { + if (obj->comment != NIL) { + OPM_SymWInt(41); + k = 0; + while ((k < 255 && (*obj->comment)[__X(k, 256)] != 0x00)) { + k += 1; + } + OPM_SymWInt(k); + l = 0; + while (l < k) { + OPM_SymWCh((*obj->comment)[__X(l, 256)]); + l += 1; + } + } if (obj->history == 4) { OPT_FPrintErr(obj, 250); } else if (obj->vis != 0) { @@ -2026,7 +2125,7 @@ static void EnumPtrs(void (*P)(void*)) } __TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 40), {0, -8}}; -__TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 304), {0, 4, 8, 12, 284, 288, -28}}; +__TDESC(OPT_ObjDesc, 1, 7) = {__TDFLDS("ObjDesc", 308), {0, 4, 8, 12, 284, 288, 304, -32}}; __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, diff --git a/bootstrap/unix-48/OPT.h b/bootstrap/unix-48/OPT.h index 63bf2070..cf456af5 100644 --- a/bootstrap/unix-48/OPT.h +++ b/bootstrap/unix-48/OPT.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPT__h #define OPT__h @@ -61,6 +61,7 @@ typedef OPT_Const conval; INT32 adr, linkadr; INT16 x; + OPT_ConstExt comment; } OPT_ObjDesc; typedef diff --git a/bootstrap/unix-48/OPV.c b/bootstrap/unix-48/OPV.c index 8b095ff5..0425b2e0 100644 --- a/bootstrap/unix-48/OPV.c +++ b/bootstrap/unix-48/OPV.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -112,7 +112,7 @@ static void OPV_Stamp (OPS_Name s) i += 2; k = 0; do { - n[__X(k, 10)] = (CHAR)((int)__MOD(j, 10) + 48); + n[__X(k, 10)] = __CHR((int)__MOD(j, 10) + 48); j = __DIV(j, 10); k += 1; } while (!(j == 0)); @@ -317,15 +317,27 @@ static INT16 OPV_Precedence (INT16 class, INT16 subclass, INT16 form, INT16 comp static void OPV_Len (OPT_Node n, INT64 dim) { + INT64 d; + OPT_Struct array = NIL; 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[", 7); - OPM_WriteInt(dim); - OPM_Write(']'); + d = dim; + array = n->typ; + while (d > 0) { + array = array->BaseTyp; + d -= 1; + } + if (array->comp == 3) { + OPV_design(n->left, 10); + OPM_WriteString((CHAR*)"->len[", 7); + OPM_WriteInt(dim); + OPM_Write(']'); + } else { + OPM_WriteInt(array->n); + } } else { OPC_Len(n->obj, n->typ, dim); } @@ -370,6 +382,7 @@ static void OPV_SizeCast (OPT_Node n, INT32 to) OPM_WriteInt(__ASHL(to, 3)); OPM_WriteString((CHAR*)")", 2); } + OPV_Entier(n, 9); } } @@ -381,7 +394,6 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec) if (to == 7) { if (from == 7) { OPV_SizeCast(n, newtype->size); - OPV_Entier(n, 9); } else { OPM_WriteString((CHAR*)"__SETOF(", 9); OPV_Entier(n, -1); @@ -391,7 +403,6 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec) } } else if (to == 4) { OPV_SizeCast(n, newtype->size); - OPV_Entier(n, 9); } else if (to == 3) { if (__IN(2, OPM_Options, 32)) { OPM_WriteString((CHAR*)"__CHR", 6); @@ -1183,7 +1194,7 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x) base = base->BaseTyp; } if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) { - OPC_Ident(base->strobj); + OPC_Andent(base); OPM_WriteString((CHAR*)"__typ", 6); } else if (base->form == 11) { OPM_WriteString((CHAR*)"POINTER__typ", 13); diff --git a/bootstrap/unix-48/OPV.h b/bootstrap/unix-48/OPV.h index c6a107b6..fbabd8f4 100644 --- a/bootstrap/unix-48/OPV.h +++ b/bootstrap/unix-48/OPV.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPV__h #define OPV__h diff --git a/bootstrap/unix-48/Out.c b/bootstrap/unix-48/Out.c index 23d917c7..ce936589 100644 --- a/bootstrap/unix-48/Out.c +++ b/bootstrap/unix-48/Out.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -80,7 +80,7 @@ void Out_String (CHAR *str, ADDRESS str__len) error = Platform_Write(1, (ADDRESS)str, l); } else { __MOVE((ADDRESS)str, (ADDRESS)&Out_buf[__X(Out_in, 128)], l); - Out_in += (INT16)l; + Out_in += __SHORT(l, 32768); } __DEL(str); } @@ -98,11 +98,11 @@ void Out_Int (INT64 x, INT64 n) if (x < 0) { x = -x; } - s[0] = (CHAR)(48 + __MOD(x, 10)); + s[0] = __CHR(48 + __MOD(x, 10)); x = __DIV(x, 10); i = 1; while (x != 0) { - s[__X(i, 22)] = (CHAR)(48 + __MOD(x, 10)); + s[__X(i, 22)] = __CHR(48 + __MOD(x, 10)); x = __DIV(x, 10); i += 1; } @@ -138,9 +138,9 @@ void Out_Hex (INT64 x, INT64 n) x = __ROTL(x, 4, 64); n -= 1; if (__MASK(x, -16) < 10) { - Out_Char((CHAR)(__MASK(x, -16) + 48)); + Out_Char(__CHR(__MASK(x, -16) + 48)); } else { - Out_Char((CHAR)((__MASK(x, -16) - 10) + 65)); + Out_Char(__CHR((__MASK(x, -16) - 10) + 65)); } } } @@ -154,7 +154,7 @@ void Out_Ln (void) static void Out_digit (INT64 n, CHAR *s, ADDRESS s__len, INT16 *i) { *i -= 1; - s[__X(*i, s__len)] = (CHAR)(__MOD(n, 10) + 48); + s[__X(*i, s__len)] = __CHR(__MOD(n, 10) + 48); } static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i) @@ -166,7 +166,7 @@ static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 if (l > *i) { l = *i; } - *i -= (INT16)l; + *i -= __SHORT(l, 32768); j = 0; while (j < l) { s[__X(*i + j, s__len)] = t[__X(j, t__len)]; @@ -248,7 +248,7 @@ static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_) if (nn) { x = -x; } - e = (INT16)__ASHR((e - 1023) * 77, 8); + e = __SHORT(__ASHR((e - 1023) * 77, 8), 32768); if (e >= 0) { x = x / (LONGREAL)Out_Ten(e); } else { diff --git a/bootstrap/unix-48/Out.h b/bootstrap/unix-48/Out.h index e1285046..a72547f4 100644 --- a/bootstrap/unix-48/Out.h +++ b/bootstrap/unix-48/Out.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Out__h #define Out__h diff --git a/bootstrap/unix-48/Platform.c b/bootstrap/unix-48/Platform.c index fa5fada1..befa6033 100644 --- a/bootstrap/unix-48/Platform.c +++ b/bootstrap/unix-48/Platform.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -42,6 +42,8 @@ export BOOLEAN Platform_Inaccessible (INT16 e); export BOOLEAN Platform_Interrupted (INT16 e); export BOOLEAN Platform_IsConsole (INT32 h); export void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d); +export INT16 Platform_MaxNameLength (void); +export INT16 Platform_MaxPathLength (void); export INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h); export BOOLEAN Platform_NoSuchDirectory (INT16 e); export INT32 Platform_OSAllocate (INT32 size); @@ -79,6 +81,7 @@ export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS #include #include #include +#include #include #include #define Platform_EACCES() EACCES @@ -94,6 +97,8 @@ export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS #define Platform_EROFS() EROFS #define Platform_ETIMEDOUT() ETIMEDOUT #define Platform_EXDEV() EXDEV +#define Platform_NAMEMAX() NAME_MAX +#define Platform_PATHMAX() PATH_MAX #define Platform_allocate(size) (ADDRESS)((void*)malloc((size_t)size)) #define Platform_chdir(n, n__len) chdir((char*)n) #define Platform_closefile(fd) close(fd) @@ -178,6 +183,16 @@ BOOLEAN Platform_Interrupted (INT16 e) return e == Platform_EINTR(); } +INT16 Platform_MaxNameLength (void) +{ + return Platform_NAMEMAX(); +} + +INT16 Platform_MaxPathLength (void) +{ + return Platform_PATHMAX(); +} + INT32 Platform_OSAllocate (INT32 size) { return Platform_allocate(size); @@ -189,13 +204,13 @@ void Platform_OSFree (INT32 address) } typedef - CHAR (*EnvPtr__78)[1024]; + CHAR (*EnvPtr__83)[1024]; BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len) { - EnvPtr__78 p = NIL; + EnvPtr__83 p = NIL; __DUP(var, var__len, CHAR); - p = (EnvPtr__78)(ADDRESS)Platform_getenv(var, var__len); + p = (EnvPtr__83)(ADDRESS)Platform_getenv(var, var__len); if (p != NIL) { __COPY(*p, val, val__len); } diff --git a/bootstrap/unix-48/Platform.h b/bootstrap/unix-48/Platform.h index 0b98d7bb..fbeef8c7 100644 --- a/bootstrap/unix-48/Platform.h +++ b/bootstrap/unix-48/Platform.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Platform__h #define Platform__h @@ -40,6 +40,8 @@ import BOOLEAN Platform_Inaccessible (INT16 e); import BOOLEAN Platform_Interrupted (INT16 e); import BOOLEAN Platform_IsConsole (INT32 h); import void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d); +import INT16 Platform_MaxNameLength (void); +import INT16 Platform_MaxPathLength (void); import INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h); import BOOLEAN Platform_NoSuchDirectory (INT16 e); import INT32 Platform_OSAllocate (INT32 size); diff --git a/bootstrap/unix-48/Reals.c b/bootstrap/unix-48/Reals.c index d1eb72f6..512ec2c4 100644 --- a/bootstrap/unix-48/Reals.c +++ b/bootstrap/unix-48/Reals.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -67,9 +67,9 @@ void Reals_SetExpo (REAL *x, INT16 ex) { CHAR c; __GET((ADDRESS)x + 3, c, CHAR); - __PUT((ADDRESS)x + 3, (CHAR)(__ASHL(__ASHR((INT16)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR); + __PUT((ADDRESS)x + 3, __CHR(__ASHL(__ASHR((INT16)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR); __GET((ADDRESS)x + 2, c, CHAR); - __PUT((ADDRESS)x + 2, (CHAR)(__MASK((INT16)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR); + __PUT((ADDRESS)x + 2, __CHR(__MASK((INT16)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR); } INT16 Reals_ExpoL (LONGREAL x) @@ -87,21 +87,21 @@ void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len) } k = 0; if (n > 9) { - i = (INT32)__ENTIER(x / (LONGREAL)(LONGREAL)1000000000); - j = (INT32)__ENTIER(x - i * (LONGREAL)1000000000); + i = __SHORT(__ENTIER(x / (LONGREAL)(LONGREAL)1000000000), 2147483648LL); + j = __SHORT(__ENTIER(x - i * (LONGREAL)1000000000), 2147483648LL); if (j < 0) { j = 0; } while (k < 9) { - d[__X(k, d__len)] = (CHAR)((int)__MOD(j, 10) + 48); + d[__X(k, d__len)] = __CHR((int)__MOD(j, 10) + 48); j = __DIV(j, 10); k += 1; } } else { - i = (INT32)__ENTIER(x); + i = __SHORT(__ENTIER(x), 2147483648LL); } while (k < n) { - d[__X(k, d__len)] = (CHAR)((int)__MOD(i, 10) + 48); + d[__X(k, d__len)] = __CHR((int)__MOD(i, 10) + 48); i = __DIV(i, 10); k += 1; } @@ -115,9 +115,9 @@ void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len) static CHAR Reals_ToHex (INT16 i) { if (i < 10) { - return (CHAR)(i + 48); + return __CHR(i + 48); } else { - return (CHAR)(i + 55); + return __CHR(i + 55); } __RETCHK; } diff --git a/bootstrap/unix-48/Reals.h b/bootstrap/unix-48/Reals.h index 170d1785..93e7fa75 100644 --- a/bootstrap/unix-48/Reals.h +++ b/bootstrap/unix-48/Reals.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Reals__h #define Reals__h diff --git a/bootstrap/unix-48/Strings.c b/bootstrap/unix-48/Strings.c index 225bd40a..4b18812f 100644 --- a/bootstrap/unix-48/Strings.c +++ b/bootstrap/unix-48/Strings.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -6,6 +6,7 @@ #define SET UINT32 #include "SYSTEM.h" +#include "Reals.h" @@ -19,6 +20,8 @@ export INT16 Strings_Length (CHAR *s, ADDRESS s__len); export BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len); export INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos); export void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len); +export void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r); +export void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r); INT16 Strings_Length (CHAR *s, ADDRESS s__len) @@ -31,7 +34,7 @@ INT16 Strings_Length (CHAR *s, ADDRESS s__len) } if (i <= 32767) { __DEL(s); - return (INT16)i; + return __SHORT(i, 32768); } else { __DEL(s); return 32767; @@ -123,7 +126,7 @@ void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHA INT16 len, destLen, i; __DUP(source, source__len, CHAR); len = Strings_Length(source, source__len); - destLen = (INT16)dest__len - 1; + destLen = __SHORT(dest__len, 32768) - 1; if (pos < 0) { pos = 0; } @@ -236,10 +239,135 @@ BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS return __retval; } +void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r) +{ + INT16 p, e; + REAL y, g; + BOOLEAN neg, negE; + __DUP(s, s__len, CHAR); + p = 0; + while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { + p += 1; + } + if (s[__X(p, s__len)] == '-') { + neg = 1; + p += 1; + } else { + neg = 0; + } + while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { + p += 1; + } + y = (REAL)0; + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + y = y * (REAL)10 + ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + if (s[__X(p, s__len)] == '.') { + p += 1; + g = (REAL)1; + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + g = g / (REAL)(REAL)10; + y = y + g * ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + } + if (s[__X(p, s__len)] == 'D' || s[__X(p, s__len)] == 'E') { + p += 1; + e = 0; + if (s[__X(p, s__len)] == '-') { + negE = 1; + p += 1; + } else { + negE = 0; + } + while (s[__X(p, s__len)] == '0') { + p += 1; + } + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + e = e * 10 + ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + if (negE) { + y = y / (REAL)Reals_Ten(e); + } else { + y = y * Reals_Ten(e); + } + } + if (neg) { + y = -y; + } + *r = y; + __DEL(s); +} + +void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r) +{ + INT16 p, e; + LONGREAL y, g; + BOOLEAN neg, negE; + __DUP(s, s__len, CHAR); + p = 0; + while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { + p += 1; + } + if (s[__X(p, s__len)] == '-') { + neg = 1; + p += 1; + } else { + neg = 0; + } + while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { + p += 1; + } + y = (LONGREAL)0; + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + y = y * (LONGREAL)10 + ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + if (s[__X(p, s__len)] == '.') { + p += 1; + g = (LONGREAL)1; + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + g = g / (LONGREAL)(LONGREAL)10; + y = y + g * ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + } + if (s[__X(p, s__len)] == 'D' || s[__X(p, s__len)] == 'E') { + p += 1; + e = 0; + if (s[__X(p, s__len)] == '-') { + negE = 1; + p += 1; + } else { + negE = 0; + } + while (s[__X(p, s__len)] == '0') { + p += 1; + } + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + e = e * 10 + ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + if (negE) { + y = y / (LONGREAL)Reals_Ten(e); + } else { + y = y * Reals_Ten(e); + } + } + if (neg) { + y = -y; + } + *r = y; + __DEL(s); +} + export void *Strings__init(void) { __DEFMOD; + __MODULE_IMPORT(Reals); __REGMOD("Strings", 0); /* BEGIN */ __ENDMOD; diff --git a/bootstrap/unix-48/Strings.h b/bootstrap/unix-48/Strings.h index 4d98f1a3..f0e3ae34 100644 --- a/bootstrap/unix-48/Strings.h +++ b/bootstrap/unix-48/Strings.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Strings__h #define Strings__h @@ -17,6 +17,8 @@ import INT16 Strings_Length (CHAR *s, ADDRESS s__len); import BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len); import INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos); import void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len); +import void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r); +import void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r); import void *Strings__init(void); diff --git a/bootstrap/unix-48/Texts.c b/bootstrap/unix-48/Texts.c index 08ee5129..43c3858f 100644 --- a/bootstrap/unix-48/Texts.c +++ b/bootstrap/unix-48/Texts.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -8,7 +8,6 @@ #include "SYSTEM.h" #include "Files.h" #include "Modules.h" -#include "Out.h" #include "Reals.h" typedef @@ -813,10 +812,10 @@ void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ) if ('9' < ch) { if (('A' <= ch && ch <= 'F')) { hex = 1; - ch = (CHAR)((INT16)ch - 7); + ch = __CHR((INT16)ch - 7); } else if (('a' <= ch && ch <= 'f')) { hex = 1; - ch = (CHAR)((INT16)ch - 39); + ch = __CHR((INT16)ch - 39); } else { break; } @@ -1058,7 +1057,7 @@ void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n) x0 = x; } do { - a[__X(i, 24)] = (CHAR)(__MOD(x0, 10) + 48); + a[__X(i, 24)] = __CHR(__MOD(x0, 10) + 48); x0 = __DIV(x0, 10); i += 1; } while (!(x0 == 0)); @@ -1085,9 +1084,9 @@ void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x) do { y = __MASK(x, -16); if (y < 10) { - a[__X(i, 20)] = (CHAR)(y + 48); + a[__X(i, 20)] = __CHR(y + 48); } else { - a[__X(i, 20)] = (CHAR)(y + 55); + a[__X(i, 20)] = __CHR(y + 55); } x = __ASHR(x, 4); i += 1; @@ -1163,8 +1162,8 @@ void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n) } 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)); + Texts_Write(&*W, W__typ, __CHR(__DIV(e, 10) + 48)); + Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48)); } } @@ -1314,7 +1313,7 @@ void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n) } else { Texts_Write(&*W, W__typ, ' '); } - e = (INT16)__ASHR((e - 1023) * 77, 8); + e = __SHORT(__ASHR((e - 1023) * 77, 8), 32768); if (e >= 0) { x = x / (LONGREAL)Reals_TenL(e); } else { @@ -1345,10 +1344,10 @@ void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n) } else { Texts_Write(&*W, W__typ, '+'); } - Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 100) + 48)); + Texts_Write(&*W, W__typ, __CHR(__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)); + Texts_Write(&*W, W__typ, __CHR(__DIV(e, 10) + 48)); + Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48)); } } @@ -1375,8 +1374,8 @@ static void WritePair__44 (CHAR ch, INT32 x); static void WritePair__44 (CHAR ch, INT32 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)((int)__MOD(x, 10) + 48)); + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, __CHR(__DIV(x, 10) + 48)); + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, __CHR((int)__MOD(x, 10) + 48)); } void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d) @@ -1810,7 +1809,6 @@ export void *Texts__init(void) __DEFMOD; __MODULE_IMPORT(Files); __MODULE_IMPORT(Modules); - __MODULE_IMPORT(Out); __MODULE_IMPORT(Reals); __REGMOD("Texts", EnumPtrs); __INITYP(Texts_FontDesc, Texts_FontDesc, 0); diff --git a/bootstrap/unix-48/Texts.h b/bootstrap/unix-48/Texts.h index 5d3316e2..fd0c0fa5 100644 --- a/bootstrap/unix-48/Texts.h +++ b/bootstrap/unix-48/Texts.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Texts__h #define Texts__h diff --git a/bootstrap/unix-48/VT100.c b/bootstrap/unix-48/VT100.c index 9cd5cf4d..346fb37b 100644 --- a/bootstrap/unix-48/VT100.c +++ b/bootstrap/unix-48/VT100.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -34,6 +34,7 @@ static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len); export void VT100_HVP (INT16 n, INT16 m); export void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len); export void VT100_RCP (void); +export void VT100_Reset (void); static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end); export void VT100_SCP (void); export void VT100_SD (INT16 n); @@ -74,7 +75,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len) } e = s; do { - b[__X(e, 21)] = (CHAR)((int)__MOD(int_, 10) + 48); + b[__X(e, 21)] = __CHR((int)__MOD(int_, 10) + 48); int_ = __DIV(int_, 10); e += 1; } while (!(int_ == 0)); @@ -136,6 +137,15 @@ static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len) __DEL(letter); } +void VT100_Reset (void) +{ + CHAR cmd[6]; + __COPY("\033", cmd, 6); + Strings_Append((CHAR*)"c", 2, (void*)cmd, 6); + Out_String(cmd, 6); + Out_Ln(); +} + void VT100_CUU (INT16 n) { VT100_EscSeq(n, (CHAR*)"A", 2); @@ -256,6 +266,7 @@ export void *VT100__init(void) __REGCMD("DECTCEMh", VT100_DECTCEMh); __REGCMD("DECTCEMl", VT100_DECTCEMl); __REGCMD("RCP", VT100_RCP); + __REGCMD("Reset", VT100_Reset); __REGCMD("SCP", VT100_SCP); /* BEGIN */ __COPY("\033", VT100_CSI, 5); diff --git a/bootstrap/unix-48/VT100.h b/bootstrap/unix-48/VT100.h index 8f60c652..4e708647 100644 --- a/bootstrap/unix-48/VT100.h +++ b/bootstrap/unix-48/VT100.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef VT100__h #define VT100__h @@ -25,6 +25,7 @@ import void VT100_EL (INT16 n); import void VT100_HVP (INT16 n, INT16 m); import void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len); import void VT100_RCP (void); +import void VT100_Reset (void); import void VT100_SCP (void); import void VT100_SD (INT16 n); import void VT100_SGR (INT16 n); diff --git a/bootstrap/unix-48/extTools.c b/bootstrap/unix-48/extTools.c index fa840303..ce2fc413 100644 --- a/bootstrap/unix-48/extTools.c +++ b/bootstrap/unix-48/extTools.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -7,18 +7,22 @@ #include "SYSTEM.h" #include "Configuration.h" +#include "Heap.h" #include "Modules.h" #include "OPM.h" #include "Out.h" #include "Platform.h" #include "Strings.h" +typedef + CHAR extTools_CommandString[4096]; -static CHAR extTools_CFLAGS[1023]; + +static extTools_CommandString extTools_CFLAGS; export void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len); -static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len); +static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len, CHAR *additionalopts, ADDRESS additionalopts__len); export void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len); static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRESS cmd__len); @@ -26,14 +30,17 @@ static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRES static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRESS cmd__len) { INT16 r, status, exitcode; + extTools_CommandString fullcmd; __DUP(title, title__len, CHAR); __DUP(cmd, cmd__len, CHAR); if (__IN(18, OPM_Options, 32)) { - Out_String(title, title__len); + Out_String((CHAR*)" ", 3); Out_String(cmd, cmd__len); Out_Ln(); } - r = Platform_System(cmd, cmd__len); + __COPY(cmd, fullcmd, 4096); + Heap_GC(0); + r = Platform_System(fullcmd, 4096); status = __MASK(r, -128); exitcode = __ASHR(r, 8); if (exitcode > 127) { @@ -63,50 +70,55 @@ static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRES __DEL(cmd); } -static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len) +static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len, CHAR *additionalopts, ADDRESS additionalopts__len) { - __COPY("gcc -g", s, s__len); + __DUP(additionalopts, additionalopts__len, CHAR); + __COPY("gcc -fPIC -g -Wno-stringop-overflow", s, s__len); Strings_Append((CHAR*)" -I \"", 6, (void*)s, s__len); Strings_Append(OPM_ResourceDir, 1024, (void*)s, s__len); Strings_Append((CHAR*)"/include\" ", 11, (void*)s, s__len); - Platform_GetEnv((CHAR*)"CFLAGS", 7, (void*)extTools_CFLAGS, 1023); - Strings_Append(extTools_CFLAGS, 1023, (void*)s, s__len); + Strings_Append(additionalopts, additionalopts__len, (void*)s, s__len); Strings_Append((CHAR*)" ", 2, (void*)s, s__len); + Platform_GetEnv((CHAR*)"CFLAGS", 7, (void*)extTools_CFLAGS, 4096); + Strings_Append(extTools_CFLAGS, 4096, (void*)s, s__len); + Strings_Append((CHAR*)" ", 2, (void*)s, s__len); + __DEL(additionalopts); } void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len) { - CHAR cmd[1023]; + extTools_CommandString cmd; __DUP(moduleName, moduleName__len, CHAR); - extTools_InitialiseCompilerCommand((void*)cmd, 1023); - Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 1023); - Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023); - Strings_Append((CHAR*)".c", 3, (void*)cmd, 1023); - extTools_execute((CHAR*)"C compile: ", 12, cmd, 1023); + extTools_InitialiseCompilerCommand((void*)cmd, 4096, (CHAR*)"", 1); + Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 4096); + Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096); + Strings_Append((CHAR*)".c", 3, (void*)cmd, 4096); + extTools_execute((CHAR*)"C compile: ", 12, cmd, 4096); __DEL(moduleName); } void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len) { - CHAR cmd[1023]; + extTools_CommandString cmd; __DUP(additionalopts, additionalopts__len, CHAR); - extTools_InitialiseCompilerCommand((void*)cmd, 1023); - Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023); - Strings_Append((CHAR*)".c ", 4, (void*)cmd, 1023); - Strings_Append(additionalopts, additionalopts__len, (void*)cmd, 1023); + extTools_InitialiseCompilerCommand((void*)cmd, 4096, additionalopts, additionalopts__len); + Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096); + Strings_Append((CHAR*)".c ", 4, (void*)cmd, 4096); if (statically) { - Strings_Append((CHAR*)" -static", 9, (void*)cmd, 1023); + Strings_Append((CHAR*)" -static", 9, (void*)cmd, 4096); } - Strings_Append((CHAR*)" -o ", 5, (void*)cmd, 1023); - Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023); - Strings_Append((CHAR*)" -L\"", 5, (void*)cmd, 1023); - Strings_Append(OPM_InstallDir, 1024, (void*)cmd, 1023); - Strings_Append((CHAR*)"/lib\"", 6, (void*)cmd, 1023); - Strings_Append((CHAR*)" -l voc", 8, (void*)cmd, 1023); - Strings_Append((CHAR*)"-O", 3, (void*)cmd, 1023); - Strings_Append(OPM_Model, 10, (void*)cmd, 1023); - Strings_Append((CHAR*)"", 1, (void*)cmd, 1023); - extTools_execute((CHAR*)"C compile and link: ", 21, cmd, 1023); + Strings_Append((CHAR*)" -o ", 5, (void*)cmd, 4096); + Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096); + if (!statically || 1) { + Strings_Append((CHAR*)" -L\"", 5, (void*)cmd, 4096); + Strings_Append(OPM_InstallDir, 1024, (void*)cmd, 4096); + Strings_Append((CHAR*)"/lib\"", 6, (void*)cmd, 4096); + Strings_Append((CHAR*)" -lvoc", 7, (void*)cmd, 4096); + Strings_Append((CHAR*)"-O", 3, (void*)cmd, 4096); + Strings_Append(OPM_Model, 10, (void*)cmd, 4096); + Strings_Append((CHAR*)"", 1, (void*)cmd, 4096); + } + extTools_execute((CHAR*)"C compile and link: ", 21, cmd, 4096); __DEL(additionalopts); } @@ -115,6 +127,7 @@ export void *extTools__init(void) { __DEFMOD; __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Heap); __MODULE_IMPORT(Modules); __MODULE_IMPORT(OPM); __MODULE_IMPORT(Out); diff --git a/bootstrap/unix-48/extTools.h b/bootstrap/unix-48/extTools.h index a93b6c85..686f0b4e 100644 --- a/bootstrap/unix-48/extTools.h +++ b/bootstrap/unix-48/extTools.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef extTools__h #define extTools__h diff --git a/bootstrap/unix-88/Compiler.c b/bootstrap/unix-88/Compiler.c index 993c2bac..4460479d 100644 --- a/bootstrap/unix-88/Compiler.c +++ b/bootstrap/unix-88/Compiler.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspamS */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspamS */ #define SHORTINT INT8 #define INTEGER INT16 @@ -89,7 +89,7 @@ static void Compiler_PropagateElementaryTypeSizes (void) OPT_sintobj->typ = OPT_sinttyp; OPT_intobj->typ = OPT_inttyp; OPT_lintobj->typ = OPT_linttyp; - switch (OPM_LongintSize) { + switch (OPM_SetSize) { case 4: OPT_settyp = OPT_set32typ; break; diff --git a/bootstrap/unix-88/Configuration.c b/bootstrap/unix-88/Configuration.c index 80b87b1d..fa87c9de 100644 --- a/bootstrap/unix-88/Configuration.c +++ b/bootstrap/unix-88/Configuration.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -8,7 +8,7 @@ #include "SYSTEM.h" -export CHAR Configuration_versionLong[75]; +export CHAR Configuration_versionLong[76]; @@ -19,6 +19,6 @@ export void *Configuration__init(void) __DEFMOD; __REGMOD("Configuration", 0); /* BEGIN */ - __MOVE("2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75); + __MOVE("2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 76); __ENDMOD; } diff --git a/bootstrap/unix-88/Configuration.h b/bootstrap/unix-88/Configuration.h index cdc285e5..c3c54eed 100644 --- a/bootstrap/unix-88/Configuration.h +++ b/bootstrap/unix-88/Configuration.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Configuration__h #define Configuration__h @@ -6,7 +6,7 @@ #include "SYSTEM.h" -import CHAR Configuration_versionLong[75]; +import CHAR Configuration_versionLong[76]; import void *Configuration__init(void); diff --git a/bootstrap/unix-88/Files.c b/bootstrap/unix-88/Files.c index d4425bbe..57e78310 100644 --- a/bootstrap/unix-88/Files.c +++ b/bootstrap/unix-88/Files.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -26,7 +26,7 @@ typedef Files_BufDesc *Files_Buffer; typedef - CHAR Files_FileName[101]; + CHAR Files_FileName[256]; typedef struct Files_FileDesc { @@ -48,6 +48,7 @@ typedef } Files_Rider; +export INT16 Files_MaxPathLength, Files_MaxNameLength; static Files_FileDesc *Files_files; static INT16 Files_tempno; static CHAR Files_HOME[1024]; @@ -85,6 +86,7 @@ export INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ); export void Files_Purge (Files_File f); export void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); export void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x); +export void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n); export void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x); export void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x); @@ -129,17 +131,17 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode) Out_String((CHAR*)": ", 3); if (f != NIL) { if (f->registerName[0] != 0x00) { - Out_String(f->registerName, 101); + Out_String(f->registerName, 256); } else { - Out_String(f->workName, 101); + Out_String(f->workName, 256); } if (f->fd != 0) { - Out_String((CHAR*)"f.fd = ", 8); + Out_String((CHAR*)", f.fd = ", 10); Out_Int(f->fd, 1); } } if (errcode != 0) { - Out_String((CHAR*)" errcode = ", 12); + Out_String((CHAR*)", errcode = ", 13); Out_Int(errcode, 1); } Out_Ln(); @@ -149,76 +151,75 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode) static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len) { - INT16 i, j; + INT16 i, j, ld, ln; __DUP(dir, dir__len, CHAR); __DUP(name, name__len, CHAR); + ld = Strings_Length(dir, dir__len); + ln = Strings_Length(name, name__len); + while ((ld > 0 && dir[__X(ld - 1, dir__len)] == '/')) { + ld -= 1; + } + if (((ld + ln) + 2) > dest__len) { + Files_Err((CHAR*)"File name too long", 19, NIL, 0); + } i = 0; + while (i < ld) { + dest[__X(i, dest__len)] = dir[__X(i, dir__len)]; + i += 1; + } + if (i > 0) { + dest[__X(i, dest__len)] = '/'; + i += 1; + } 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]; + while (j < ln) { + dest[__X(i, dest__len)] = name[__X(j, name__len)]; i += 1; j += 1; } - dest[i] = 0x00; + dest[__X(i, dest__len)] = 0x00; __DEL(dir); __DEL(name); } static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len) { - INT32 n, i, j; + INT16 i, n; __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; - } + if (finalName[0] == '/') { + __COPY(finalName, name, name__len); + } else { + Files_MakeFileName(Platform_CWD, 256, finalName, finalName__len, (void*)name, name__len); } - j = 0; - while (finalName[j] != 0x00) { - name[i] = finalName[j]; - i += 1; - j += 1; - } - i -= 1; - while (name[i] != '/') { + i = Strings_Length(name, name__len) - 1; + while ((i > 0 && name[__X(i, name__len)] != '/')) { i -= 1; } - name[i + 1] = '.'; - name[i + 2] = 't'; - name[i + 3] = 'm'; - name[i + 4] = 'p'; - name[i + 5] = '.'; + if ((i + 16) >= name__len) { + Files_Err((CHAR*)"File name too long", 19, NIL, 0); + } + Files_tempno += 1; + n = Files_tempno; + name[__X(i + 1, name__len)] = '.'; + name[__X(i + 2, name__len)] = 't'; + name[__X(i + 3, name__len)] = 'm'; + name[__X(i + 4, name__len)] = 'p'; + name[__X(i + 5, name__len)] = '.'; i += 6; while (n > 0) { - name[i] = (CHAR)((int)__MOD(n, 10) + 48); + name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48); n = __DIV(n, 10); i += 1; } - name[i] = '.'; + name[__X(i, name__len)] = '.'; i += 1; n = Platform_PID; while (n > 0) { - name[i] = (CHAR)((int)__MOD(n, 10) + 48); + name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48); n = __DIV(n, 10); i += 1; } - name[i] = 0x00; + name[__X(i, name__len)] = 0x00; __DEL(finalName); } @@ -236,11 +237,11 @@ static void Files_Deregister (CHAR *name, ADDRESS name__len) if (osfile != NIL) { __ASSERT(!osfile->tempFile, 0); __ASSERT(osfile->fd >= 0, 0); - __MOVE(osfile->workName, osfile->registerName, 101); - Files_GetTempName(osfile->registerName, 101, (void*)osfile->workName, 101); + __MOVE(osfile->workName, osfile->registerName, 256); + Files_GetTempName(osfile->registerName, 256, (void*)osfile->workName, 256); osfile->tempFile = 1; osfile->state = 0; - error = Platform_Rename((void*)osfile->registerName, 101, (void*)osfile->workName, 101); + error = Platform_Rename((void*)osfile->registerName, 256, (void*)osfile->workName, 256); if (error != 0) { Files_Err((CHAR*)"Couldn't rename previous version of file being registered", 58, osfile, error); } @@ -256,17 +257,17 @@ static void Files_Create (Files_File f) CHAR err[32]; if (f->fd == -1) { if (f->state == 1) { - Files_GetTempName(f->registerName, 101, (void*)f->workName, 101); + Files_GetTempName(f->registerName, 256, (void*)f->workName, 256); f->tempFile = 1; } else { __ASSERT(f->state == 2, 0); - Files_Deregister(f->registerName, 101); - __MOVE(f->registerName, f->workName, 101); + Files_Deregister(f->registerName, 256); + __MOVE(f->registerName, f->workName, 256); f->registerName[0] = 0x00; f->tempFile = 0; } - error = Platform_Unlink((void*)f->workName, 101); - error = Platform_New((void*)f->workName, 101, &f->fd); + error = Platform_Unlink((void*)f->workName, 256); + error = Platform_New((void*)f->workName, 256, &f->fd); done = error == 0; if (done) { f->next = Files_files; @@ -319,8 +320,8 @@ void Files_Close (Files_File f) 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]); + while ((i < 4 && f->bufs[__X(i, 4)] != NIL)) { + Files_Flush(f->bufs[__X(i, 4)]); i += 1; } } @@ -337,7 +338,7 @@ Files_File Files_New (CHAR *name, ADDRESS name__len) __DUP(name, name__len, CHAR); __NEW(f, Files_FileDesc); f->workName[0] = 0x00; - __COPY(name, f->registerName, 101); + __COPY(name, f->registerName, 256); f->fd = -1; f->state = 1; f->len = 0; @@ -359,35 +360,35 @@ static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len) *pos += 1; } } else { - ch = (Files_SearchPath->data)[*pos]; + ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])]; while (ch == ' ' || ch == ';') { *pos += 1; - ch = (Files_SearchPath->data)[*pos]; + ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])]; } if (ch == '~') { *pos += 1; - ch = (Files_SearchPath->data)[*pos]; - while (Files_HOME[i] != 0x00) { - dir[i] = Files_HOME[i]; + ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])]; + while (Files_HOME[__X(i, 1024)] != 0x00) { + dir[__X(i, dir__len)] = Files_HOME[__X(i, 1024)]; i += 1; } if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) { - while ((i > 0 && dir[i - 1] != '/')) { + while ((i > 0 && dir[__X(i - 1, dir__len)] != '/')) { i -= 1; } } } while ((ch != 0x00 && ch != ';')) { - dir[i] = ch; + dir[__X(i, dir__len)] = ch; i += 1; *pos += 1; - ch = (Files_SearchPath->data)[*pos]; + ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])]; } - while ((i > 0 && dir[i - 1] == ' ')) { + while ((i > 0 && dir[__X(i - 1, dir__len)] == ' ')) { i -= 1; } } - dir[i] = 0x00; + dir[__X(i, dir__len)] = 0x00; } static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len) @@ -398,7 +399,7 @@ static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len) ch = name[0]; while ((ch != 0x00 && ch != '/')) { i += 1; - ch = name[i]; + ch = name[__X(i, name__len)]; } return ch == '/'; } @@ -413,9 +414,9 @@ static Files_File Files_CacheEntry (Platform_FileIdentity 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; + if (f->bufs[__X(i, 4)] != NIL) { + f->bufs[__X(i, 4)]->org = -1; + f->bufs[__X(i, 4)] = NIL; } i += 1; } @@ -482,7 +483,7 @@ Files_File Files_Old (CHAR *name, ADDRESS name__len) f->pos = 0; f->swapper = -1; error = Platform_Size(fd, &f->len); - __COPY(name, f->workName, 101); + __COPY(name, f->workName, 256); f->registerName[0] = 0x00; f->tempFile = 0; f->identity = identity; @@ -514,9 +515,9 @@ void Files_Purge (Files_File f) INT16 error; i = 0; while (i < 4) { - if (f->bufs[i] != NIL) { - f->bufs[i]->org = -1; - f->bufs[i] = NIL; + if (f->bufs[__X(i, 4)] != NIL) { + f->bufs[__X(i, 4)]->org = -1; + f->bufs[__X(i, 4)] = NIL; } i += 1; } @@ -560,22 +561,22 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos) offset = __MASK(pos, -4096); org = pos - offset; i = 0; - while ((((i < 4 && f->bufs[i] != NIL)) && org != f->bufs[i]->org)) { + while ((((i < 4 && f->bufs[__X(i, 4)] != NIL)) && org != f->bufs[__X(i, 4)]->org)) { i += 1; } if (i < 4) { - if (f->bufs[i] == NIL) { + if (f->bufs[__X(i, 4)] == NIL) { __NEW(buf, Files_BufDesc); buf->chg = 0; buf->org = -1; buf->f = f; - f->bufs[i] = buf; + f->bufs[__X(i, 4)] = buf; } else { - buf = f->bufs[i]; + buf = f->bufs[__X(i, 4)]; } } else { f->swapper = __MASK(f->swapper + 1, -4); - buf = f->bufs[f->swapper]; + buf = f->bufs[__X(f->swapper, 4)]; Files_Flush(buf); } if (buf->org != org) { @@ -622,7 +623,7 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x) } Files_Assert(offset <= buf->size); if (offset < buf->size) { - *x = buf->data[offset]; + *x = buf->data[__X(offset, 4096)]; (*r).offset = offset + 1; } else if ((*r).org + offset < buf->f->len) { Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset); @@ -634,6 +635,11 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x) } } +void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x) +{ + Files_Read(&*r, r__typ, &*x); +} + void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n) { INT32 xpos, min, restInBuf, offset; @@ -660,7 +666,7 @@ void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x } else { min = n; } - __MOVE((ADDRESS)&buf->data[offset], (ADDRESS)&x[xpos], min); + __MOVE((ADDRESS)&buf->data[__X(offset, 4096)], (ADDRESS)&x[__X(xpos, x__len)], min); offset += min; (*r).offset = offset; xpos += min; @@ -689,7 +695,7 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x) offset = (*r).offset; } Files_Assert(offset < 4096); - buf->data[offset] = x; + buf->data[__X(offset, 4096)] = x; buf->chg = 1; if (offset == buf->size) { buf->size += 1; @@ -723,7 +729,7 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS } else { min = n; } - __MOVE((ADDRESS)&x[xpos], (ADDRESS)&buf->data[offset], min); + __MOVE((ADDRESS)&x[__X(xpos, x__len)], (ADDRESS)&buf->data[__X(offset, 4096)], min); offset += min; (*r).offset = offset; Files_Assert(offset <= 4096); @@ -817,12 +823,12 @@ void Files_Register (Files_File f) } Files_Close(f); if (f->registerName[0] != 0x00) { - Files_Deregister(f->registerName, 101); - Files_Rename(f->workName, 101, f->registerName, 101, &errcode); + Files_Deregister(f->registerName, 256); + Files_Rename(f->workName, 256, f->registerName, 256, &errcode); if (errcode != 0) { Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode); } - __MOVE(f->registerName, f->workName, 101); + __MOVE(f->registerName, f->workName, 256); f->registerName[0] = 0x00; f->tempFile = 0; } @@ -843,7 +849,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *de j = 0; while (i > 0) { i -= 1; - dest[j] = src[i]; + dest[__X(j, dest__len)] = src[__X(i, src__len)]; j += 1; } } else { @@ -900,7 +906,7 @@ void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len) i = 0; do { Files_Read(&*R, R__typ, (void*)&ch); - x[i] = ch; + x[__X(i, x__len)] = ch; i += 1; } while (!(ch == 0x00)); } @@ -910,16 +916,16 @@ void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len) INT16 i; i = 0; do { - Files_Read(&*R, R__typ, (void*)&x[i]); + Files_Read(&*R, R__typ, (void*)&x[__X(i, x__len)]); i += 1; - } while (!(x[i - 1] == 0x00 || x[i - 1] == 0x0a)); - if (x[i - 1] == 0x0a) { + } while (!(x[__X(i - 1, x__len)] == 0x00 || x[__X(i - 1, x__len)] == 0x0a)); + if (x[__X(i - 1, x__len)] == 0x0a) { i -= 1; } - if ((i > 0 && x[i - 1] == 0x0d)) { + if ((i > 0 && x[__X(i - 1, x__len)] == 0x0d)) { i -= 1; } - x[i] = 0x00; + x[__X(i, x__len)] = 0x00; } void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len) @@ -947,18 +953,18 @@ void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x) void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x) { CHAR b[2]; - b[0] = (CHAR)x; - b[1] = (CHAR)__ASHR(x, 8); + b[0] = __CHR(x); + b[1] = __CHR(__ASHR(x, 8)); Files_WriteBytes(&*R, R__typ, (void*)b, 2, 2); } void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 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); + b[0] = __CHR(x); + b[1] = __CHR(__ASHR(x, 8)); + b[2] = __CHR(__ASHR(x, 16)); + b[3] = __CHR(__ASHR(x, 24)); Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4); } @@ -966,11 +972,13 @@ void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x) { CHAR b[4]; INT32 i; - i = (INT32)x; - b[0] = (CHAR)i; - b[1] = (CHAR)__ASHR(i, 8); - b[2] = (CHAR)__ASHR(i, 16); - b[3] = (CHAR)__ASHR(i, 24); + UINT64 y; + y = x; + i = __VAL(INT32, y); + b[0] = __CHR(i); + b[1] = __CHR(__ASHR(i, 8)); + b[2] = __CHR(__ASHR(i, 16)); + b[3] = __CHR(__ASHR(i, 24)); Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4); } @@ -992,7 +1000,7 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len { INT16 i; i = 0; - while (x[i] != 0x00) { + while (x[__X(i, x__len)] != 0x00) { i += 1; } Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1); @@ -1001,10 +1009,10 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x) { while (x < -64 || x > 63) { - Files_Write(&*R, R__typ, (CHAR)(__MASK(x, -128) + 128)); + Files_Write(&*R, R__typ, __CHR(__MASK(x, -128) + 128)); x = __ASHR(x, 7); } - Files_Write(&*R, R__typ, (CHAR)__MASK(x, -128)); + Files_Write(&*R, R__typ, __CHR(__MASK(x, -128))); } void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len) @@ -1041,7 +1049,7 @@ static void Files_Finalize (SYSTEM_PTR o) if (f->fd >= 0) { Files_CloseOSFile(f); if (f->tempFile) { - res = Platform_Unlink((void*)f->workName, 101); + res = Platform_Unlink((void*)f->workName, 256); } } } @@ -1063,7 +1071,7 @@ static void EnumPtrs(void (*P)(void*)) P(Files_SearchPath); } -__TDESC(Files_FileDesc, 1, 4) = {__TDFLDS("FileDesc", 280), {232, 240, 248, 256, -40}}; +__TDESC(Files_FileDesc, 1, 4) = {__TDFLDS("FileDesc", 592), {544, 552, 560, 568, -40}}; __TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4120), {0, -16}}; __TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 24), {8, -16}}; @@ -1083,5 +1091,7 @@ export void *Files__init(void) Heap_FileCount = 0; Files_HOME[0] = 0x00; Platform_GetEnv((CHAR*)"HOME", 5, (void*)Files_HOME, 1024); + Files_MaxPathLength = Platform_MaxPathLength(); + Files_MaxNameLength = Platform_MaxNameLength(); __ENDMOD; } diff --git a/bootstrap/unix-88/Files.h b/bootstrap/unix-88/Files.h index a34a1758..676f434c 100644 --- a/bootstrap/unix-88/Files.h +++ b/bootstrap/unix-88/Files.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Files__h #define Files__h @@ -11,7 +11,7 @@ typedef typedef struct Files_FileDesc { INT64 _prvt0; - char _prvt1[272]; + char _prvt1[584]; } Files_FileDesc; typedef @@ -23,6 +23,7 @@ typedef } Files_Rider; +import INT16 Files_MaxPathLength, Files_MaxNameLength; import ADDRESS *Files_FileDesc__typ; import ADDRESS *Files_Rider__typ; @@ -40,6 +41,7 @@ import INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ); import void Files_Purge (Files_File f); import void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); import void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x); +import void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); import void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n); import void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x); import void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x); diff --git a/bootstrap/unix-88/Heap.c b/bootstrap/unix-88/Heap.c index aeebff17..7b004b60 100644 --- a/bootstrap/unix-88/Heap.c +++ b/bootstrap/unix-88/Heap.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tsSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -68,9 +68,10 @@ static INT64 Heap_freeList[10]; static INT64 Heap_bigBlocks; export INT64 Heap_allocated; static BOOLEAN Heap_firstTry; +static INT16 Heap_ldUnit; export INT64 Heap_heap; static INT64 Heap_heapMin, Heap_heapMax; -export INT64 Heap_heapsize; +export INT64 Heap_heapsize, Heap_heapMinExpand; static Heap_FinNode Heap_fin; static INT16 Heap_lockdepth; static BOOLEAN Heap_interrupted; @@ -228,10 +229,10 @@ static INT64 Heap_NewChunk (INT64 blksz) static void Heap_ExtendHeap (INT64 blksz) { INT64 size, chnk, j, next; - if (Heap_uLT(320000, blksz)) { + if (Heap_uLT(Heap_heapMinExpand, blksz)) { size = blksz; } else { - size = 320000; + size = Heap_heapMinExpand; } chnk = Heap_NewChunk(size); if (chnk != 0) { @@ -248,6 +249,8 @@ static void Heap_ExtendHeap (INT64 blksz) __PUT(chnk, next, INT64); __PUT(j, chnk, INT64); } + } else if (!Heap_firstTry) { + Heap_heapMinExpand = 32; } } @@ -257,16 +260,16 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag) SYSTEM_PTR new; Heap_Lock(); __GET(tag, blksz, INT64); - i0 = __ASHR(blksz, 5); + i0 = __LSH(blksz, -Heap_ldUnit, 64); i = i0; - if (Heap_uLT(i, 9)) { + if (i < 9) { adr = Heap_freeList[i]; while (adr == 0) { i += 1; adr = Heap_freeList[i]; } } - if (Heap_uLT(i, 9)) { + if (i < 9) { __GET(adr + 24, next, INT64); Heap_freeList[i] = next; if (i != i0) { @@ -289,16 +292,17 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag) if (Heap_firstTry) { Heap_GC(1); blksz += 32; - if (Heap_uLT(Heap_heapsize - Heap_allocated, blksz) || Heap_uLT(__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2), Heap_heapsize)) { - Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 96), 7) - Heap_heapsize); + t = __LSH(Heap_allocated + blksz, -(2 + Heap_ldUnit), 64) * 160; + if (Heap_uLT(Heap_heapsize, t)) { + Heap_ExtendHeap(t - 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); + Heap_ExtendHeap(blksz); new = Heap_NEWREC(tag); } + Heap_firstTry = 1; Heap_Unlock(); return new; } else { @@ -443,7 +447,7 @@ static void Heap_Scan (void) __PUT(start, start + 8, INT64); __PUT(start + 8, freesize, INT64); __PUT(start + 16, -8, INT64); - i = __ASHR(freesize, 5); + i = __LSH(freesize, -Heap_ldUnit, 64); freesize = 0; if (Heap_uLT(i, 9)) { __PUT(start + 24, Heap_freeList[i], INT64); @@ -469,7 +473,7 @@ static void Heap_Scan (void) __PUT(start, start + 8, INT64); __PUT(start + 8, freesize, INT64); __PUT(start + 16, -8, INT64); - i = __ASHR(freesize, 5); + i = __LSH(freesize, -Heap_ldUnit, 64); freesize = 0; if (Heap_uLT(i, 9)) { __PUT(start + 24, Heap_freeList[i], INT64); @@ -661,79 +665,77 @@ void Heap_GC (BOOLEAN markStack) Heap_Module m; INT64 i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23; INT64 cand[10000]; - if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) { - Heap_Lock(); - m = (Heap_Module)(ADDRESS)Heap_modules; - while (m != NIL) { - if (m->enumPtrs != NIL) { - (*m->enumPtrs)(Heap_MarkP); - } - m = m->next; + Heap_Lock(); + m = (Heap_Module)(ADDRESS)Heap_modules; + while (m != NIL) { + if (m->enumPtrs != NIL) { + (*m->enumPtrs)(Heap_MarkP); } - 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(32, (void*)cand, 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(); + 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(32, (void*)cand, 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) @@ -756,6 +758,8 @@ void Heap_InitHeap (void) Heap_heapMin = -1; Heap_heapMax = 0; Heap_bigBlocks = 0; + Heap_heapMinExpand = 256000; + Heap_ldUnit = 5; Heap_heap = Heap_NewChunk(256000); __PUT(Heap_heap, 0, INT64); Heap_firstTry = 1; diff --git a/bootstrap/unix-88/Heap.h b/bootstrap/unix-88/Heap.h index ff1a1b07..45a9c6d2 100644 --- a/bootstrap/unix-88/Heap.h +++ b/bootstrap/unix-88/Heap.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tsSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */ #ifndef Heap__h #define Heap__h @@ -48,7 +48,7 @@ typedef import SYSTEM_PTR Heap_modules; import INT64 Heap_allocated; import INT64 Heap_heap; -import INT64 Heap_heapsize; +import INT64 Heap_heapsize, Heap_heapMinExpand; import INT16 Heap_FileCount; import ADDRESS *Heap_ModuleDesc__typ; diff --git a/bootstrap/unix-88/Modules.c b/bootstrap/unix-88/Modules.c index c66fe5bd..a5b989e5 100644 --- a/bootstrap/unix-88/Modules.c +++ b/bootstrap/unix-88/Modules.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -404,7 +404,7 @@ static void Modules_errint (INT32 l) if (l >= 10) { Modules_errint(__DIV(l, 10)); } - Modules_errch((CHAR)((int)__MOD(l, 10) + 48)); + Modules_errch(__CHR((int)__MOD(l, 10) + 48)); } static void Modules_DisplayHaltCode (INT32 code) diff --git a/bootstrap/unix-88/Modules.h b/bootstrap/unix-88/Modules.h index 5e518753..ee65a938 100644 --- a/bootstrap/unix-88/Modules.h +++ b/bootstrap/unix-88/Modules.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Modules__h #define Modules__h diff --git a/bootstrap/unix-88/OPB.c b/bootstrap/unix-88/OPB.c index 19e40505..913fbf2d 100644 --- a/bootstrap/unix-88/OPB.c +++ b/bootstrap/unix-88/OPB.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -261,7 +261,7 @@ static void OPB_CharToString (OPT_Node n) { CHAR ch; n->typ = OPT_stringtyp; - ch = (CHAR)n->conval->intval; + ch = __CHR(n->conval->intval); n->conval->ext = OPT_NewExt(); if (ch == 0x00) { n->conval->intval2 = 1; @@ -597,7 +597,7 @@ void OPB_MOp (INT8 op, OPT_Node *x) case 22: if (f == 3) { if (z->class == 7) { - z->conval->intval = (INT16)__CAP((CHAR)z->conval->intval); + z->conval->intval = (INT16)__CAP(__CHR(z->conval->intval)); z->obj = NIL; } else { z = NewOp__29(op, typ, z); @@ -1136,7 +1136,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ) OPB_err(203); r = (LONGREAL)1; } - (*x)->conval->intval = (INT32)__ENTIER(r); + (*x)->conval->intval = __SHORT(__ENTIER(r), 2147483648LL); OPB_SetIntType(*x); } } @@ -1626,6 +1626,7 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode) if (x == y) { } else if ((((y->comp == 2 && y->BaseTyp == x->BaseTyp)) && y->n <= x->n)) { } else if ((y->comp == 3 && y->BaseTyp == x->BaseTyp)) { + OPB_err(113); } else if (x->BaseTyp == OPT_chartyp) { if (g == 8) { if (ynode->conval->intval2 > x->n) { diff --git a/bootstrap/unix-88/OPB.h b/bootstrap/unix-88/OPB.h index 71d82def..f66fcd66 100644 --- a/bootstrap/unix-88/OPB.h +++ b/bootstrap/unix-88/OPB.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPB__h #define OPB__h diff --git a/bootstrap/unix-88/OPC.c b/bootstrap/unix-88/OPC.c index a5f41a8e..7b92ccc1 100644 --- a/bootstrap/unix-88/OPC.c +++ b/bootstrap/unix-88/OPC.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -618,31 +618,33 @@ 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 __", 11); - OPC_Ident(obj); - OPC_DeclareParams(obj->link, 1); - OPM_WriteString((CHAR*)" __SEND(", 9); - if (obj->link->typ->form == 11) { - OPM_WriteString((CHAR*)"__TYPEOF(", 10); - OPC_Ident(obj->link); + if ((obj->mode == 13 && obj == OPC_BaseTProc(obj))) { + if (OPM_currFile == 1 || (OPM_currFile == 0 && obj->vis == 1)) { + OPM_WriteString((CHAR*)"#define __", 11); + OPC_Ident(obj); + OPC_DeclareParams(obj->link, 1); + OPM_WriteString((CHAR*)" __SEND(", 9); + if (obj->link->typ->form == 11) { + OPM_WriteString((CHAR*)"__TYPEOF(", 10); + OPC_Ident(obj->link); + OPM_Write(')'); + } else { + OPC_Ident(obj->link); + OPM_WriteString((CHAR*)"__typ", 6); + } + OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16)); + if (obj->typ == OPT_notyp) { + OPM_WriteString((CHAR*)"void", 5); + } else { + OPC_Ident(obj->typ->strobj); + } + OPM_WriteString((CHAR*)"(*)", 4); + OPC_AnsiParamList(obj->link, 0); + OPM_WriteString((CHAR*)", ", 3); + OPC_DeclareParams(obj->link, 1); OPM_Write(')'); - } else { - OPC_Ident(obj->link); - OPM_WriteString((CHAR*)"__typ", 6); + OPM_WriteLn(); } - OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16)); - if (obj->typ == OPT_notyp) { - OPM_WriteString((CHAR*)"void", 5); - } else { - OPC_Ident(obj->typ->strobj); - } - OPM_WriteString((CHAR*)"(*)", 4); - OPC_AnsiParamList(obj->link, 0); - OPM_WriteString((CHAR*)", ", 3); - OPC_DeclareParams(obj->link, 1); - OPM_Write(')'); - OPM_WriteLn(); } OPC_DefineTProcMacros(obj->right, &*empty); } @@ -652,7 +654,7 @@ static void OPC_DefineType (OPT_Struct str) { OPT_Object obj = NIL, field = NIL, par = NIL; BOOLEAN empty; - if (OPM_currFile == 1 || str->ref < 255) { + if ((OPM_currFile == 1 || str->ref < 255) || (((OPM_currFile == 0 && str->strobj != NIL)) && str->strobj->vis == 1)) { obj = str->strobj; if (obj == NIL || OPC_Undefined(obj)) { if (obj != NIL) { @@ -681,6 +683,10 @@ static void OPC_DefineType (OPT_Struct str) OPC_DefineType(str->BaseTyp); } } else if (__IN(str->comp, 0x0c, 32)) { + if ((str->BaseTyp->strobj != NIL && str->BaseTyp->strobj->linkadr == 1)) { + OPM_Mark(244, str->txtpos); + str->BaseTyp->strobj->linkadr = 2; + } OPC_DefineType(str->BaseTyp); } else if (str->form == 12) { if (str->BaseTyp != OPT_notyp) { @@ -715,6 +721,13 @@ static void OPC_DefineType (OPT_Struct str) if (!empty) { OPM_WriteLn(); } + } else if ((obj->typ->form == 11 && obj->typ->BaseTyp->comp == 4)) { + empty = 1; + OPC_DeclareTProcs(obj->typ->BaseTyp->link, &empty); + OPC_DefineTProcMacros(obj->typ->BaseTyp->link, &empty); + if (!empty) { + OPM_WriteLn(); + } } } } @@ -1138,7 +1151,7 @@ static void OPC_GenHeaderMsg (void) OPM_WriteString((CHAR*)"/* ", 4); OPM_WriteString((CHAR*)"voc", 4); OPM_Write(' '); - OPM_WriteString(Configuration_versionLong, 75); + OPM_WriteString(Configuration_versionLong, 76); OPM_Write(' '); i = 0; while (i <= 31) { @@ -1739,7 +1752,7 @@ static void OPC_CharacterLiteral (INT64 c) if ((c == 92 || c == 39) || c == 63) { OPM_Write('\\'); } - OPM_Write((CHAR)c); + OPM_Write(__CHR(c)); OPM_Write('\''); } } @@ -1755,16 +1768,16 @@ static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l) c = (INT16)s[__X(i, s__len)]; if (c < 32 || c > 126) { OPM_Write('\\'); - OPM_Write((CHAR)(48 + __ASHR(c, 6))); + OPM_Write(__CHR(48 + __ASHR(c, 6))); c = __MASK(c, -64); - OPM_Write((CHAR)(48 + __ASHR(c, 3))); + OPM_Write(__CHR(48 + __ASHR(c, 3))); c = __MASK(c, -8); - OPM_Write((CHAR)(48 + c)); + OPM_Write(__CHR(48 + c)); } else { if ((c == 92 || c == 34) || c == 63) { OPM_Write('\\'); } - OPM_Write((CHAR)c); + OPM_Write(__CHR(c)); } i += 1; } @@ -1830,6 +1843,12 @@ void OPC_IntLiteral (INT64 n, INT32 size) void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim) { + INT64 d; + d = dim; + while (d > 0) { + array = array->BaseTyp; + d -= 1; + } if (array->comp == 3) { OPC_CompleteIdent(obj); OPM_WriteString((CHAR*)"__len", 6); @@ -1837,10 +1856,6 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim) OPM_WriteInt(dim); } } else { - while (dim > 0) { - array = array->BaseTyp; - dim -= 1; - } OPM_WriteInt(array->n); } } diff --git a/bootstrap/unix-88/OPC.h b/bootstrap/unix-88/OPC.h index 38a2b01d..3bfd88b8 100644 --- a/bootstrap/unix-88/OPC.h +++ b/bootstrap/unix-88/OPC.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPC__h #define OPC__h diff --git a/bootstrap/unix-88/OPM.c b/bootstrap/unix-88/OPM.c index 143546fd..b486b3b9 100644 --- a/bootstrap/unix-88/OPM.c +++ b/bootstrap/unix-88/OPM.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -19,6 +19,8 @@ typedef CHAR OPM_FileName[32]; +static CHAR OPM_currentComment[256]; +static BOOLEAN OPM_hasComment; static CHAR OPM_SourceFileName[256]; static CHAR OPM_GlobalModel[10]; export CHAR OPM_Model[10]; @@ -27,7 +29,7 @@ export INT16 OPM_AddressSize; static INT16 OPM_GlobalAlignment; export INT16 OPM_Alignment; export UINT32 OPM_GlobalOptions, OPM_Options; -export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; +export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize; export INT64 OPM_MaxIndex; export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; export BOOLEAN OPM_noerr; @@ -59,6 +61,7 @@ static void OPM_FindInstallDir (void); static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos); static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len); export void OPM_Get (CHAR *ch); +export void OPM_GetComment (CHAR *text, ADDRESS text__len); export void OPM_Init (BOOLEAN *done); export void OPM_InitOptions (void); export INT16 OPM_Integer (INT64 n); @@ -82,6 +85,7 @@ static void OPM_ScanOptions (CHAR *s, ADDRESS s__len); static void OPM_ShowLine (INT64 pos); export INT64 OPM_SignedMaximum (INT32 bytecount); export INT64 OPM_SignedMinimum (INT32 bytecount); +export void OPM_StoreComment (CHAR *text, ADDRESS text__len); export void OPM_SymRCh (CHAR *ch); export INT32 OPM_SymRInt (void); export INT64 OPM_SymRInt64 (void); @@ -157,6 +161,36 @@ void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len) __DEL(modname); } +void OPM_StoreComment (CHAR *text, ADDRESS text__len) +{ + INT16 i; + __DUP(text, text__len, CHAR); + i = 0; + while ((i < 255 && text[__X(i, text__len)] != 0x00)) { + OPM_currentComment[__X(i, 256)] = text[__X(i, text__len)]; + i += 1; + } + OPM_currentComment[__X(i, 256)] = 0x00; + OPM_hasComment = 1; + __DEL(text); +} + +void OPM_GetComment (CHAR *text, ADDRESS text__len) +{ + INT16 i; + if (OPM_hasComment) { + i = 0; + while ((((i < text__len && i < 256)) && OPM_currentComment[__X(i, 256)] != 0x00)) { + text[__X(i, text__len)] = OPM_currentComment[__X(i, 256)]; + i += 1; + } + text[__X(i, text__len)] = 0x00; + OPM_hasComment = 0; + } else { + text[0] = 0x00; + } +} + INT64 OPM_SignedMaximum (INT32 bytecount) { INT64 result; @@ -272,7 +306,7 @@ BOOLEAN OPM_OpenPar (void) if (Modules_ArgCount == 1) { OPM_LogWLn(); OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20); - OPM_LogWStr(Configuration_versionLong, 75); + OPM_LogWStr(Configuration_versionLong, 76); OPM_LogW('.'); OPM_LogWLn(); OPM_LogWStr((CHAR*)"Based on Ofront by J. Templ and Software Templ OEG.", 52); @@ -338,7 +372,7 @@ BOOLEAN OPM_OpenPar (void) OPM_LogWLn(); OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95); OPM_LogWLn(); - OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); + OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER and SET, 64 bit LONGINT.", 95); OPM_LogWLn(); OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); OPM_LogWLn(); @@ -410,21 +444,25 @@ void OPM_InitOptions (void) OPM_ShortintSize = 1; OPM_IntegerSize = 2; OPM_LongintSize = 4; + OPM_SetSize = 4; break; case 'C': OPM_ShortintSize = 2; OPM_IntegerSize = 4; OPM_LongintSize = 8; + OPM_SetSize = 4; break; case 'V': OPM_ShortintSize = 1; OPM_IntegerSize = 4; OPM_LongintSize = 8; + OPM_SetSize = 8; break; default: OPM_ShortintSize = 1; OPM_IntegerSize = 2; OPM_LongintSize = 4; + OPM_SetSize = 4; break; } __MOVE(OPM_InstallDir, OPM_ResourceDir, 1024); @@ -606,7 +644,7 @@ static void OPM_ShowLine (INT64 pos) if (pos >= (INT64)OPM_ErrorLineLimitPos) { pos = OPM_ErrorLineLimitPos - 1; } - i = (INT16)OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos); + i = __SHORTF(OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos), 32768); while (i > 0) { OPM_LogW(' '); i -= 1; @@ -759,7 +797,7 @@ void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done) Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, 0); Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&tag); Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ver); - if (tag != 0xf7 || ver != 0x83) { + if (tag != 0xf7 || ver != 0x84) { if (!__IN(4, OPM_Options, 32)) { OPM_err(-306); } @@ -830,7 +868,7 @@ void OPM_NewSym (CHAR *modName, ADDRESS modName__len) if (OPM_newSFile != NIL) { Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, 0); Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7); - Files_Write(&OPM_newSF, Files_Rider__typ, 0x83); + Files_Write(&OPM_newSF, Files_Rider__typ, 0x84); } else { OPM_err(153); } @@ -865,17 +903,17 @@ void OPM_WriteHex (INT64 i) { CHAR s[3]; INT32 digit; - digit = __ASHR((INT32)i, 4); + digit = __ASHR(__SHORT(i, 2147483648LL), 4); if (digit < 10) { - s[0] = (CHAR)(48 + digit); + s[0] = __CHR(48 + digit); } else { - s[0] = (CHAR)(87 + digit); + s[0] = __CHR(87 + digit); } - digit = __MASK((INT32)i, -16); + digit = __MASK(__SHORT(i, 2147483648LL), -16); if (digit < 10) { - s[1] = (CHAR)(48 + digit); + s[1] = __CHR(48 + digit); } else { - s[1] = (CHAR)(87 + digit); + s[1] = __CHR(87 + digit); } s[2] = 0x00; OPM_WriteString(s, 3); @@ -897,11 +935,11 @@ void OPM_WriteInt (INT64 i) __MOVE("LL", s, 3); k = 2; } - s[__X(k, 26)] = (CHAR)(__MOD(i1, 10) + 48); + s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48); i1 = __DIV(i1, 10); k += 1; while (i1 > 0) { - s[__X(k, 26)] = (CHAR)(__MOD(i1, 10) + 48); + s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48); i1 = __DIV(i1, 10); k += 1; } @@ -924,13 +962,13 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx) CHAR s[32]; CHAR ch; INT16 i; - if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == ((INT32)__ENTIER(r)))) { + if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == (__SHORT(__ENTIER(r), 2147483648LL)))) { if (suffx == 'f') { OPM_WriteString((CHAR*)"(REAL)", 7); } else { OPM_WriteString((CHAR*)"(LONGREAL)", 11); } - OPM_WriteInt((INT32)__ENTIER(r)); + OPM_WriteInt(__SHORT(__ENTIER(r), 2147483648LL)); } else { Texts_OpenWriter(&W, Texts_Writer__typ); if (suffx == 'f') { @@ -1139,5 +1177,7 @@ export void *OPM__init(void) OPM_MinReal = -OPM_MaxReal; OPM_MinLReal = -OPM_MaxLReal; OPM_FindInstallDir(); + OPM_hasComment = 0; + OPM_currentComment[0] = 0x00; __ENDMOD; } diff --git a/bootstrap/unix-88/OPM.h b/bootstrap/unix-88/OPM.h index 96318bea..64c15a28 100644 --- a/bootstrap/unix-88/OPM.h +++ b/bootstrap/unix-88/OPM.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPM__h #define OPM__h @@ -9,7 +9,7 @@ import CHAR OPM_Model[10]; import INT16 OPM_AddressSize, OPM_Alignment; import UINT32 OPM_GlobalOptions, OPM_Options; -import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; +import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize; import INT64 OPM_MaxIndex; import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; import BOOLEAN OPM_noerr; @@ -30,6 +30,7 @@ import void OPM_FPrintLReal (INT32 *fp, LONGREAL val); import void OPM_FPrintReal (INT32 *fp, REAL val); import void OPM_FPrintSet (INT32 *fp, UINT64 val); import void OPM_Get (CHAR *ch); +import void OPM_GetComment (CHAR *text, ADDRESS text__len); import void OPM_Init (BOOLEAN *done); import void OPM_InitOptions (void); import INT16 OPM_Integer (INT64 n); @@ -48,6 +49,7 @@ import BOOLEAN OPM_OpenPar (void); import void OPM_RegisterNewSym (void); import INT64 OPM_SignedMaximum (INT32 bytecount); import INT64 OPM_SignedMinimum (INT32 bytecount); +import void OPM_StoreComment (CHAR *text, ADDRESS text__len); import void OPM_SymRCh (CHAR *ch); import INT32 OPM_SymRInt (void); import INT64 OPM_SymRInt64 (void); diff --git a/bootstrap/unix-88/OPP.c b/bootstrap/unix-88/OPP.c index 52620168..3fed2e31 100644 --- a/bootstrap/unix-88/OPP.c +++ b/bootstrap/unix-88/OPP.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -634,7 +634,7 @@ static void OPP_StandProcCall (OPT_Node *x) OPT_Node y = NIL; INT8 m; INT16 n; - m = (INT8)((INT16)(*x)->obj->adr); + m = __SHORT(__SHORT((*x)->obj->adr, 32768), 128); n = 0; if (OPP_sym == 30) { OPS_Get(&OPP_sym); @@ -943,7 +943,7 @@ static void GetCode__19 (void) (*ext)[__X(n + 1, 256)] = OPS_str[__X(n, 256)]; n += 1; } - (*ext)[0] = (CHAR)n; + (*ext)[0] = __CHR(n); OPS_Get(&OPP_sym); } else { for (;;) { @@ -956,14 +956,14 @@ static void GetCode__19 (void) n = 1; } OPS_Get(&OPP_sym); - (*ext)[__X(n, 256)] = (CHAR)c; + (*ext)[__X(n, 256)] = __CHR(c); } if (OPP_sym == 19) { OPS_Get(&OPP_sym); } else if (OPP_sym == 35) { OPP_err(19); } else { - (*ext)[0] = (CHAR)n; + (*ext)[0] = __CHR(n); break; } } diff --git a/bootstrap/unix-88/OPP.h b/bootstrap/unix-88/OPP.h index aa076aaa..3d8cefe8 100644 --- a/bootstrap/unix-88/OPP.h +++ b/bootstrap/unix-88/OPP.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPP__h #define OPP__h diff --git a/bootstrap/unix-88/OPS.c b/bootstrap/unix-88/OPS.c index bf9f1af5..a25a2c12 100644 --- a/bootstrap/unix-88/OPS.c +++ b/bootstrap/unix-88/OPS.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -56,11 +56,11 @@ static void OPS_Str (INT8 *sym) OPS_err(241); break; } - OPS_str[i] = OPS_ch; + OPS_str[__X(i, 256)] = OPS_ch; i += 1; } OPM_Get(&OPS_ch); - OPS_str[i] = 0x00; + OPS_str[__X(i, 256)] = 0x00; OPS_intval = i + 1; if (OPS_intval == 2) { *sym = 35; @@ -76,7 +76,7 @@ static void OPS_Identifier (INT8 *sym) INT16 i; i = 0; do { - OPS_name[i] = OPS_ch; + OPS_name[__X(i, 256)] = 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)); @@ -84,7 +84,7 @@ static void OPS_Identifier (INT8 *sym) OPS_err(240); i -= 1; } - OPS_name[i] = 0x00; + OPS_name[__X(i, 256)] = 0x00; *sym = 38; } @@ -143,7 +143,7 @@ static void OPS_Number (void) 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; + dig[__X(n, 24)] = OPS_ch; n += 1; } m += 1; @@ -173,7 +173,7 @@ static void OPS_Number (void) OPS_numtyp = 1; if (n <= 2) { while (i < n) { - OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1); + OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[__X(i, 24)], 1); i += 1; } } else { @@ -187,7 +187,7 @@ static void OPS_Number (void) OPS_intval = -1; } while (i < n) { - OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1); + OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[__X(i, 24)], 1); i += 1; } } else { @@ -196,7 +196,7 @@ static void OPS_Number (void) } else { OPS_numtyp = 2; while (i < n) { - d = Ord__7(dig[i], 0); + d = Ord__7(dig[__X(i, 24)], 0); i += 1; if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) { OPS_intval = OPS_intval * 10 + (INT64)d; @@ -214,7 +214,7 @@ static void OPS_Number (void) expCh = 'E'; while (n > 0) { n -= 1; - f = (Ord__7(dig[n], 0) + f) / (LONGREAL)(LONGREAL)10; + f = (Ord__7(dig[__X(n, 24)], 0) + f) / (LONGREAL)(LONGREAL)10; } if (OPS_ch == 'E' || OPS_ch == 'D') { expCh = OPS_ch; @@ -279,32 +279,74 @@ static void Comment__2 (void); static void Comment__2 (void) { + BOOLEAN isExported; + CHAR commentText[256]; + INT16 i, nestLevel; + CHAR prevCh, nextCh; + i = 0; + while (i <= 255) { + commentText[__X(i, 256)] = 0x00; + i += 1; + } + isExported = 0; + i = 0; + nestLevel = 1; + prevCh = 0x00; OPM_Get(&OPS_ch); - for (;;) { - for (;;) { - while (OPS_ch == '(') { + if (OPS_ch == '*') { + isExported = 1; + OPM_Get(&OPS_ch); + if (OPS_ch == ')') { + commentText[0] = 0x00; + OPM_StoreComment(commentText, 256); + OPM_Get(&OPS_ch); + return; + } + } + while ((nestLevel > 0 && OPS_ch != 0x00)) { + if ((prevCh == '(' && OPS_ch == '*')) { + nestLevel += 1; + prevCh = 0x00; + } else if ((prevCh == '*' && OPS_ch == ')')) { + nestLevel -= 1; + if (nestLevel == 0) { OPM_Get(&OPS_ch); - if (OPS_ch == '*') { - Comment__2(); + } else { + prevCh = 0x00; + } + } else { + if ((((isExported && nestLevel == 1)) && prevCh != 0x00)) { + if (i < 255) { + commentText[__X(i, 256)] = prevCh; + i += 1; } } - if (OPS_ch == '*') { - OPM_Get(&OPS_ch); - break; - } - if (OPS_ch == 0x00) { - break; - } + prevCh = OPS_ch; + } + if (nestLevel > 0) { OPM_Get(&OPS_ch); } - if (OPS_ch == ')') { - OPM_Get(&OPS_ch); - break; + } + if (OPS_ch == 0x00) { + OPS_err(5); + } + if ((((((isExported && nestLevel == 0)) && prevCh != 0x00)) && prevCh != '*')) { + if (i < 255) { + commentText[__X(i, 256)] = prevCh; + i += 1; + } else { + OPM_LogWStr((CHAR*)"Truncating final comment character", 35); + OPM_LogWLn(); } - if (OPS_ch == 0x00) { - OPS_err(5); - break; + } + if (isExported) { + if (i >= 256) { + OPM_LogWStr((CHAR*)"Warning: commentText overflow", 30); + OPM_LogWLn(); + i = 255; } + commentText[__X(i, 256)] = 0x00; + OPM_StoreComment(commentText, 256); } } diff --git a/bootstrap/unix-88/OPS.h b/bootstrap/unix-88/OPS.h index 09a33705..19e222ac 100644 --- a/bootstrap/unix-88/OPS.h +++ b/bootstrap/unix-88/OPS.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPS__h #define OPS__h diff --git a/bootstrap/unix-88/OPT.c b/bootstrap/unix-88/OPT.c index d89ea5c8..c3999981 100644 --- a/bootstrap/unix-88/OPT.c +++ b/bootstrap/unix-88/OPT.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -83,6 +83,7 @@ typedef OPT_Const conval; INT32 adr, linkadr; INT16 x; + OPT_ConstExt comment; } OPT_ObjDesc; typedef @@ -173,6 +174,7 @@ 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_OutTruncatedName (CHAR *text, ADDRESS text__len); export OPT_Struct OPT_SetType (INT32 size); export OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir); export INT32 OPT_SizeAlignment (INT32 size); @@ -352,7 +354,7 @@ void OPT_TypSize (OPT_Struct typ) } typ->size = offset; typ->align = base; - typ->sysflag = __MASK(typ->sysflag, -256) + (INT16)__ASHL(offset - off0, 8); + typ->sysflag = __MASK(typ->sysflag, -256) + __SHORT(__ASHL(offset - off0, 8), 32768); } else if (c == 2) { OPT_TypSize(typ->BaseTyp); typ->size = typ->n * typ->BaseTyp->size; @@ -388,6 +390,10 @@ OPT_Object OPT_NewObj (void) { OPT_Object obj = NIL; __NEW(obj, OPT_ObjDesc); + obj->typ = NIL; + obj->conval = NIL; + obj->comment = NIL; + obj->name[0] = 0x00; return obj; } @@ -554,6 +560,8 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj) OPT_Object ob0 = NIL, ob1 = NIL; BOOLEAN left; INT8 mnolev; + CHAR commentText[256]; + INT16 j; ob0 = OPT_topScope; ob1 = ob0->right; left = 0; @@ -585,6 +593,16 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj) __COPY(name, ob1->name, 256); mnolev = OPT_topScope->mnolev; ob1->mnolev = mnolev; + OPM_GetComment((void*)commentText, 256); + if (commentText[0] != 0x00) { + ob1->comment = __NEWARR(NIL, 1, 1, 1, 0, ((INT64)(256))); + j = 0; + while ((j < 255 && commentText[__X(j, 256)] != 0x00)) { + (*ob1->comment)[__X(j, 256)] = commentText[__X(j, 256)]; + j += 1; + } + (*ob1->comment)[__X(j, 256)] = 0x00; + } break; } } @@ -1103,6 +1121,13 @@ static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par) tag = OPM_SymRInt(); last = NIL; while (tag != 18) { + if (tag < 0 || tag > 100) { + OPM_LogWStr((CHAR*)"ERROR: Invalid tag value in InSign: ", 37); + OPM_LogWNum(tag, 0); + OPM_LogWLn(); + OPM_err(155); + return; + } new = OPT_NewObj(); new->mnolev = -mno; if (last == NIL) { @@ -1251,7 +1276,7 @@ static void OPT_InStruct (OPT_Struct *typ) obj->vis = 0; tag = OPM_SymRInt(); if (tag == 35) { - (*typ)->sysflag = (INT16)OPM_SymRInt(); + (*typ)->sysflag = __SHORTF(OPM_SymRInt(), 32768); tag = OPM_SymRInt(); } switch (tag) { @@ -1381,7 +1406,37 @@ static OPT_Object OPT_InObj (INT8 mno) OPT_Struct typ = NIL; INT32 tag; OPT_ConstExt ext = NIL; + OPS_Name commentText; + BOOLEAN hasComment; + INT16 j; + INT32 len; tag = OPT_impCtxt.nextTag; + hasComment = 0; + while (tag == 41) { + len = OPM_SymRInt(); + if (len < 0) { + len = 0; + } + if (len > 255) { + len = 255; + } + i = 0; + while (i < len) { + OPM_SymRCh(&commentText[__X(i, 256)]); + i += 1; + } + commentText[__X(i, 256)] = 0x00; + hasComment = 1; + tag = OPM_SymRInt(); + } + OPT_impCtxt.nextTag = tag; + if (tag < 0 || tag > 50) { + OPM_LogWStr((CHAR*)"ERROR: Invalid tag in InObj: ", 30); + OPM_LogWNum(tag, 0); + OPM_LogWLn(); + OPM_err(155); + return NIL; + } if (tag == 19) { OPT_InStruct(&typ); obj = typ->strobj; @@ -1397,7 +1452,7 @@ static OPT_Object OPT_InObj (INT8 mno) obj->conval = OPT_NewConst(); OPT_InConstant(tag, obj->conval); obj->typ = OPT_InTyp(tag); - } else if (tag >= 31) { + } else if ((tag >= 31 && tag <= 33)) { obj->conval = OPT_NewConst(); obj->conval->intval = -1; OPT_InSign(mno, &obj->typ, &obj->link); @@ -1412,8 +1467,8 @@ static OPT_Object OPT_InObj (INT8 mno) obj->mode = 9; ext = OPT_NewExt(); obj->conval->ext = ext; - s = (INT16)OPM_SymRInt(); - (*ext)[0] = (CHAR)s; + s = __SHORTF(OPM_SymRInt(), 32768); + (*ext)[0] = __CHR(s); i = 1; while (i <= s) { OPM_SymRCh(&(*ext)[__X(i, 256)]); @@ -1424,20 +1479,37 @@ static OPT_Object OPT_InObj (INT8 mno) OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", 32); OPM_LogWNum(tag, 0); OPM_LogWLn(); + OPM_err(155); + return NIL; break; } } else if (tag == 20) { obj->mode = 5; OPT_InStruct(&obj->typ); - } else { + } else if (tag == 21 || tag == 22) { obj->mode = 1; if (tag == 22) { obj->vis = 2; } OPT_InStruct(&obj->typ); + } else { + OPM_LogWStr((CHAR*)"ERROR: Unexpected tag in InObj: ", 33); + OPM_LogWNum(tag, 0); + OPM_LogWLn(); + OPM_err(155); + return NIL; } OPT_InName((void*)obj->name, 256); } + if ((hasComment && obj != NIL)) { + obj->comment = __NEWARR(NIL, 1, 1, 1, 0, ((INT64)(256))); + j = 0; + while ((((j < 255 && j < len)) && commentText[__X(j, 256)] != 0x00)) { + (*obj->comment)[__X(j, 256)] = commentText[__X(j, 256)]; + j += 1; + } + (*obj->comment)[__X(j, 256)] = 0x00; + } 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); @@ -1752,7 +1824,7 @@ static void OPT_OutConstant (OPT_Object obj) OPM_SymWInt(f); switch (f) { case 2: case 3: - OPM_SymWCh((CHAR)obj->conval->intval); + OPM_SymWCh(__CHR(obj->conval->intval)); break; case 4: OPM_SymWInt(obj->conval->intval); @@ -1780,13 +1852,40 @@ static void OPT_OutConstant (OPT_Object obj) } } +static void OPT_OutTruncatedName (CHAR *text, ADDRESS text__len) +{ + INT16 i; + __DUP(text, text__len, CHAR); + i = 0; + while ((i < 255 && text[__X(i, text__len)] != 0x00)) { + OPM_SymWCh(text[__X(i, text__len)]); + i += 1; + } + OPM_SymWCh(0x00); + __DEL(text); +} + static void OPT_OutObj (OPT_Object obj) { INT16 i, j; OPT_ConstExt ext = NIL; + INT16 k, l; if (obj != NIL) { OPT_OutObj(obj->left); if (__IN(obj->mode, 0x06ea, 32)) { + if (obj->comment != NIL) { + OPM_SymWInt(41); + k = 0; + while ((k < 255 && (*obj->comment)[__X(k, 256)] != 0x00)) { + k += 1; + } + OPM_SymWInt(k); + l = 0; + while (l < k) { + OPM_SymWCh((*obj->comment)[__X(l, 256)]); + l += 1; + } + } if (obj->history == 4) { OPT_FPrintErr(obj, 250); } else if (obj->vis != 0) { @@ -2026,7 +2125,7 @@ static void EnumPtrs(void (*P)(void*)) } __TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 40), {0, -16}}; -__TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 336), {0, 8, 16, 24, 304, 312, -56}}; +__TDESC(OPT_ObjDesc, 1, 7) = {__TDFLDS("ObjDesc", 344), {0, 8, 16, 24, 304, 312, 336, -64}}; __TDESC(OPT_StrDesc, 1, 3) = {__TDFLDS("StrDesc", 72), {48, 56, 64, -32}}; __TDESC(OPT_NodeDesc, 1, 6) = {__TDFLDS("NodeDesc", 56), {0, 8, 16, 32, 40, 48, -56}}; __TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 5184), {16, 24, 32, 40, 48, 56, 64, 72, 80, 88, 96, 104, 112, 120, 128, 136, diff --git a/bootstrap/unix-88/OPT.h b/bootstrap/unix-88/OPT.h index 63bf2070..cf456af5 100644 --- a/bootstrap/unix-88/OPT.h +++ b/bootstrap/unix-88/OPT.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPT__h #define OPT__h @@ -61,6 +61,7 @@ typedef OPT_Const conval; INT32 adr, linkadr; INT16 x; + OPT_ConstExt comment; } OPT_ObjDesc; typedef diff --git a/bootstrap/unix-88/OPV.c b/bootstrap/unix-88/OPV.c index 69e2f94e..26c1c715 100644 --- a/bootstrap/unix-88/OPV.c +++ b/bootstrap/unix-88/OPV.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -112,7 +112,7 @@ static void OPV_Stamp (OPS_Name s) i += 2; k = 0; do { - n[__X(k, 10)] = (CHAR)((int)__MOD(j, 10) + 48); + n[__X(k, 10)] = __CHR((int)__MOD(j, 10) + 48); j = __DIV(j, 10); k += 1; } while (!(j == 0)); @@ -317,15 +317,27 @@ static INT16 OPV_Precedence (INT16 class, INT16 subclass, INT16 form, INT16 comp static void OPV_Len (OPT_Node n, INT64 dim) { + INT64 d; + OPT_Struct array = NIL; 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[", 7); - OPM_WriteInt(dim); - OPM_Write(']'); + d = dim; + array = n->typ; + while (d > 0) { + array = array->BaseTyp; + d -= 1; + } + if (array->comp == 3) { + OPV_design(n->left, 10); + OPM_WriteString((CHAR*)"->len[", 7); + OPM_WriteInt(dim); + OPM_Write(']'); + } else { + OPM_WriteInt(array->n); + } } else { OPC_Len(n->obj, n->typ, dim); } @@ -370,6 +382,7 @@ static void OPV_SizeCast (OPT_Node n, INT32 to) OPM_WriteInt(__ASHL(to, 3)); OPM_WriteString((CHAR*)")", 2); } + OPV_Entier(n, 9); } } @@ -381,7 +394,6 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec) if (to == 7) { if (from == 7) { OPV_SizeCast(n, newtype->size); - OPV_Entier(n, 9); } else { OPM_WriteString((CHAR*)"__SETOF(", 9); OPV_Entier(n, -1); @@ -391,7 +403,6 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec) } } else if (to == 4) { OPV_SizeCast(n, newtype->size); - OPV_Entier(n, 9); } else if (to == 3) { if (__IN(2, OPM_Options, 32)) { OPM_WriteString((CHAR*)"__CHR", 6); @@ -1183,7 +1194,7 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x) base = base->BaseTyp; } if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) { - OPC_Ident(base->strobj); + OPC_Andent(base); OPM_WriteString((CHAR*)"__typ", 6); } else if (base->form == 11) { OPM_WriteString((CHAR*)"POINTER__typ", 13); diff --git a/bootstrap/unix-88/OPV.h b/bootstrap/unix-88/OPV.h index c6a107b6..fbabd8f4 100644 --- a/bootstrap/unix-88/OPV.h +++ b/bootstrap/unix-88/OPV.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPV__h #define OPV__h diff --git a/bootstrap/unix-88/Out.c b/bootstrap/unix-88/Out.c index 23d917c7..ce936589 100644 --- a/bootstrap/unix-88/Out.c +++ b/bootstrap/unix-88/Out.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -80,7 +80,7 @@ void Out_String (CHAR *str, ADDRESS str__len) error = Platform_Write(1, (ADDRESS)str, l); } else { __MOVE((ADDRESS)str, (ADDRESS)&Out_buf[__X(Out_in, 128)], l); - Out_in += (INT16)l; + Out_in += __SHORT(l, 32768); } __DEL(str); } @@ -98,11 +98,11 @@ void Out_Int (INT64 x, INT64 n) if (x < 0) { x = -x; } - s[0] = (CHAR)(48 + __MOD(x, 10)); + s[0] = __CHR(48 + __MOD(x, 10)); x = __DIV(x, 10); i = 1; while (x != 0) { - s[__X(i, 22)] = (CHAR)(48 + __MOD(x, 10)); + s[__X(i, 22)] = __CHR(48 + __MOD(x, 10)); x = __DIV(x, 10); i += 1; } @@ -138,9 +138,9 @@ void Out_Hex (INT64 x, INT64 n) x = __ROTL(x, 4, 64); n -= 1; if (__MASK(x, -16) < 10) { - Out_Char((CHAR)(__MASK(x, -16) + 48)); + Out_Char(__CHR(__MASK(x, -16) + 48)); } else { - Out_Char((CHAR)((__MASK(x, -16) - 10) + 65)); + Out_Char(__CHR((__MASK(x, -16) - 10) + 65)); } } } @@ -154,7 +154,7 @@ void Out_Ln (void) static void Out_digit (INT64 n, CHAR *s, ADDRESS s__len, INT16 *i) { *i -= 1; - s[__X(*i, s__len)] = (CHAR)(__MOD(n, 10) + 48); + s[__X(*i, s__len)] = __CHR(__MOD(n, 10) + 48); } static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i) @@ -166,7 +166,7 @@ static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 if (l > *i) { l = *i; } - *i -= (INT16)l; + *i -= __SHORT(l, 32768); j = 0; while (j < l) { s[__X(*i + j, s__len)] = t[__X(j, t__len)]; @@ -248,7 +248,7 @@ static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_) if (nn) { x = -x; } - e = (INT16)__ASHR((e - 1023) * 77, 8); + e = __SHORT(__ASHR((e - 1023) * 77, 8), 32768); if (e >= 0) { x = x / (LONGREAL)Out_Ten(e); } else { diff --git a/bootstrap/unix-88/Out.h b/bootstrap/unix-88/Out.h index e1285046..a72547f4 100644 --- a/bootstrap/unix-88/Out.h +++ b/bootstrap/unix-88/Out.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Out__h #define Out__h diff --git a/bootstrap/unix-88/Platform.c b/bootstrap/unix-88/Platform.c index 4d25035f..139181a0 100644 --- a/bootstrap/unix-88/Platform.c +++ b/bootstrap/unix-88/Platform.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -42,6 +42,8 @@ export BOOLEAN Platform_Inaccessible (INT16 e); export BOOLEAN Platform_Interrupted (INT16 e); export BOOLEAN Platform_IsConsole (INT32 h); export void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d); +export INT16 Platform_MaxNameLength (void); +export INT16 Platform_MaxPathLength (void); export INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h); export BOOLEAN Platform_NoSuchDirectory (INT16 e); export INT64 Platform_OSAllocate (INT64 size); @@ -79,6 +81,7 @@ export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS #include #include #include +#include #include #include #define Platform_EACCES() EACCES @@ -94,6 +97,8 @@ export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS #define Platform_EROFS() EROFS #define Platform_ETIMEDOUT() ETIMEDOUT #define Platform_EXDEV() EXDEV +#define Platform_NAMEMAX() NAME_MAX +#define Platform_PATHMAX() PATH_MAX #define Platform_allocate(size) (ADDRESS)((void*)malloc((size_t)size)) #define Platform_chdir(n, n__len) chdir((char*)n) #define Platform_closefile(fd) close(fd) @@ -178,6 +183,16 @@ BOOLEAN Platform_Interrupted (INT16 e) return e == Platform_EINTR(); } +INT16 Platform_MaxNameLength (void) +{ + return Platform_NAMEMAX(); +} + +INT16 Platform_MaxPathLength (void) +{ + return Platform_PATHMAX(); +} + INT64 Platform_OSAllocate (INT64 size) { return Platform_allocate(size); @@ -189,13 +204,13 @@ void Platform_OSFree (INT64 address) } typedef - CHAR (*EnvPtr__78)[1024]; + CHAR (*EnvPtr__83)[1024]; BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len) { - EnvPtr__78 p = NIL; + EnvPtr__83 p = NIL; __DUP(var, var__len, CHAR); - p = (EnvPtr__78)(ADDRESS)Platform_getenv(var, var__len); + p = (EnvPtr__83)(ADDRESS)Platform_getenv(var, var__len); if (p != NIL) { __COPY(*p, val, val__len); } diff --git a/bootstrap/unix-88/Platform.h b/bootstrap/unix-88/Platform.h index 76f5da00..e827b641 100644 --- a/bootstrap/unix-88/Platform.h +++ b/bootstrap/unix-88/Platform.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Platform__h #define Platform__h @@ -40,6 +40,8 @@ import BOOLEAN Platform_Inaccessible (INT16 e); import BOOLEAN Platform_Interrupted (INT16 e); import BOOLEAN Platform_IsConsole (INT32 h); import void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d); +import INT16 Platform_MaxNameLength (void); +import INT16 Platform_MaxPathLength (void); import INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h); import BOOLEAN Platform_NoSuchDirectory (INT16 e); import INT64 Platform_OSAllocate (INT64 size); diff --git a/bootstrap/unix-88/Reals.c b/bootstrap/unix-88/Reals.c index d1eb72f6..512ec2c4 100644 --- a/bootstrap/unix-88/Reals.c +++ b/bootstrap/unix-88/Reals.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -67,9 +67,9 @@ void Reals_SetExpo (REAL *x, INT16 ex) { CHAR c; __GET((ADDRESS)x + 3, c, CHAR); - __PUT((ADDRESS)x + 3, (CHAR)(__ASHL(__ASHR((INT16)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR); + __PUT((ADDRESS)x + 3, __CHR(__ASHL(__ASHR((INT16)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR); __GET((ADDRESS)x + 2, c, CHAR); - __PUT((ADDRESS)x + 2, (CHAR)(__MASK((INT16)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR); + __PUT((ADDRESS)x + 2, __CHR(__MASK((INT16)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR); } INT16 Reals_ExpoL (LONGREAL x) @@ -87,21 +87,21 @@ void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len) } k = 0; if (n > 9) { - i = (INT32)__ENTIER(x / (LONGREAL)(LONGREAL)1000000000); - j = (INT32)__ENTIER(x - i * (LONGREAL)1000000000); + i = __SHORT(__ENTIER(x / (LONGREAL)(LONGREAL)1000000000), 2147483648LL); + j = __SHORT(__ENTIER(x - i * (LONGREAL)1000000000), 2147483648LL); if (j < 0) { j = 0; } while (k < 9) { - d[__X(k, d__len)] = (CHAR)((int)__MOD(j, 10) + 48); + d[__X(k, d__len)] = __CHR((int)__MOD(j, 10) + 48); j = __DIV(j, 10); k += 1; } } else { - i = (INT32)__ENTIER(x); + i = __SHORT(__ENTIER(x), 2147483648LL); } while (k < n) { - d[__X(k, d__len)] = (CHAR)((int)__MOD(i, 10) + 48); + d[__X(k, d__len)] = __CHR((int)__MOD(i, 10) + 48); i = __DIV(i, 10); k += 1; } @@ -115,9 +115,9 @@ void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len) static CHAR Reals_ToHex (INT16 i) { if (i < 10) { - return (CHAR)(i + 48); + return __CHR(i + 48); } else { - return (CHAR)(i + 55); + return __CHR(i + 55); } __RETCHK; } diff --git a/bootstrap/unix-88/Reals.h b/bootstrap/unix-88/Reals.h index 170d1785..93e7fa75 100644 --- a/bootstrap/unix-88/Reals.h +++ b/bootstrap/unix-88/Reals.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Reals__h #define Reals__h diff --git a/bootstrap/unix-88/Strings.c b/bootstrap/unix-88/Strings.c index 225bd40a..4b18812f 100644 --- a/bootstrap/unix-88/Strings.c +++ b/bootstrap/unix-88/Strings.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -6,6 +6,7 @@ #define SET UINT32 #include "SYSTEM.h" +#include "Reals.h" @@ -19,6 +20,8 @@ export INT16 Strings_Length (CHAR *s, ADDRESS s__len); export BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len); export INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos); export void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len); +export void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r); +export void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r); INT16 Strings_Length (CHAR *s, ADDRESS s__len) @@ -31,7 +34,7 @@ INT16 Strings_Length (CHAR *s, ADDRESS s__len) } if (i <= 32767) { __DEL(s); - return (INT16)i; + return __SHORT(i, 32768); } else { __DEL(s); return 32767; @@ -123,7 +126,7 @@ void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHA INT16 len, destLen, i; __DUP(source, source__len, CHAR); len = Strings_Length(source, source__len); - destLen = (INT16)dest__len - 1; + destLen = __SHORT(dest__len, 32768) - 1; if (pos < 0) { pos = 0; } @@ -236,10 +239,135 @@ BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS return __retval; } +void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r) +{ + INT16 p, e; + REAL y, g; + BOOLEAN neg, negE; + __DUP(s, s__len, CHAR); + p = 0; + while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { + p += 1; + } + if (s[__X(p, s__len)] == '-') { + neg = 1; + p += 1; + } else { + neg = 0; + } + while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { + p += 1; + } + y = (REAL)0; + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + y = y * (REAL)10 + ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + if (s[__X(p, s__len)] == '.') { + p += 1; + g = (REAL)1; + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + g = g / (REAL)(REAL)10; + y = y + g * ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + } + if (s[__X(p, s__len)] == 'D' || s[__X(p, s__len)] == 'E') { + p += 1; + e = 0; + if (s[__X(p, s__len)] == '-') { + negE = 1; + p += 1; + } else { + negE = 0; + } + while (s[__X(p, s__len)] == '0') { + p += 1; + } + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + e = e * 10 + ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + if (negE) { + y = y / (REAL)Reals_Ten(e); + } else { + y = y * Reals_Ten(e); + } + } + if (neg) { + y = -y; + } + *r = y; + __DEL(s); +} + +void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r) +{ + INT16 p, e; + LONGREAL y, g; + BOOLEAN neg, negE; + __DUP(s, s__len, CHAR); + p = 0; + while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { + p += 1; + } + if (s[__X(p, s__len)] == '-') { + neg = 1; + p += 1; + } else { + neg = 0; + } + while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { + p += 1; + } + y = (LONGREAL)0; + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + y = y * (LONGREAL)10 + ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + if (s[__X(p, s__len)] == '.') { + p += 1; + g = (LONGREAL)1; + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + g = g / (LONGREAL)(LONGREAL)10; + y = y + g * ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + } + if (s[__X(p, s__len)] == 'D' || s[__X(p, s__len)] == 'E') { + p += 1; + e = 0; + if (s[__X(p, s__len)] == '-') { + negE = 1; + p += 1; + } else { + negE = 0; + } + while (s[__X(p, s__len)] == '0') { + p += 1; + } + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + e = e * 10 + ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + if (negE) { + y = y / (LONGREAL)Reals_Ten(e); + } else { + y = y * Reals_Ten(e); + } + } + if (neg) { + y = -y; + } + *r = y; + __DEL(s); +} + export void *Strings__init(void) { __DEFMOD; + __MODULE_IMPORT(Reals); __REGMOD("Strings", 0); /* BEGIN */ __ENDMOD; diff --git a/bootstrap/unix-88/Strings.h b/bootstrap/unix-88/Strings.h index 4d98f1a3..f0e3ae34 100644 --- a/bootstrap/unix-88/Strings.h +++ b/bootstrap/unix-88/Strings.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Strings__h #define Strings__h @@ -17,6 +17,8 @@ import INT16 Strings_Length (CHAR *s, ADDRESS s__len); import BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len); import INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos); import void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len); +import void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r); +import void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r); import void *Strings__init(void); diff --git a/bootstrap/unix-88/Texts.c b/bootstrap/unix-88/Texts.c index 565de43f..77dc1bac 100644 --- a/bootstrap/unix-88/Texts.c +++ b/bootstrap/unix-88/Texts.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -8,7 +8,6 @@ #include "SYSTEM.h" #include "Files.h" #include "Modules.h" -#include "Out.h" #include "Reals.h" typedef @@ -813,10 +812,10 @@ void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ) if ('9' < ch) { if (('A' <= ch && ch <= 'F')) { hex = 1; - ch = (CHAR)((INT16)ch - 7); + ch = __CHR((INT16)ch - 7); } else if (('a' <= ch && ch <= 'f')) { hex = 1; - ch = (CHAR)((INT16)ch - 39); + ch = __CHR((INT16)ch - 39); } else { break; } @@ -1058,7 +1057,7 @@ void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n) x0 = x; } do { - a[__X(i, 24)] = (CHAR)(__MOD(x0, 10) + 48); + a[__X(i, 24)] = __CHR(__MOD(x0, 10) + 48); x0 = __DIV(x0, 10); i += 1; } while (!(x0 == 0)); @@ -1085,9 +1084,9 @@ void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x) do { y = __MASK(x, -16); if (y < 10) { - a[__X(i, 20)] = (CHAR)(y + 48); + a[__X(i, 20)] = __CHR(y + 48); } else { - a[__X(i, 20)] = (CHAR)(y + 55); + a[__X(i, 20)] = __CHR(y + 55); } x = __ASHR(x, 4); i += 1; @@ -1163,8 +1162,8 @@ void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n) } 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)); + Texts_Write(&*W, W__typ, __CHR(__DIV(e, 10) + 48)); + Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48)); } } @@ -1314,7 +1313,7 @@ void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n) } else { Texts_Write(&*W, W__typ, ' '); } - e = (INT16)__ASHR((e - 1023) * 77, 8); + e = __SHORT(__ASHR((e - 1023) * 77, 8), 32768); if (e >= 0) { x = x / (LONGREAL)Reals_TenL(e); } else { @@ -1345,10 +1344,10 @@ void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n) } else { Texts_Write(&*W, W__typ, '+'); } - Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 100) + 48)); + Texts_Write(&*W, W__typ, __CHR(__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)); + Texts_Write(&*W, W__typ, __CHR(__DIV(e, 10) + 48)); + Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48)); } } @@ -1375,8 +1374,8 @@ static void WritePair__44 (CHAR ch, INT32 x); static void WritePair__44 (CHAR ch, INT32 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)((int)__MOD(x, 10) + 48)); + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, __CHR(__DIV(x, 10) + 48)); + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, __CHR((int)__MOD(x, 10) + 48)); } void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d) @@ -1810,7 +1809,6 @@ export void *Texts__init(void) __DEFMOD; __MODULE_IMPORT(Files); __MODULE_IMPORT(Modules); - __MODULE_IMPORT(Out); __MODULE_IMPORT(Reals); __REGMOD("Texts", EnumPtrs); __INITYP(Texts_FontDesc, Texts_FontDesc, 0); diff --git a/bootstrap/unix-88/Texts.h b/bootstrap/unix-88/Texts.h index bdd9fada..081eec2c 100644 --- a/bootstrap/unix-88/Texts.h +++ b/bootstrap/unix-88/Texts.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Texts__h #define Texts__h diff --git a/bootstrap/unix-88/VT100.c b/bootstrap/unix-88/VT100.c index 9cd5cf4d..346fb37b 100644 --- a/bootstrap/unix-88/VT100.c +++ b/bootstrap/unix-88/VT100.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -34,6 +34,7 @@ static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len); export void VT100_HVP (INT16 n, INT16 m); export void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len); export void VT100_RCP (void); +export void VT100_Reset (void); static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end); export void VT100_SCP (void); export void VT100_SD (INT16 n); @@ -74,7 +75,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len) } e = s; do { - b[__X(e, 21)] = (CHAR)((int)__MOD(int_, 10) + 48); + b[__X(e, 21)] = __CHR((int)__MOD(int_, 10) + 48); int_ = __DIV(int_, 10); e += 1; } while (!(int_ == 0)); @@ -136,6 +137,15 @@ static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len) __DEL(letter); } +void VT100_Reset (void) +{ + CHAR cmd[6]; + __COPY("\033", cmd, 6); + Strings_Append((CHAR*)"c", 2, (void*)cmd, 6); + Out_String(cmd, 6); + Out_Ln(); +} + void VT100_CUU (INT16 n) { VT100_EscSeq(n, (CHAR*)"A", 2); @@ -256,6 +266,7 @@ export void *VT100__init(void) __REGCMD("DECTCEMh", VT100_DECTCEMh); __REGCMD("DECTCEMl", VT100_DECTCEMl); __REGCMD("RCP", VT100_RCP); + __REGCMD("Reset", VT100_Reset); __REGCMD("SCP", VT100_SCP); /* BEGIN */ __COPY("\033", VT100_CSI, 5); diff --git a/bootstrap/unix-88/VT100.h b/bootstrap/unix-88/VT100.h index 8f60c652..4e708647 100644 --- a/bootstrap/unix-88/VT100.h +++ b/bootstrap/unix-88/VT100.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef VT100__h #define VT100__h @@ -25,6 +25,7 @@ import void VT100_EL (INT16 n); import void VT100_HVP (INT16 n, INT16 m); import void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len); import void VT100_RCP (void); +import void VT100_Reset (void); import void VT100_SCP (void); import void VT100_SD (INT16 n); import void VT100_SGR (INT16 n); diff --git a/bootstrap/unix-88/extTools.c b/bootstrap/unix-88/extTools.c index fa840303..ce2fc413 100644 --- a/bootstrap/unix-88/extTools.c +++ b/bootstrap/unix-88/extTools.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -7,18 +7,22 @@ #include "SYSTEM.h" #include "Configuration.h" +#include "Heap.h" #include "Modules.h" #include "OPM.h" #include "Out.h" #include "Platform.h" #include "Strings.h" +typedef + CHAR extTools_CommandString[4096]; -static CHAR extTools_CFLAGS[1023]; + +static extTools_CommandString extTools_CFLAGS; export void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len); -static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len); +static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len, CHAR *additionalopts, ADDRESS additionalopts__len); export void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len); static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRESS cmd__len); @@ -26,14 +30,17 @@ static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRES static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRESS cmd__len) { INT16 r, status, exitcode; + extTools_CommandString fullcmd; __DUP(title, title__len, CHAR); __DUP(cmd, cmd__len, CHAR); if (__IN(18, OPM_Options, 32)) { - Out_String(title, title__len); + Out_String((CHAR*)" ", 3); Out_String(cmd, cmd__len); Out_Ln(); } - r = Platform_System(cmd, cmd__len); + __COPY(cmd, fullcmd, 4096); + Heap_GC(0); + r = Platform_System(fullcmd, 4096); status = __MASK(r, -128); exitcode = __ASHR(r, 8); if (exitcode > 127) { @@ -63,50 +70,55 @@ static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRES __DEL(cmd); } -static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len) +static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len, CHAR *additionalopts, ADDRESS additionalopts__len) { - __COPY("gcc -g", s, s__len); + __DUP(additionalopts, additionalopts__len, CHAR); + __COPY("gcc -fPIC -g -Wno-stringop-overflow", s, s__len); Strings_Append((CHAR*)" -I \"", 6, (void*)s, s__len); Strings_Append(OPM_ResourceDir, 1024, (void*)s, s__len); Strings_Append((CHAR*)"/include\" ", 11, (void*)s, s__len); - Platform_GetEnv((CHAR*)"CFLAGS", 7, (void*)extTools_CFLAGS, 1023); - Strings_Append(extTools_CFLAGS, 1023, (void*)s, s__len); + Strings_Append(additionalopts, additionalopts__len, (void*)s, s__len); Strings_Append((CHAR*)" ", 2, (void*)s, s__len); + Platform_GetEnv((CHAR*)"CFLAGS", 7, (void*)extTools_CFLAGS, 4096); + Strings_Append(extTools_CFLAGS, 4096, (void*)s, s__len); + Strings_Append((CHAR*)" ", 2, (void*)s, s__len); + __DEL(additionalopts); } void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len) { - CHAR cmd[1023]; + extTools_CommandString cmd; __DUP(moduleName, moduleName__len, CHAR); - extTools_InitialiseCompilerCommand((void*)cmd, 1023); - Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 1023); - Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023); - Strings_Append((CHAR*)".c", 3, (void*)cmd, 1023); - extTools_execute((CHAR*)"C compile: ", 12, cmd, 1023); + extTools_InitialiseCompilerCommand((void*)cmd, 4096, (CHAR*)"", 1); + Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 4096); + Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096); + Strings_Append((CHAR*)".c", 3, (void*)cmd, 4096); + extTools_execute((CHAR*)"C compile: ", 12, cmd, 4096); __DEL(moduleName); } void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len) { - CHAR cmd[1023]; + extTools_CommandString cmd; __DUP(additionalopts, additionalopts__len, CHAR); - extTools_InitialiseCompilerCommand((void*)cmd, 1023); - Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023); - Strings_Append((CHAR*)".c ", 4, (void*)cmd, 1023); - Strings_Append(additionalopts, additionalopts__len, (void*)cmd, 1023); + extTools_InitialiseCompilerCommand((void*)cmd, 4096, additionalopts, additionalopts__len); + Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096); + Strings_Append((CHAR*)".c ", 4, (void*)cmd, 4096); if (statically) { - Strings_Append((CHAR*)" -static", 9, (void*)cmd, 1023); + Strings_Append((CHAR*)" -static", 9, (void*)cmd, 4096); } - Strings_Append((CHAR*)" -o ", 5, (void*)cmd, 1023); - Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023); - Strings_Append((CHAR*)" -L\"", 5, (void*)cmd, 1023); - Strings_Append(OPM_InstallDir, 1024, (void*)cmd, 1023); - Strings_Append((CHAR*)"/lib\"", 6, (void*)cmd, 1023); - Strings_Append((CHAR*)" -l voc", 8, (void*)cmd, 1023); - Strings_Append((CHAR*)"-O", 3, (void*)cmd, 1023); - Strings_Append(OPM_Model, 10, (void*)cmd, 1023); - Strings_Append((CHAR*)"", 1, (void*)cmd, 1023); - extTools_execute((CHAR*)"C compile and link: ", 21, cmd, 1023); + Strings_Append((CHAR*)" -o ", 5, (void*)cmd, 4096); + Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096); + if (!statically || 1) { + Strings_Append((CHAR*)" -L\"", 5, (void*)cmd, 4096); + Strings_Append(OPM_InstallDir, 1024, (void*)cmd, 4096); + Strings_Append((CHAR*)"/lib\"", 6, (void*)cmd, 4096); + Strings_Append((CHAR*)" -lvoc", 7, (void*)cmd, 4096); + Strings_Append((CHAR*)"-O", 3, (void*)cmd, 4096); + Strings_Append(OPM_Model, 10, (void*)cmd, 4096); + Strings_Append((CHAR*)"", 1, (void*)cmd, 4096); + } + extTools_execute((CHAR*)"C compile and link: ", 21, cmd, 4096); __DEL(additionalopts); } @@ -115,6 +127,7 @@ export void *extTools__init(void) { __DEFMOD; __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Heap); __MODULE_IMPORT(Modules); __MODULE_IMPORT(OPM); __MODULE_IMPORT(Out); diff --git a/bootstrap/unix-88/extTools.h b/bootstrap/unix-88/extTools.h index a93b6c85..686f0b4e 100644 --- a/bootstrap/unix-88/extTools.h +++ b/bootstrap/unix-88/extTools.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef extTools__h #define extTools__h diff --git a/bootstrap/windows-48/Compiler.c b/bootstrap/windows-48/Compiler.c index 993c2bac..4460479d 100644 --- a/bootstrap/windows-48/Compiler.c +++ b/bootstrap/windows-48/Compiler.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspamS */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspamS */ #define SHORTINT INT8 #define INTEGER INT16 @@ -89,7 +89,7 @@ static void Compiler_PropagateElementaryTypeSizes (void) OPT_sintobj->typ = OPT_sinttyp; OPT_intobj->typ = OPT_inttyp; OPT_lintobj->typ = OPT_linttyp; - switch (OPM_LongintSize) { + switch (OPM_SetSize) { case 4: OPT_settyp = OPT_set32typ; break; diff --git a/bootstrap/windows-48/Configuration.c b/bootstrap/windows-48/Configuration.c index 80b87b1d..fa87c9de 100644 --- a/bootstrap/windows-48/Configuration.c +++ b/bootstrap/windows-48/Configuration.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -8,7 +8,7 @@ #include "SYSTEM.h" -export CHAR Configuration_versionLong[75]; +export CHAR Configuration_versionLong[76]; @@ -19,6 +19,6 @@ export void *Configuration__init(void) __DEFMOD; __REGMOD("Configuration", 0); /* BEGIN */ - __MOVE("2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75); + __MOVE("2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 76); __ENDMOD; } diff --git a/bootstrap/windows-48/Configuration.h b/bootstrap/windows-48/Configuration.h index cdc285e5..c3c54eed 100644 --- a/bootstrap/windows-48/Configuration.h +++ b/bootstrap/windows-48/Configuration.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Configuration__h #define Configuration__h @@ -6,7 +6,7 @@ #include "SYSTEM.h" -import CHAR Configuration_versionLong[75]; +import CHAR Configuration_versionLong[76]; import void *Configuration__init(void); diff --git a/bootstrap/windows-48/Files.c b/bootstrap/windows-48/Files.c index 3eecd248..553bb49a 100644 --- a/bootstrap/windows-48/Files.c +++ b/bootstrap/windows-48/Files.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -26,7 +26,7 @@ typedef Files_BufDesc *Files_Buffer; typedef - CHAR Files_FileName[101]; + CHAR Files_FileName[256]; typedef struct Files_FileDesc { @@ -48,6 +48,7 @@ typedef } Files_Rider; +export INT16 Files_MaxPathLength, Files_MaxNameLength; static Files_FileDesc *Files_files; static INT16 Files_tempno; static CHAR Files_HOME[1024]; @@ -85,6 +86,7 @@ export INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ); export void Files_Purge (Files_File f); export void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); export void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x); +export void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n); export void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x); export void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x); @@ -129,17 +131,17 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode) Out_String((CHAR*)": ", 3); if (f != NIL) { if (f->registerName[0] != 0x00) { - Out_String(f->registerName, 101); + Out_String(f->registerName, 256); } else { - Out_String(f->workName, 101); + Out_String(f->workName, 256); } if (f->fd != 0) { - Out_String((CHAR*)"f.fd = ", 8); + Out_String((CHAR*)", f.fd = ", 10); Out_Int(f->fd, 1); } } if (errcode != 0) { - Out_String((CHAR*)" errcode = ", 12); + Out_String((CHAR*)", errcode = ", 13); Out_Int(errcode, 1); } Out_Ln(); @@ -149,76 +151,75 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode) static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len) { - INT16 i, j; + INT16 i, j, ld, ln; __DUP(dir, dir__len, CHAR); __DUP(name, name__len, CHAR); + ld = Strings_Length(dir, dir__len); + ln = Strings_Length(name, name__len); + while ((ld > 0 && dir[__X(ld - 1, dir__len)] == '/')) { + ld -= 1; + } + if (((ld + ln) + 2) > dest__len) { + Files_Err((CHAR*)"File name too long", 19, NIL, 0); + } i = 0; + while (i < ld) { + dest[__X(i, dest__len)] = dir[__X(i, dir__len)]; + i += 1; + } + if (i > 0) { + dest[__X(i, dest__len)] = '/'; + i += 1; + } 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]; + while (j < ln) { + dest[__X(i, dest__len)] = name[__X(j, name__len)]; i += 1; j += 1; } - dest[i] = 0x00; + dest[__X(i, dest__len)] = 0x00; __DEL(dir); __DEL(name); } static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len) { - INT32 n, i, j; + INT16 i, n; __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; - } + if (finalName[0] == '/') { + __COPY(finalName, name, name__len); + } else { + Files_MakeFileName(Platform_CWD, 4096, finalName, finalName__len, (void*)name, name__len); } - j = 0; - while (finalName[j] != 0x00) { - name[i] = finalName[j]; - i += 1; - j += 1; - } - i -= 1; - while (name[i] != '/') { + i = Strings_Length(name, name__len) - 1; + while ((i > 0 && name[__X(i, name__len)] != '/')) { i -= 1; } - name[i + 1] = '.'; - name[i + 2] = 't'; - name[i + 3] = 'm'; - name[i + 4] = 'p'; - name[i + 5] = '.'; + if ((i + 16) >= name__len) { + Files_Err((CHAR*)"File name too long", 19, NIL, 0); + } + Files_tempno += 1; + n = Files_tempno; + name[__X(i + 1, name__len)] = '.'; + name[__X(i + 2, name__len)] = 't'; + name[__X(i + 3, name__len)] = 'm'; + name[__X(i + 4, name__len)] = 'p'; + name[__X(i + 5, name__len)] = '.'; i += 6; while (n > 0) { - name[i] = (CHAR)((int)__MOD(n, 10) + 48); + name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48); n = __DIV(n, 10); i += 1; } - name[i] = '.'; + name[__X(i, name__len)] = '.'; i += 1; n = Platform_PID; while (n > 0) { - name[i] = (CHAR)((int)__MOD(n, 10) + 48); + name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48); n = __DIV(n, 10); i += 1; } - name[i] = 0x00; + name[__X(i, name__len)] = 0x00; __DEL(finalName); } @@ -236,11 +237,11 @@ static void Files_Deregister (CHAR *name, ADDRESS name__len) if (osfile != NIL) { __ASSERT(!osfile->tempFile, 0); __ASSERT(osfile->fd >= 0, 0); - __MOVE(osfile->workName, osfile->registerName, 101); - Files_GetTempName(osfile->registerName, 101, (void*)osfile->workName, 101); + __MOVE(osfile->workName, osfile->registerName, 256); + Files_GetTempName(osfile->registerName, 256, (void*)osfile->workName, 256); osfile->tempFile = 1; osfile->state = 0; - error = Platform_Rename((void*)osfile->registerName, 101, (void*)osfile->workName, 101); + error = Platform_Rename((void*)osfile->registerName, 256, (void*)osfile->workName, 256); if (error != 0) { Files_Err((CHAR*)"Couldn't rename previous version of file being registered", 58, osfile, error); } @@ -256,17 +257,17 @@ static void Files_Create (Files_File f) CHAR err[32]; if (f->fd == -1) { if (f->state == 1) { - Files_GetTempName(f->registerName, 101, (void*)f->workName, 101); + Files_GetTempName(f->registerName, 256, (void*)f->workName, 256); f->tempFile = 1; } else { __ASSERT(f->state == 2, 0); - Files_Deregister(f->registerName, 101); - __MOVE(f->registerName, f->workName, 101); + Files_Deregister(f->registerName, 256); + __MOVE(f->registerName, f->workName, 256); f->registerName[0] = 0x00; f->tempFile = 0; } - error = Platform_Unlink((void*)f->workName, 101); - error = Platform_New((void*)f->workName, 101, &f->fd); + error = Platform_Unlink((void*)f->workName, 256); + error = Platform_New((void*)f->workName, 256, &f->fd); done = error == 0; if (done) { f->next = Files_files; @@ -319,8 +320,8 @@ void Files_Close (Files_File f) 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]); + while ((i < 4 && f->bufs[__X(i, 4)] != NIL)) { + Files_Flush(f->bufs[__X(i, 4)]); i += 1; } } @@ -337,7 +338,7 @@ Files_File Files_New (CHAR *name, ADDRESS name__len) __DUP(name, name__len, CHAR); __NEW(f, Files_FileDesc); f->workName[0] = 0x00; - __COPY(name, f->registerName, 101); + __COPY(name, f->registerName, 256); f->fd = -1; f->state = 1; f->len = 0; @@ -359,35 +360,35 @@ static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len) *pos += 1; } } else { - ch = (Files_SearchPath->data)[*pos]; + ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])]; while (ch == ' ' || ch == ';') { *pos += 1; - ch = (Files_SearchPath->data)[*pos]; + ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])]; } if (ch == '~') { *pos += 1; - ch = (Files_SearchPath->data)[*pos]; - while (Files_HOME[i] != 0x00) { - dir[i] = Files_HOME[i]; + ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])]; + while (Files_HOME[__X(i, 1024)] != 0x00) { + dir[__X(i, dir__len)] = Files_HOME[__X(i, 1024)]; i += 1; } if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) { - while ((i > 0 && dir[i - 1] != '/')) { + while ((i > 0 && dir[__X(i - 1, dir__len)] != '/')) { i -= 1; } } } while ((ch != 0x00 && ch != ';')) { - dir[i] = ch; + dir[__X(i, dir__len)] = ch; i += 1; *pos += 1; - ch = (Files_SearchPath->data)[*pos]; + ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])]; } - while ((i > 0 && dir[i - 1] == ' ')) { + while ((i > 0 && dir[__X(i - 1, dir__len)] == ' ')) { i -= 1; } } - dir[i] = 0x00; + dir[__X(i, dir__len)] = 0x00; } static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len) @@ -398,7 +399,7 @@ static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len) ch = name[0]; while ((ch != 0x00 && ch != '/')) { i += 1; - ch = name[i]; + ch = name[__X(i, name__len)]; } return ch == '/'; } @@ -413,9 +414,9 @@ static Files_File Files_CacheEntry (Platform_FileIdentity 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; + if (f->bufs[__X(i, 4)] != NIL) { + f->bufs[__X(i, 4)]->org = -1; + f->bufs[__X(i, 4)] = NIL; } i += 1; } @@ -482,7 +483,7 @@ Files_File Files_Old (CHAR *name, ADDRESS name__len) f->pos = 0; f->swapper = -1; error = Platform_Size(fd, &f->len); - __COPY(name, f->workName, 101); + __COPY(name, f->workName, 256); f->registerName[0] = 0x00; f->tempFile = 0; f->identity = identity; @@ -514,9 +515,9 @@ void Files_Purge (Files_File f) INT16 error; i = 0; while (i < 4) { - if (f->bufs[i] != NIL) { - f->bufs[i]->org = -1; - f->bufs[i] = NIL; + if (f->bufs[__X(i, 4)] != NIL) { + f->bufs[__X(i, 4)]->org = -1; + f->bufs[__X(i, 4)] = NIL; } i += 1; } @@ -560,22 +561,22 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos) offset = __MASK(pos, -4096); org = pos - offset; i = 0; - while ((((i < 4 && f->bufs[i] != NIL)) && org != f->bufs[i]->org)) { + while ((((i < 4 && f->bufs[__X(i, 4)] != NIL)) && org != f->bufs[__X(i, 4)]->org)) { i += 1; } if (i < 4) { - if (f->bufs[i] == NIL) { + if (f->bufs[__X(i, 4)] == NIL) { __NEW(buf, Files_BufDesc); buf->chg = 0; buf->org = -1; buf->f = f; - f->bufs[i] = buf; + f->bufs[__X(i, 4)] = buf; } else { - buf = f->bufs[i]; + buf = f->bufs[__X(i, 4)]; } } else { f->swapper = __MASK(f->swapper + 1, -4); - buf = f->bufs[f->swapper]; + buf = f->bufs[__X(f->swapper, 4)]; Files_Flush(buf); } if (buf->org != org) { @@ -622,7 +623,7 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x) } Files_Assert(offset <= buf->size); if (offset < buf->size) { - *x = buf->data[offset]; + *x = buf->data[__X(offset, 4096)]; (*r).offset = offset + 1; } else if ((*r).org + offset < buf->f->len) { Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset); @@ -634,6 +635,11 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x) } } +void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x) +{ + Files_Read(&*r, r__typ, &*x); +} + void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n) { INT32 xpos, min, restInBuf, offset; @@ -660,7 +666,7 @@ void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x } else { min = n; } - __MOVE((ADDRESS)&buf->data[offset], (ADDRESS)&x[xpos], min); + __MOVE((ADDRESS)&buf->data[__X(offset, 4096)], (ADDRESS)&x[__X(xpos, x__len)], min); offset += min; (*r).offset = offset; xpos += min; @@ -689,7 +695,7 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x) offset = (*r).offset; } Files_Assert(offset < 4096); - buf->data[offset] = x; + buf->data[__X(offset, 4096)] = x; buf->chg = 1; if (offset == buf->size) { buf->size += 1; @@ -723,7 +729,7 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS } else { min = n; } - __MOVE((ADDRESS)&x[xpos], (ADDRESS)&buf->data[offset], min); + __MOVE((ADDRESS)&x[__X(xpos, x__len)], (ADDRESS)&buf->data[__X(offset, 4096)], min); offset += min; (*r).offset = offset; Files_Assert(offset <= 4096); @@ -817,12 +823,12 @@ void Files_Register (Files_File f) } Files_Close(f); if (f->registerName[0] != 0x00) { - Files_Deregister(f->registerName, 101); - Files_Rename(f->workName, 101, f->registerName, 101, &errcode); + Files_Deregister(f->registerName, 256); + Files_Rename(f->workName, 256, f->registerName, 256, &errcode); if (errcode != 0) { Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode); } - __MOVE(f->registerName, f->workName, 101); + __MOVE(f->registerName, f->workName, 256); f->registerName[0] = 0x00; f->tempFile = 0; } @@ -843,7 +849,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *de j = 0; while (i > 0) { i -= 1; - dest[j] = src[i]; + dest[__X(j, dest__len)] = src[__X(i, src__len)]; j += 1; } } else { @@ -900,7 +906,7 @@ void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len) i = 0; do { Files_Read(&*R, R__typ, (void*)&ch); - x[i] = ch; + x[__X(i, x__len)] = ch; i += 1; } while (!(ch == 0x00)); } @@ -910,16 +916,16 @@ void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len) INT16 i; i = 0; do { - Files_Read(&*R, R__typ, (void*)&x[i]); + Files_Read(&*R, R__typ, (void*)&x[__X(i, x__len)]); i += 1; - } while (!(x[i - 1] == 0x00 || x[i - 1] == 0x0a)); - if (x[i - 1] == 0x0a) { + } while (!(x[__X(i - 1, x__len)] == 0x00 || x[__X(i - 1, x__len)] == 0x0a)); + if (x[__X(i - 1, x__len)] == 0x0a) { i -= 1; } - if ((i > 0 && x[i - 1] == 0x0d)) { + if ((i > 0 && x[__X(i - 1, x__len)] == 0x0d)) { i -= 1; } - x[i] = 0x00; + x[__X(i, x__len)] = 0x00; } void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len) @@ -947,18 +953,18 @@ void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x) void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x) { CHAR b[2]; - b[0] = (CHAR)x; - b[1] = (CHAR)__ASHR(x, 8); + b[0] = __CHR(x); + b[1] = __CHR(__ASHR(x, 8)); Files_WriteBytes(&*R, R__typ, (void*)b, 2, 2); } void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 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); + b[0] = __CHR(x); + b[1] = __CHR(__ASHR(x, 8)); + b[2] = __CHR(__ASHR(x, 16)); + b[3] = __CHR(__ASHR(x, 24)); Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4); } @@ -966,11 +972,13 @@ void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x) { CHAR b[4]; INT32 i; - i = (INT32)x; - b[0] = (CHAR)i; - b[1] = (CHAR)__ASHR(i, 8); - b[2] = (CHAR)__ASHR(i, 16); - b[3] = (CHAR)__ASHR(i, 24); + UINT64 y; + y = x; + i = __VAL(INT32, y); + b[0] = __CHR(i); + b[1] = __CHR(__ASHR(i, 8)); + b[2] = __CHR(__ASHR(i, 16)); + b[3] = __CHR(__ASHR(i, 24)); Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4); } @@ -992,7 +1000,7 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len { INT16 i; i = 0; - while (x[i] != 0x00) { + while (x[__X(i, x__len)] != 0x00) { i += 1; } Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1); @@ -1001,10 +1009,10 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x) { while (x < -64 || x > 63) { - Files_Write(&*R, R__typ, (CHAR)(__MASK(x, -128) + 128)); + Files_Write(&*R, R__typ, __CHR(__MASK(x, -128) + 128)); x = __ASHR(x, 7); } - Files_Write(&*R, R__typ, (CHAR)__MASK(x, -128)); + Files_Write(&*R, R__typ, __CHR(__MASK(x, -128))); } void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len) @@ -1041,7 +1049,7 @@ static void Files_Finalize (SYSTEM_PTR o) if (f->fd >= 0) { Files_CloseOSFile(f); if (f->tempFile) { - res = Platform_Unlink((void*)f->workName, 101); + res = Platform_Unlink((void*)f->workName, 256); } } } @@ -1063,7 +1071,7 @@ static void EnumPtrs(void (*P)(void*)) P(Files_SearchPath); } -__TDESC(Files_FileDesc, 1, 4) = {__TDFLDS("FileDesc", 260), {236, 240, 244, 248, -20}}; +__TDESC(Files_FileDesc, 1, 4) = {__TDFLDS("FileDesc", 572), {548, 552, 556, 560, -20}}; __TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4112), {0, -8}}; __TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 20), {8, -8}}; @@ -1083,5 +1091,7 @@ export void *Files__init(void) Heap_FileCount = 0; Files_HOME[0] = 0x00; Platform_GetEnv((CHAR*)"HOME", 5, (void*)Files_HOME, 1024); + Files_MaxPathLength = Platform_MaxPathLength(); + Files_MaxNameLength = Platform_MaxNameLength(); __ENDMOD; } diff --git a/bootstrap/windows-48/Files.h b/bootstrap/windows-48/Files.h index 2dc667a1..dadf1ace 100644 --- a/bootstrap/windows-48/Files.h +++ b/bootstrap/windows-48/Files.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Files__h #define Files__h @@ -11,7 +11,7 @@ typedef typedef struct Files_FileDesc { INT32 _prvt0; - char _prvt1[256]; + char _prvt1[568]; } Files_FileDesc; typedef @@ -22,6 +22,7 @@ typedef } Files_Rider; +import INT16 Files_MaxPathLength, Files_MaxNameLength; import ADDRESS *Files_FileDesc__typ; import ADDRESS *Files_Rider__typ; @@ -39,6 +40,7 @@ import INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ); import void Files_Purge (Files_File f); import void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); import void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x); +import void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); import void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n); import void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x); import void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x); diff --git a/bootstrap/windows-48/Heap.c b/bootstrap/windows-48/Heap.c index c12cb722..42552415 100644 --- a/bootstrap/windows-48/Heap.c +++ b/bootstrap/windows-48/Heap.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tsSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -68,9 +68,10 @@ static INT32 Heap_freeList[10]; static INT32 Heap_bigBlocks; export INT32 Heap_allocated; static BOOLEAN Heap_firstTry; +static INT16 Heap_ldUnit; export INT32 Heap_heap; static INT32 Heap_heapMin, Heap_heapMax; -export INT32 Heap_heapsize; +export INT32 Heap_heapsize, Heap_heapMinExpand; static Heap_FinNode Heap_fin; static INT16 Heap_lockdepth; static BOOLEAN Heap_interrupted; @@ -228,10 +229,10 @@ static INT32 Heap_NewChunk (INT32 blksz) static void Heap_ExtendHeap (INT32 blksz) { INT32 size, chnk, j, next; - if (Heap_uLT(160000, blksz)) { + if (Heap_uLT(Heap_heapMinExpand, blksz)) { size = blksz; } else { - size = 160000; + size = Heap_heapMinExpand; } chnk = Heap_NewChunk(size); if (chnk != 0) { @@ -248,6 +249,8 @@ static void Heap_ExtendHeap (INT32 blksz) __PUT(chnk, next, INT32); __PUT(j, chnk, INT32); } + } else if (!Heap_firstTry) { + Heap_heapMinExpand = 16; } } @@ -257,16 +260,16 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag) SYSTEM_PTR new; Heap_Lock(); __GET(tag, blksz, INT32); - i0 = __ASHR(blksz, 4); + i0 = __LSH(blksz, -Heap_ldUnit, 32); i = i0; - if (Heap_uLT(i, 9)) { + if (i < 9) { adr = Heap_freeList[i]; while (adr == 0) { i += 1; adr = Heap_freeList[i]; } } - if (Heap_uLT(i, 9)) { + if (i < 9) { __GET(adr + 12, next, INT32); Heap_freeList[i] = next; if (i != i0) { @@ -289,16 +292,17 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag) if (Heap_firstTry) { Heap_GC(1); blksz += 16; - if (Heap_uLT(Heap_heapsize - Heap_allocated, blksz) || Heap_uLT(__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2), Heap_heapsize)) { - Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize); + t = __LSH(Heap_allocated + blksz, -(2 + Heap_ldUnit), 32) * 80; + if (Heap_uLT(Heap_heapsize, t)) { + Heap_ExtendHeap(t - 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); + Heap_ExtendHeap(blksz); new = Heap_NEWREC(tag); } + Heap_firstTry = 1; Heap_Unlock(); return new; } else { @@ -443,7 +447,7 @@ static void Heap_Scan (void) __PUT(start, start + 4, INT32); __PUT(start + 4, freesize, INT32); __PUT(start + 8, -4, INT32); - i = __ASHR(freesize, 4); + i = __LSH(freesize, -Heap_ldUnit, 32); freesize = 0; if (Heap_uLT(i, 9)) { __PUT(start + 12, Heap_freeList[i], INT32); @@ -469,7 +473,7 @@ static void Heap_Scan (void) __PUT(start, start + 4, INT32); __PUT(start + 4, freesize, INT32); __PUT(start + 8, -4, INT32); - i = __ASHR(freesize, 4); + i = __LSH(freesize, -Heap_ldUnit, 32); freesize = 0; if (Heap_uLT(i, 9)) { __PUT(start + 12, Heap_freeList[i], INT32); @@ -661,79 +665,77 @@ void Heap_GC (BOOLEAN markStack) Heap_Module m; INT32 i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23; INT32 cand[10000]; - if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) { - Heap_Lock(); - m = (Heap_Module)(ADDRESS)Heap_modules; - while (m != NIL) { - if (m->enumPtrs != NIL) { - (*m->enumPtrs)(Heap_MarkP); - } - m = m->next; + Heap_Lock(); + m = (Heap_Module)(ADDRESS)Heap_modules; + while (m != NIL) { + if (m->enumPtrs != NIL) { + (*m->enumPtrs)(Heap_MarkP); } - 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(32, (void*)cand, 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(); + 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(32, (void*)cand, 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) @@ -756,6 +758,8 @@ void Heap_InitHeap (void) Heap_heapMin = -1; Heap_heapMax = 0; Heap_bigBlocks = 0; + Heap_heapMinExpand = 128000; + Heap_ldUnit = 4; Heap_heap = Heap_NewChunk(128000); __PUT(Heap_heap, 0, INT32); Heap_firstTry = 1; diff --git a/bootstrap/windows-48/Heap.h b/bootstrap/windows-48/Heap.h index de4d17ce..3cde1c3b 100644 --- a/bootstrap/windows-48/Heap.h +++ b/bootstrap/windows-48/Heap.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tsSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */ #ifndef Heap__h #define Heap__h @@ -48,7 +48,7 @@ typedef import SYSTEM_PTR Heap_modules; import INT32 Heap_allocated; import INT32 Heap_heap; -import INT32 Heap_heapsize; +import INT32 Heap_heapsize, Heap_heapMinExpand; import INT16 Heap_FileCount; import ADDRESS *Heap_ModuleDesc__typ; diff --git a/bootstrap/windows-48/Modules.c b/bootstrap/windows-48/Modules.c index b437b514..bdad4713 100644 --- a/bootstrap/windows-48/Modules.c +++ b/bootstrap/windows-48/Modules.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -404,7 +404,7 @@ static void Modules_errint (INT32 l) if (l >= 10) { Modules_errint(__DIV(l, 10)); } - Modules_errch((CHAR)((int)__MOD(l, 10) + 48)); + Modules_errch(__CHR((int)__MOD(l, 10) + 48)); } static void Modules_DisplayHaltCode (INT32 code) diff --git a/bootstrap/windows-48/Modules.h b/bootstrap/windows-48/Modules.h index 8436f089..26d86b38 100644 --- a/bootstrap/windows-48/Modules.h +++ b/bootstrap/windows-48/Modules.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Modules__h #define Modules__h diff --git a/bootstrap/windows-48/OPB.c b/bootstrap/windows-48/OPB.c index 19e40505..913fbf2d 100644 --- a/bootstrap/windows-48/OPB.c +++ b/bootstrap/windows-48/OPB.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -261,7 +261,7 @@ static void OPB_CharToString (OPT_Node n) { CHAR ch; n->typ = OPT_stringtyp; - ch = (CHAR)n->conval->intval; + ch = __CHR(n->conval->intval); n->conval->ext = OPT_NewExt(); if (ch == 0x00) { n->conval->intval2 = 1; @@ -597,7 +597,7 @@ void OPB_MOp (INT8 op, OPT_Node *x) case 22: if (f == 3) { if (z->class == 7) { - z->conval->intval = (INT16)__CAP((CHAR)z->conval->intval); + z->conval->intval = (INT16)__CAP(__CHR(z->conval->intval)); z->obj = NIL; } else { z = NewOp__29(op, typ, z); @@ -1136,7 +1136,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ) OPB_err(203); r = (LONGREAL)1; } - (*x)->conval->intval = (INT32)__ENTIER(r); + (*x)->conval->intval = __SHORT(__ENTIER(r), 2147483648LL); OPB_SetIntType(*x); } } @@ -1626,6 +1626,7 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode) if (x == y) { } else if ((((y->comp == 2 && y->BaseTyp == x->BaseTyp)) && y->n <= x->n)) { } else if ((y->comp == 3 && y->BaseTyp == x->BaseTyp)) { + OPB_err(113); } else if (x->BaseTyp == OPT_chartyp) { if (g == 8) { if (ynode->conval->intval2 > x->n) { diff --git a/bootstrap/windows-48/OPB.h b/bootstrap/windows-48/OPB.h index 71d82def..f66fcd66 100644 --- a/bootstrap/windows-48/OPB.h +++ b/bootstrap/windows-48/OPB.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPB__h #define OPB__h diff --git a/bootstrap/windows-48/OPC.c b/bootstrap/windows-48/OPC.c index a5f41a8e..7b92ccc1 100644 --- a/bootstrap/windows-48/OPC.c +++ b/bootstrap/windows-48/OPC.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -618,31 +618,33 @@ 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 __", 11); - OPC_Ident(obj); - OPC_DeclareParams(obj->link, 1); - OPM_WriteString((CHAR*)" __SEND(", 9); - if (obj->link->typ->form == 11) { - OPM_WriteString((CHAR*)"__TYPEOF(", 10); - OPC_Ident(obj->link); + if ((obj->mode == 13 && obj == OPC_BaseTProc(obj))) { + if (OPM_currFile == 1 || (OPM_currFile == 0 && obj->vis == 1)) { + OPM_WriteString((CHAR*)"#define __", 11); + OPC_Ident(obj); + OPC_DeclareParams(obj->link, 1); + OPM_WriteString((CHAR*)" __SEND(", 9); + if (obj->link->typ->form == 11) { + OPM_WriteString((CHAR*)"__TYPEOF(", 10); + OPC_Ident(obj->link); + OPM_Write(')'); + } else { + OPC_Ident(obj->link); + OPM_WriteString((CHAR*)"__typ", 6); + } + OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16)); + if (obj->typ == OPT_notyp) { + OPM_WriteString((CHAR*)"void", 5); + } else { + OPC_Ident(obj->typ->strobj); + } + OPM_WriteString((CHAR*)"(*)", 4); + OPC_AnsiParamList(obj->link, 0); + OPM_WriteString((CHAR*)", ", 3); + OPC_DeclareParams(obj->link, 1); OPM_Write(')'); - } else { - OPC_Ident(obj->link); - OPM_WriteString((CHAR*)"__typ", 6); + OPM_WriteLn(); } - OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16)); - if (obj->typ == OPT_notyp) { - OPM_WriteString((CHAR*)"void", 5); - } else { - OPC_Ident(obj->typ->strobj); - } - OPM_WriteString((CHAR*)"(*)", 4); - OPC_AnsiParamList(obj->link, 0); - OPM_WriteString((CHAR*)", ", 3); - OPC_DeclareParams(obj->link, 1); - OPM_Write(')'); - OPM_WriteLn(); } OPC_DefineTProcMacros(obj->right, &*empty); } @@ -652,7 +654,7 @@ static void OPC_DefineType (OPT_Struct str) { OPT_Object obj = NIL, field = NIL, par = NIL; BOOLEAN empty; - if (OPM_currFile == 1 || str->ref < 255) { + if ((OPM_currFile == 1 || str->ref < 255) || (((OPM_currFile == 0 && str->strobj != NIL)) && str->strobj->vis == 1)) { obj = str->strobj; if (obj == NIL || OPC_Undefined(obj)) { if (obj != NIL) { @@ -681,6 +683,10 @@ static void OPC_DefineType (OPT_Struct str) OPC_DefineType(str->BaseTyp); } } else if (__IN(str->comp, 0x0c, 32)) { + if ((str->BaseTyp->strobj != NIL && str->BaseTyp->strobj->linkadr == 1)) { + OPM_Mark(244, str->txtpos); + str->BaseTyp->strobj->linkadr = 2; + } OPC_DefineType(str->BaseTyp); } else if (str->form == 12) { if (str->BaseTyp != OPT_notyp) { @@ -715,6 +721,13 @@ static void OPC_DefineType (OPT_Struct str) if (!empty) { OPM_WriteLn(); } + } else if ((obj->typ->form == 11 && obj->typ->BaseTyp->comp == 4)) { + empty = 1; + OPC_DeclareTProcs(obj->typ->BaseTyp->link, &empty); + OPC_DefineTProcMacros(obj->typ->BaseTyp->link, &empty); + if (!empty) { + OPM_WriteLn(); + } } } } @@ -1138,7 +1151,7 @@ static void OPC_GenHeaderMsg (void) OPM_WriteString((CHAR*)"/* ", 4); OPM_WriteString((CHAR*)"voc", 4); OPM_Write(' '); - OPM_WriteString(Configuration_versionLong, 75); + OPM_WriteString(Configuration_versionLong, 76); OPM_Write(' '); i = 0; while (i <= 31) { @@ -1739,7 +1752,7 @@ static void OPC_CharacterLiteral (INT64 c) if ((c == 92 || c == 39) || c == 63) { OPM_Write('\\'); } - OPM_Write((CHAR)c); + OPM_Write(__CHR(c)); OPM_Write('\''); } } @@ -1755,16 +1768,16 @@ static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l) c = (INT16)s[__X(i, s__len)]; if (c < 32 || c > 126) { OPM_Write('\\'); - OPM_Write((CHAR)(48 + __ASHR(c, 6))); + OPM_Write(__CHR(48 + __ASHR(c, 6))); c = __MASK(c, -64); - OPM_Write((CHAR)(48 + __ASHR(c, 3))); + OPM_Write(__CHR(48 + __ASHR(c, 3))); c = __MASK(c, -8); - OPM_Write((CHAR)(48 + c)); + OPM_Write(__CHR(48 + c)); } else { if ((c == 92 || c == 34) || c == 63) { OPM_Write('\\'); } - OPM_Write((CHAR)c); + OPM_Write(__CHR(c)); } i += 1; } @@ -1830,6 +1843,12 @@ void OPC_IntLiteral (INT64 n, INT32 size) void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim) { + INT64 d; + d = dim; + while (d > 0) { + array = array->BaseTyp; + d -= 1; + } if (array->comp == 3) { OPC_CompleteIdent(obj); OPM_WriteString((CHAR*)"__len", 6); @@ -1837,10 +1856,6 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim) OPM_WriteInt(dim); } } else { - while (dim > 0) { - array = array->BaseTyp; - dim -= 1; - } OPM_WriteInt(array->n); } } diff --git a/bootstrap/windows-48/OPC.h b/bootstrap/windows-48/OPC.h index 38a2b01d..3bfd88b8 100644 --- a/bootstrap/windows-48/OPC.h +++ b/bootstrap/windows-48/OPC.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPC__h #define OPC__h diff --git a/bootstrap/windows-48/OPM.c b/bootstrap/windows-48/OPM.c index 8f903e46..bcb39247 100644 --- a/bootstrap/windows-48/OPM.c +++ b/bootstrap/windows-48/OPM.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -19,6 +19,8 @@ typedef CHAR OPM_FileName[32]; +static CHAR OPM_currentComment[256]; +static BOOLEAN OPM_hasComment; static CHAR OPM_SourceFileName[256]; static CHAR OPM_GlobalModel[10]; export CHAR OPM_Model[10]; @@ -27,7 +29,7 @@ export INT16 OPM_AddressSize; static INT16 OPM_GlobalAlignment; export INT16 OPM_Alignment; export UINT32 OPM_GlobalOptions, OPM_Options; -export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; +export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize; export INT64 OPM_MaxIndex; export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; export BOOLEAN OPM_noerr; @@ -59,6 +61,7 @@ static void OPM_FindInstallDir (void); static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos); static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len); export void OPM_Get (CHAR *ch); +export void OPM_GetComment (CHAR *text, ADDRESS text__len); export void OPM_Init (BOOLEAN *done); export void OPM_InitOptions (void); export INT16 OPM_Integer (INT64 n); @@ -82,6 +85,7 @@ static void OPM_ScanOptions (CHAR *s, ADDRESS s__len); static void OPM_ShowLine (INT64 pos); export INT64 OPM_SignedMaximum (INT32 bytecount); export INT64 OPM_SignedMinimum (INT32 bytecount); +export void OPM_StoreComment (CHAR *text, ADDRESS text__len); export void OPM_SymRCh (CHAR *ch); export INT32 OPM_SymRInt (void); export INT64 OPM_SymRInt64 (void); @@ -157,6 +161,36 @@ void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len) __DEL(modname); } +void OPM_StoreComment (CHAR *text, ADDRESS text__len) +{ + INT16 i; + __DUP(text, text__len, CHAR); + i = 0; + while ((i < 255 && text[__X(i, text__len)] != 0x00)) { + OPM_currentComment[__X(i, 256)] = text[__X(i, text__len)]; + i += 1; + } + OPM_currentComment[__X(i, 256)] = 0x00; + OPM_hasComment = 1; + __DEL(text); +} + +void OPM_GetComment (CHAR *text, ADDRESS text__len) +{ + INT16 i; + if (OPM_hasComment) { + i = 0; + while ((((i < text__len && i < 256)) && OPM_currentComment[__X(i, 256)] != 0x00)) { + text[__X(i, text__len)] = OPM_currentComment[__X(i, 256)]; + i += 1; + } + text[__X(i, text__len)] = 0x00; + OPM_hasComment = 0; + } else { + text[0] = 0x00; + } +} + INT64 OPM_SignedMaximum (INT32 bytecount) { INT64 result; @@ -272,7 +306,7 @@ BOOLEAN OPM_OpenPar (void) if (Modules_ArgCount == 1) { OPM_LogWLn(); OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20); - OPM_LogWStr(Configuration_versionLong, 75); + OPM_LogWStr(Configuration_versionLong, 76); OPM_LogW('.'); OPM_LogWLn(); OPM_LogWStr((CHAR*)"Based on Ofront by J. Templ and Software Templ OEG.", 52); @@ -338,7 +372,7 @@ BOOLEAN OPM_OpenPar (void) OPM_LogWLn(); OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95); OPM_LogWLn(); - OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); + OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER and SET, 64 bit LONGINT.", 95); OPM_LogWLn(); OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); OPM_LogWLn(); @@ -410,21 +444,25 @@ void OPM_InitOptions (void) OPM_ShortintSize = 1; OPM_IntegerSize = 2; OPM_LongintSize = 4; + OPM_SetSize = 4; break; case 'C': OPM_ShortintSize = 2; OPM_IntegerSize = 4; OPM_LongintSize = 8; + OPM_SetSize = 4; break; case 'V': OPM_ShortintSize = 1; OPM_IntegerSize = 4; OPM_LongintSize = 8; + OPM_SetSize = 8; break; default: OPM_ShortintSize = 1; OPM_IntegerSize = 2; OPM_LongintSize = 4; + OPM_SetSize = 4; break; } __MOVE(OPM_InstallDir, OPM_ResourceDir, 1024); @@ -606,7 +644,7 @@ static void OPM_ShowLine (INT64 pos) if (pos >= (INT64)OPM_ErrorLineLimitPos) { pos = OPM_ErrorLineLimitPos - 1; } - i = (INT16)OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos); + i = __SHORTF(OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos), 32768); while (i > 0) { OPM_LogW(' '); i -= 1; @@ -759,7 +797,7 @@ void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done) Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, 0); Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&tag); Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ver); - if (tag != 0xf7 || ver != 0x83) { + if (tag != 0xf7 || ver != 0x84) { if (!__IN(4, OPM_Options, 32)) { OPM_err(-306); } @@ -830,7 +868,7 @@ void OPM_NewSym (CHAR *modName, ADDRESS modName__len) if (OPM_newSFile != NIL) { Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, 0); Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7); - Files_Write(&OPM_newSF, Files_Rider__typ, 0x83); + Files_Write(&OPM_newSF, Files_Rider__typ, 0x84); } else { OPM_err(153); } @@ -865,17 +903,17 @@ void OPM_WriteHex (INT64 i) { CHAR s[3]; INT32 digit; - digit = __ASHR((INT32)i, 4); + digit = __ASHR(__SHORT(i, 2147483648LL), 4); if (digit < 10) { - s[0] = (CHAR)(48 + digit); + s[0] = __CHR(48 + digit); } else { - s[0] = (CHAR)(87 + digit); + s[0] = __CHR(87 + digit); } - digit = __MASK((INT32)i, -16); + digit = __MASK(__SHORT(i, 2147483648LL), -16); if (digit < 10) { - s[1] = (CHAR)(48 + digit); + s[1] = __CHR(48 + digit); } else { - s[1] = (CHAR)(87 + digit); + s[1] = __CHR(87 + digit); } s[2] = 0x00; OPM_WriteString(s, 3); @@ -897,11 +935,11 @@ void OPM_WriteInt (INT64 i) __MOVE("LL", s, 3); k = 2; } - s[__X(k, 26)] = (CHAR)(__MOD(i1, 10) + 48); + s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48); i1 = __DIV(i1, 10); k += 1; while (i1 > 0) { - s[__X(k, 26)] = (CHAR)(__MOD(i1, 10) + 48); + s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48); i1 = __DIV(i1, 10); k += 1; } @@ -924,13 +962,13 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx) CHAR s[32]; CHAR ch; INT16 i; - if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == ((INT32)__ENTIER(r)))) { + if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == (__SHORT(__ENTIER(r), 2147483648LL)))) { if (suffx == 'f') { OPM_WriteString((CHAR*)"(REAL)", 7); } else { OPM_WriteString((CHAR*)"(LONGREAL)", 11); } - OPM_WriteInt((INT32)__ENTIER(r)); + OPM_WriteInt(__SHORT(__ENTIER(r), 2147483648LL)); } else { Texts_OpenWriter(&W, Texts_Writer__typ); if (suffx == 'f') { @@ -1139,5 +1177,7 @@ export void *OPM__init(void) OPM_MinReal = -OPM_MaxReal; OPM_MinLReal = -OPM_MaxLReal; OPM_FindInstallDir(); + OPM_hasComment = 0; + OPM_currentComment[0] = 0x00; __ENDMOD; } diff --git a/bootstrap/windows-48/OPM.h b/bootstrap/windows-48/OPM.h index 96318bea..64c15a28 100644 --- a/bootstrap/windows-48/OPM.h +++ b/bootstrap/windows-48/OPM.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPM__h #define OPM__h @@ -9,7 +9,7 @@ import CHAR OPM_Model[10]; import INT16 OPM_AddressSize, OPM_Alignment; import UINT32 OPM_GlobalOptions, OPM_Options; -import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; +import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize; import INT64 OPM_MaxIndex; import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; import BOOLEAN OPM_noerr; @@ -30,6 +30,7 @@ import void OPM_FPrintLReal (INT32 *fp, LONGREAL val); import void OPM_FPrintReal (INT32 *fp, REAL val); import void OPM_FPrintSet (INT32 *fp, UINT64 val); import void OPM_Get (CHAR *ch); +import void OPM_GetComment (CHAR *text, ADDRESS text__len); import void OPM_Init (BOOLEAN *done); import void OPM_InitOptions (void); import INT16 OPM_Integer (INT64 n); @@ -48,6 +49,7 @@ import BOOLEAN OPM_OpenPar (void); import void OPM_RegisterNewSym (void); import INT64 OPM_SignedMaximum (INT32 bytecount); import INT64 OPM_SignedMinimum (INT32 bytecount); +import void OPM_StoreComment (CHAR *text, ADDRESS text__len); import void OPM_SymRCh (CHAR *ch); import INT32 OPM_SymRInt (void); import INT64 OPM_SymRInt64 (void); diff --git a/bootstrap/windows-48/OPP.c b/bootstrap/windows-48/OPP.c index ec4ad2be..ad4a370a 100644 --- a/bootstrap/windows-48/OPP.c +++ b/bootstrap/windows-48/OPP.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -634,7 +634,7 @@ static void OPP_StandProcCall (OPT_Node *x) OPT_Node y = NIL; INT8 m; INT16 n; - m = (INT8)((INT16)(*x)->obj->adr); + m = __SHORT(__SHORT((*x)->obj->adr, 32768), 128); n = 0; if (OPP_sym == 30) { OPS_Get(&OPP_sym); @@ -943,7 +943,7 @@ static void GetCode__19 (void) (*ext)[__X(n + 1, 256)] = OPS_str[__X(n, 256)]; n += 1; } - (*ext)[0] = (CHAR)n; + (*ext)[0] = __CHR(n); OPS_Get(&OPP_sym); } else { for (;;) { @@ -956,14 +956,14 @@ static void GetCode__19 (void) n = 1; } OPS_Get(&OPP_sym); - (*ext)[__X(n, 256)] = (CHAR)c; + (*ext)[__X(n, 256)] = __CHR(c); } if (OPP_sym == 19) { OPS_Get(&OPP_sym); } else if (OPP_sym == 35) { OPP_err(19); } else { - (*ext)[0] = (CHAR)n; + (*ext)[0] = __CHR(n); break; } } diff --git a/bootstrap/windows-48/OPP.h b/bootstrap/windows-48/OPP.h index aa076aaa..3d8cefe8 100644 --- a/bootstrap/windows-48/OPP.h +++ b/bootstrap/windows-48/OPP.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPP__h #define OPP__h diff --git a/bootstrap/windows-48/OPS.c b/bootstrap/windows-48/OPS.c index bf9f1af5..a25a2c12 100644 --- a/bootstrap/windows-48/OPS.c +++ b/bootstrap/windows-48/OPS.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -56,11 +56,11 @@ static void OPS_Str (INT8 *sym) OPS_err(241); break; } - OPS_str[i] = OPS_ch; + OPS_str[__X(i, 256)] = OPS_ch; i += 1; } OPM_Get(&OPS_ch); - OPS_str[i] = 0x00; + OPS_str[__X(i, 256)] = 0x00; OPS_intval = i + 1; if (OPS_intval == 2) { *sym = 35; @@ -76,7 +76,7 @@ static void OPS_Identifier (INT8 *sym) INT16 i; i = 0; do { - OPS_name[i] = OPS_ch; + OPS_name[__X(i, 256)] = 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)); @@ -84,7 +84,7 @@ static void OPS_Identifier (INT8 *sym) OPS_err(240); i -= 1; } - OPS_name[i] = 0x00; + OPS_name[__X(i, 256)] = 0x00; *sym = 38; } @@ -143,7 +143,7 @@ static void OPS_Number (void) 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; + dig[__X(n, 24)] = OPS_ch; n += 1; } m += 1; @@ -173,7 +173,7 @@ static void OPS_Number (void) OPS_numtyp = 1; if (n <= 2) { while (i < n) { - OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1); + OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[__X(i, 24)], 1); i += 1; } } else { @@ -187,7 +187,7 @@ static void OPS_Number (void) OPS_intval = -1; } while (i < n) { - OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1); + OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[__X(i, 24)], 1); i += 1; } } else { @@ -196,7 +196,7 @@ static void OPS_Number (void) } else { OPS_numtyp = 2; while (i < n) { - d = Ord__7(dig[i], 0); + d = Ord__7(dig[__X(i, 24)], 0); i += 1; if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) { OPS_intval = OPS_intval * 10 + (INT64)d; @@ -214,7 +214,7 @@ static void OPS_Number (void) expCh = 'E'; while (n > 0) { n -= 1; - f = (Ord__7(dig[n], 0) + f) / (LONGREAL)(LONGREAL)10; + f = (Ord__7(dig[__X(n, 24)], 0) + f) / (LONGREAL)(LONGREAL)10; } if (OPS_ch == 'E' || OPS_ch == 'D') { expCh = OPS_ch; @@ -279,32 +279,74 @@ static void Comment__2 (void); static void Comment__2 (void) { + BOOLEAN isExported; + CHAR commentText[256]; + INT16 i, nestLevel; + CHAR prevCh, nextCh; + i = 0; + while (i <= 255) { + commentText[__X(i, 256)] = 0x00; + i += 1; + } + isExported = 0; + i = 0; + nestLevel = 1; + prevCh = 0x00; OPM_Get(&OPS_ch); - for (;;) { - for (;;) { - while (OPS_ch == '(') { + if (OPS_ch == '*') { + isExported = 1; + OPM_Get(&OPS_ch); + if (OPS_ch == ')') { + commentText[0] = 0x00; + OPM_StoreComment(commentText, 256); + OPM_Get(&OPS_ch); + return; + } + } + while ((nestLevel > 0 && OPS_ch != 0x00)) { + if ((prevCh == '(' && OPS_ch == '*')) { + nestLevel += 1; + prevCh = 0x00; + } else if ((prevCh == '*' && OPS_ch == ')')) { + nestLevel -= 1; + if (nestLevel == 0) { OPM_Get(&OPS_ch); - if (OPS_ch == '*') { - Comment__2(); + } else { + prevCh = 0x00; + } + } else { + if ((((isExported && nestLevel == 1)) && prevCh != 0x00)) { + if (i < 255) { + commentText[__X(i, 256)] = prevCh; + i += 1; } } - if (OPS_ch == '*') { - OPM_Get(&OPS_ch); - break; - } - if (OPS_ch == 0x00) { - break; - } + prevCh = OPS_ch; + } + if (nestLevel > 0) { OPM_Get(&OPS_ch); } - if (OPS_ch == ')') { - OPM_Get(&OPS_ch); - break; + } + if (OPS_ch == 0x00) { + OPS_err(5); + } + if ((((((isExported && nestLevel == 0)) && prevCh != 0x00)) && prevCh != '*')) { + if (i < 255) { + commentText[__X(i, 256)] = prevCh; + i += 1; + } else { + OPM_LogWStr((CHAR*)"Truncating final comment character", 35); + OPM_LogWLn(); } - if (OPS_ch == 0x00) { - OPS_err(5); - break; + } + if (isExported) { + if (i >= 256) { + OPM_LogWStr((CHAR*)"Warning: commentText overflow", 30); + OPM_LogWLn(); + i = 255; } + commentText[__X(i, 256)] = 0x00; + OPM_StoreComment(commentText, 256); } } diff --git a/bootstrap/windows-48/OPS.h b/bootstrap/windows-48/OPS.h index 09a33705..19e222ac 100644 --- a/bootstrap/windows-48/OPS.h +++ b/bootstrap/windows-48/OPS.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPS__h #define OPS__h diff --git a/bootstrap/windows-48/OPT.c b/bootstrap/windows-48/OPT.c index 0002aa51..ebb47dd8 100644 --- a/bootstrap/windows-48/OPT.c +++ b/bootstrap/windows-48/OPT.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -83,6 +83,7 @@ typedef OPT_Const conval; INT32 adr, linkadr; INT16 x; + OPT_ConstExt comment; } OPT_ObjDesc; typedef @@ -173,6 +174,7 @@ 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_OutTruncatedName (CHAR *text, ADDRESS text__len); export OPT_Struct OPT_SetType (INT32 size); export OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir); export INT32 OPT_SizeAlignment (INT32 size); @@ -352,7 +354,7 @@ void OPT_TypSize (OPT_Struct typ) } typ->size = offset; typ->align = base; - typ->sysflag = __MASK(typ->sysflag, -256) + (INT16)__ASHL(offset - off0, 8); + typ->sysflag = __MASK(typ->sysflag, -256) + __SHORT(__ASHL(offset - off0, 8), 32768); } else if (c == 2) { OPT_TypSize(typ->BaseTyp); typ->size = typ->n * typ->BaseTyp->size; @@ -388,6 +390,10 @@ OPT_Object OPT_NewObj (void) { OPT_Object obj = NIL; __NEW(obj, OPT_ObjDesc); + obj->typ = NIL; + obj->conval = NIL; + obj->comment = NIL; + obj->name[0] = 0x00; return obj; } @@ -554,6 +560,8 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj) OPT_Object ob0 = NIL, ob1 = NIL; BOOLEAN left; INT8 mnolev; + CHAR commentText[256]; + INT16 j; ob0 = OPT_topScope; ob1 = ob0->right; left = 0; @@ -585,6 +593,16 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj) __COPY(name, ob1->name, 256); mnolev = OPT_topScope->mnolev; ob1->mnolev = mnolev; + OPM_GetComment((void*)commentText, 256); + if (commentText[0] != 0x00) { + ob1->comment = __NEWARR(NIL, 1, 1, 1, 0, 256); + j = 0; + while ((j < 255 && commentText[__X(j, 256)] != 0x00)) { + (*ob1->comment)[__X(j, 256)] = commentText[__X(j, 256)]; + j += 1; + } + (*ob1->comment)[__X(j, 256)] = 0x00; + } break; } } @@ -1103,6 +1121,13 @@ static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par) tag = OPM_SymRInt(); last = NIL; while (tag != 18) { + if (tag < 0 || tag > 100) { + OPM_LogWStr((CHAR*)"ERROR: Invalid tag value in InSign: ", 37); + OPM_LogWNum(tag, 0); + OPM_LogWLn(); + OPM_err(155); + return; + } new = OPT_NewObj(); new->mnolev = -mno; if (last == NIL) { @@ -1251,7 +1276,7 @@ static void OPT_InStruct (OPT_Struct *typ) obj->vis = 0; tag = OPM_SymRInt(); if (tag == 35) { - (*typ)->sysflag = (INT16)OPM_SymRInt(); + (*typ)->sysflag = __SHORTF(OPM_SymRInt(), 32768); tag = OPM_SymRInt(); } switch (tag) { @@ -1381,7 +1406,37 @@ static OPT_Object OPT_InObj (INT8 mno) OPT_Struct typ = NIL; INT32 tag; OPT_ConstExt ext = NIL; + OPS_Name commentText; + BOOLEAN hasComment; + INT16 j; + INT32 len; tag = OPT_impCtxt.nextTag; + hasComment = 0; + while (tag == 41) { + len = OPM_SymRInt(); + if (len < 0) { + len = 0; + } + if (len > 255) { + len = 255; + } + i = 0; + while (i < len) { + OPM_SymRCh(&commentText[__X(i, 256)]); + i += 1; + } + commentText[__X(i, 256)] = 0x00; + hasComment = 1; + tag = OPM_SymRInt(); + } + OPT_impCtxt.nextTag = tag; + if (tag < 0 || tag > 50) { + OPM_LogWStr((CHAR*)"ERROR: Invalid tag in InObj: ", 30); + OPM_LogWNum(tag, 0); + OPM_LogWLn(); + OPM_err(155); + return NIL; + } if (tag == 19) { OPT_InStruct(&typ); obj = typ->strobj; @@ -1397,7 +1452,7 @@ static OPT_Object OPT_InObj (INT8 mno) obj->conval = OPT_NewConst(); OPT_InConstant(tag, obj->conval); obj->typ = OPT_InTyp(tag); - } else if (tag >= 31) { + } else if ((tag >= 31 && tag <= 33)) { obj->conval = OPT_NewConst(); obj->conval->intval = -1; OPT_InSign(mno, &obj->typ, &obj->link); @@ -1412,8 +1467,8 @@ static OPT_Object OPT_InObj (INT8 mno) obj->mode = 9; ext = OPT_NewExt(); obj->conval->ext = ext; - s = (INT16)OPM_SymRInt(); - (*ext)[0] = (CHAR)s; + s = __SHORTF(OPM_SymRInt(), 32768); + (*ext)[0] = __CHR(s); i = 1; while (i <= s) { OPM_SymRCh(&(*ext)[__X(i, 256)]); @@ -1424,20 +1479,37 @@ static OPT_Object OPT_InObj (INT8 mno) OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", 32); OPM_LogWNum(tag, 0); OPM_LogWLn(); + OPM_err(155); + return NIL; break; } } else if (tag == 20) { obj->mode = 5; OPT_InStruct(&obj->typ); - } else { + } else if (tag == 21 || tag == 22) { obj->mode = 1; if (tag == 22) { obj->vis = 2; } OPT_InStruct(&obj->typ); + } else { + OPM_LogWStr((CHAR*)"ERROR: Unexpected tag in InObj: ", 33); + OPM_LogWNum(tag, 0); + OPM_LogWLn(); + OPM_err(155); + return NIL; } OPT_InName((void*)obj->name, 256); } + if ((hasComment && obj != NIL)) { + obj->comment = __NEWARR(NIL, 1, 1, 1, 0, 256); + j = 0; + while ((((j < 255 && j < len)) && commentText[__X(j, 256)] != 0x00)) { + (*obj->comment)[__X(j, 256)] = commentText[__X(j, 256)]; + j += 1; + } + (*obj->comment)[__X(j, 256)] = 0x00; + } 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); @@ -1752,7 +1824,7 @@ static void OPT_OutConstant (OPT_Object obj) OPM_SymWInt(f); switch (f) { case 2: case 3: - OPM_SymWCh((CHAR)obj->conval->intval); + OPM_SymWCh(__CHR(obj->conval->intval)); break; case 4: OPM_SymWInt(obj->conval->intval); @@ -1780,13 +1852,40 @@ static void OPT_OutConstant (OPT_Object obj) } } +static void OPT_OutTruncatedName (CHAR *text, ADDRESS text__len) +{ + INT16 i; + __DUP(text, text__len, CHAR); + i = 0; + while ((i < 255 && text[__X(i, text__len)] != 0x00)) { + OPM_SymWCh(text[__X(i, text__len)]); + i += 1; + } + OPM_SymWCh(0x00); + __DEL(text); +} + static void OPT_OutObj (OPT_Object obj) { INT16 i, j; OPT_ConstExt ext = NIL; + INT16 k, l; if (obj != NIL) { OPT_OutObj(obj->left); if (__IN(obj->mode, 0x06ea, 32)) { + if (obj->comment != NIL) { + OPM_SymWInt(41); + k = 0; + while ((k < 255 && (*obj->comment)[__X(k, 256)] != 0x00)) { + k += 1; + } + OPM_SymWInt(k); + l = 0; + while (l < k) { + OPM_SymWCh((*obj->comment)[__X(l, 256)]); + l += 1; + } + } if (obj->history == 4) { OPT_FPrintErr(obj, 250); } else if (obj->vis != 0) { @@ -2026,7 +2125,7 @@ static void EnumPtrs(void (*P)(void*)) } __TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 40), {0, -8}}; -__TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 304), {0, 4, 8, 12, 284, 288, -28}}; +__TDESC(OPT_ObjDesc, 1, 7) = {__TDFLDS("ObjDesc", 308), {0, 4, 8, 12, 284, 288, 304, -32}}; __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, diff --git a/bootstrap/windows-48/OPT.h b/bootstrap/windows-48/OPT.h index 63bf2070..cf456af5 100644 --- a/bootstrap/windows-48/OPT.h +++ b/bootstrap/windows-48/OPT.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPT__h #define OPT__h @@ -61,6 +61,7 @@ typedef OPT_Const conval; INT32 adr, linkadr; INT16 x; + OPT_ConstExt comment; } OPT_ObjDesc; typedef diff --git a/bootstrap/windows-48/OPV.c b/bootstrap/windows-48/OPV.c index 8b095ff5..0425b2e0 100644 --- a/bootstrap/windows-48/OPV.c +++ b/bootstrap/windows-48/OPV.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -112,7 +112,7 @@ static void OPV_Stamp (OPS_Name s) i += 2; k = 0; do { - n[__X(k, 10)] = (CHAR)((int)__MOD(j, 10) + 48); + n[__X(k, 10)] = __CHR((int)__MOD(j, 10) + 48); j = __DIV(j, 10); k += 1; } while (!(j == 0)); @@ -317,15 +317,27 @@ static INT16 OPV_Precedence (INT16 class, INT16 subclass, INT16 form, INT16 comp static void OPV_Len (OPT_Node n, INT64 dim) { + INT64 d; + OPT_Struct array = NIL; 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[", 7); - OPM_WriteInt(dim); - OPM_Write(']'); + d = dim; + array = n->typ; + while (d > 0) { + array = array->BaseTyp; + d -= 1; + } + if (array->comp == 3) { + OPV_design(n->left, 10); + OPM_WriteString((CHAR*)"->len[", 7); + OPM_WriteInt(dim); + OPM_Write(']'); + } else { + OPM_WriteInt(array->n); + } } else { OPC_Len(n->obj, n->typ, dim); } @@ -370,6 +382,7 @@ static void OPV_SizeCast (OPT_Node n, INT32 to) OPM_WriteInt(__ASHL(to, 3)); OPM_WriteString((CHAR*)")", 2); } + OPV_Entier(n, 9); } } @@ -381,7 +394,6 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec) if (to == 7) { if (from == 7) { OPV_SizeCast(n, newtype->size); - OPV_Entier(n, 9); } else { OPM_WriteString((CHAR*)"__SETOF(", 9); OPV_Entier(n, -1); @@ -391,7 +403,6 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec) } } else if (to == 4) { OPV_SizeCast(n, newtype->size); - OPV_Entier(n, 9); } else if (to == 3) { if (__IN(2, OPM_Options, 32)) { OPM_WriteString((CHAR*)"__CHR", 6); @@ -1183,7 +1194,7 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x) base = base->BaseTyp; } if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) { - OPC_Ident(base->strobj); + OPC_Andent(base); OPM_WriteString((CHAR*)"__typ", 6); } else if (base->form == 11) { OPM_WriteString((CHAR*)"POINTER__typ", 13); diff --git a/bootstrap/windows-48/OPV.h b/bootstrap/windows-48/OPV.h index c6a107b6..fbabd8f4 100644 --- a/bootstrap/windows-48/OPV.h +++ b/bootstrap/windows-48/OPV.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPV__h #define OPV__h diff --git a/bootstrap/windows-48/Out.c b/bootstrap/windows-48/Out.c index 01e91698..b43e55f1 100644 --- a/bootstrap/windows-48/Out.c +++ b/bootstrap/windows-48/Out.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -80,7 +80,7 @@ void Out_String (CHAR *str, ADDRESS str__len) error = Platform_Write(Platform_StdOut, (ADDRESS)str, l); } else { __MOVE((ADDRESS)str, (ADDRESS)&Out_buf[__X(Out_in, 128)], l); - Out_in += (INT16)l; + Out_in += __SHORT(l, 32768); } __DEL(str); } @@ -98,11 +98,11 @@ void Out_Int (INT64 x, INT64 n) if (x < 0) { x = -x; } - s[0] = (CHAR)(48 + __MOD(x, 10)); + s[0] = __CHR(48 + __MOD(x, 10)); x = __DIV(x, 10); i = 1; while (x != 0) { - s[__X(i, 22)] = (CHAR)(48 + __MOD(x, 10)); + s[__X(i, 22)] = __CHR(48 + __MOD(x, 10)); x = __DIV(x, 10); i += 1; } @@ -138,9 +138,9 @@ void Out_Hex (INT64 x, INT64 n) x = __ROTL(x, 4, 64); n -= 1; if (__MASK(x, -16) < 10) { - Out_Char((CHAR)(__MASK(x, -16) + 48)); + Out_Char(__CHR(__MASK(x, -16) + 48)); } else { - Out_Char((CHAR)((__MASK(x, -16) - 10) + 65)); + Out_Char(__CHR((__MASK(x, -16) - 10) + 65)); } } } @@ -154,7 +154,7 @@ void Out_Ln (void) static void Out_digit (INT64 n, CHAR *s, ADDRESS s__len, INT16 *i) { *i -= 1; - s[__X(*i, s__len)] = (CHAR)(__MOD(n, 10) + 48); + s[__X(*i, s__len)] = __CHR(__MOD(n, 10) + 48); } static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i) @@ -166,7 +166,7 @@ static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 if (l > *i) { l = *i; } - *i -= (INT16)l; + *i -= __SHORT(l, 32768); j = 0; while (j < l) { s[__X(*i + j, s__len)] = t[__X(j, t__len)]; @@ -248,7 +248,7 @@ static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_) if (nn) { x = -x; } - e = (INT16)__ASHR((e - 1023) * 77, 8); + e = __SHORT(__ASHR((e - 1023) * 77, 8), 32768); if (e >= 0) { x = x / (LONGREAL)Out_Ten(e); } else { diff --git a/bootstrap/windows-48/Out.h b/bootstrap/windows-48/Out.h index e1285046..a72547f4 100644 --- a/bootstrap/windows-48/Out.h +++ b/bootstrap/windows-48/Out.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Out__h #define Out__h diff --git a/bootstrap/windows-48/Platform.c b/bootstrap/windows-48/Platform.c index 9d308e71..9b1f0e4f 100644 --- a/bootstrap/windows-48/Platform.c +++ b/bootstrap/windows-48/Platform.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -44,6 +44,8 @@ export BOOLEAN Platform_Inaccessible (INT16 e); export BOOLEAN Platform_Interrupted (INT16 e); export BOOLEAN Platform_IsConsole (INT32 h); export void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d); +export INT16 Platform_MaxNameLength (void); +export INT16 Platform_MaxPathLength (void); export INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h); export BOOLEAN Platform_NoSuchDirectory (INT16 e); export INT32 Platform_OSAllocate (INT32 size); @@ -88,6 +90,7 @@ export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS #define Platform_ETIMEDOUT() WSAETIMEDOUT #define Platform_GetConsoleMode(h, m) GetConsoleMode((HANDLE)h, (DWORD*)m) #define Platform_GetTickCount() (LONGINT)(UINT32)GetTickCount() +#define Platform_MAXPATH() MAX_PATH #define Platform_SetConsoleMode(h, m) SetConsoleMode((HANDLE)h, (DWORD)m) #define Platform_SetInterruptHandler(h) SystemSetInterruptHandler((ADDRESS)h) #define Platform_SetQuitHandler(h) SystemSetQuitHandler((ADDRESS)h) @@ -191,6 +194,16 @@ BOOLEAN Platform_Interrupted (INT16 e) return e == Platform_EINTR(); } +INT16 Platform_MaxNameLength (void) +{ + return Platform_MAXPATH(); +} + +INT16 Platform_MaxPathLength (void) +{ + return Platform_MAXPATH(); +} + INT32 Platform_OSAllocate (INT32 size) { return Platform_allocate(size); diff --git a/bootstrap/windows-48/Platform.h b/bootstrap/windows-48/Platform.h index bd2a519b..b1ed4c6f 100644 --- a/bootstrap/windows-48/Platform.h +++ b/bootstrap/windows-48/Platform.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Platform__h #define Platform__h @@ -41,6 +41,8 @@ import BOOLEAN Platform_Inaccessible (INT16 e); import BOOLEAN Platform_Interrupted (INT16 e); import BOOLEAN Platform_IsConsole (INT32 h); import void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d); +import INT16 Platform_MaxNameLength (void); +import INT16 Platform_MaxPathLength (void); import INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h); import BOOLEAN Platform_NoSuchDirectory (INT16 e); import INT32 Platform_OSAllocate (INT32 size); diff --git a/bootstrap/windows-48/Reals.c b/bootstrap/windows-48/Reals.c index d1eb72f6..512ec2c4 100644 --- a/bootstrap/windows-48/Reals.c +++ b/bootstrap/windows-48/Reals.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -67,9 +67,9 @@ void Reals_SetExpo (REAL *x, INT16 ex) { CHAR c; __GET((ADDRESS)x + 3, c, CHAR); - __PUT((ADDRESS)x + 3, (CHAR)(__ASHL(__ASHR((INT16)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR); + __PUT((ADDRESS)x + 3, __CHR(__ASHL(__ASHR((INT16)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR); __GET((ADDRESS)x + 2, c, CHAR); - __PUT((ADDRESS)x + 2, (CHAR)(__MASK((INT16)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR); + __PUT((ADDRESS)x + 2, __CHR(__MASK((INT16)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR); } INT16 Reals_ExpoL (LONGREAL x) @@ -87,21 +87,21 @@ void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len) } k = 0; if (n > 9) { - i = (INT32)__ENTIER(x / (LONGREAL)(LONGREAL)1000000000); - j = (INT32)__ENTIER(x - i * (LONGREAL)1000000000); + i = __SHORT(__ENTIER(x / (LONGREAL)(LONGREAL)1000000000), 2147483648LL); + j = __SHORT(__ENTIER(x - i * (LONGREAL)1000000000), 2147483648LL); if (j < 0) { j = 0; } while (k < 9) { - d[__X(k, d__len)] = (CHAR)((int)__MOD(j, 10) + 48); + d[__X(k, d__len)] = __CHR((int)__MOD(j, 10) + 48); j = __DIV(j, 10); k += 1; } } else { - i = (INT32)__ENTIER(x); + i = __SHORT(__ENTIER(x), 2147483648LL); } while (k < n) { - d[__X(k, d__len)] = (CHAR)((int)__MOD(i, 10) + 48); + d[__X(k, d__len)] = __CHR((int)__MOD(i, 10) + 48); i = __DIV(i, 10); k += 1; } @@ -115,9 +115,9 @@ void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len) static CHAR Reals_ToHex (INT16 i) { if (i < 10) { - return (CHAR)(i + 48); + return __CHR(i + 48); } else { - return (CHAR)(i + 55); + return __CHR(i + 55); } __RETCHK; } diff --git a/bootstrap/windows-48/Reals.h b/bootstrap/windows-48/Reals.h index 170d1785..93e7fa75 100644 --- a/bootstrap/windows-48/Reals.h +++ b/bootstrap/windows-48/Reals.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Reals__h #define Reals__h diff --git a/bootstrap/windows-48/Strings.c b/bootstrap/windows-48/Strings.c index 225bd40a..4b18812f 100644 --- a/bootstrap/windows-48/Strings.c +++ b/bootstrap/windows-48/Strings.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -6,6 +6,7 @@ #define SET UINT32 #include "SYSTEM.h" +#include "Reals.h" @@ -19,6 +20,8 @@ export INT16 Strings_Length (CHAR *s, ADDRESS s__len); export BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len); export INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos); export void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len); +export void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r); +export void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r); INT16 Strings_Length (CHAR *s, ADDRESS s__len) @@ -31,7 +34,7 @@ INT16 Strings_Length (CHAR *s, ADDRESS s__len) } if (i <= 32767) { __DEL(s); - return (INT16)i; + return __SHORT(i, 32768); } else { __DEL(s); return 32767; @@ -123,7 +126,7 @@ void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHA INT16 len, destLen, i; __DUP(source, source__len, CHAR); len = Strings_Length(source, source__len); - destLen = (INT16)dest__len - 1; + destLen = __SHORT(dest__len, 32768) - 1; if (pos < 0) { pos = 0; } @@ -236,10 +239,135 @@ BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS return __retval; } +void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r) +{ + INT16 p, e; + REAL y, g; + BOOLEAN neg, negE; + __DUP(s, s__len, CHAR); + p = 0; + while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { + p += 1; + } + if (s[__X(p, s__len)] == '-') { + neg = 1; + p += 1; + } else { + neg = 0; + } + while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { + p += 1; + } + y = (REAL)0; + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + y = y * (REAL)10 + ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + if (s[__X(p, s__len)] == '.') { + p += 1; + g = (REAL)1; + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + g = g / (REAL)(REAL)10; + y = y + g * ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + } + if (s[__X(p, s__len)] == 'D' || s[__X(p, s__len)] == 'E') { + p += 1; + e = 0; + if (s[__X(p, s__len)] == '-') { + negE = 1; + p += 1; + } else { + negE = 0; + } + while (s[__X(p, s__len)] == '0') { + p += 1; + } + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + e = e * 10 + ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + if (negE) { + y = y / (REAL)Reals_Ten(e); + } else { + y = y * Reals_Ten(e); + } + } + if (neg) { + y = -y; + } + *r = y; + __DEL(s); +} + +void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r) +{ + INT16 p, e; + LONGREAL y, g; + BOOLEAN neg, negE; + __DUP(s, s__len, CHAR); + p = 0; + while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { + p += 1; + } + if (s[__X(p, s__len)] == '-') { + neg = 1; + p += 1; + } else { + neg = 0; + } + while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { + p += 1; + } + y = (LONGREAL)0; + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + y = y * (LONGREAL)10 + ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + if (s[__X(p, s__len)] == '.') { + p += 1; + g = (LONGREAL)1; + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + g = g / (LONGREAL)(LONGREAL)10; + y = y + g * ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + } + if (s[__X(p, s__len)] == 'D' || s[__X(p, s__len)] == 'E') { + p += 1; + e = 0; + if (s[__X(p, s__len)] == '-') { + negE = 1; + p += 1; + } else { + negE = 0; + } + while (s[__X(p, s__len)] == '0') { + p += 1; + } + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + e = e * 10 + ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + if (negE) { + y = y / (LONGREAL)Reals_Ten(e); + } else { + y = y * Reals_Ten(e); + } + } + if (neg) { + y = -y; + } + *r = y; + __DEL(s); +} + export void *Strings__init(void) { __DEFMOD; + __MODULE_IMPORT(Reals); __REGMOD("Strings", 0); /* BEGIN */ __ENDMOD; diff --git a/bootstrap/windows-48/Strings.h b/bootstrap/windows-48/Strings.h index 4d98f1a3..f0e3ae34 100644 --- a/bootstrap/windows-48/Strings.h +++ b/bootstrap/windows-48/Strings.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Strings__h #define Strings__h @@ -17,6 +17,8 @@ import INT16 Strings_Length (CHAR *s, ADDRESS s__len); import BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len); import INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos); import void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len); +import void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r); +import void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r); import void *Strings__init(void); diff --git a/bootstrap/windows-48/Texts.c b/bootstrap/windows-48/Texts.c index 08ee5129..43c3858f 100644 --- a/bootstrap/windows-48/Texts.c +++ b/bootstrap/windows-48/Texts.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -8,7 +8,6 @@ #include "SYSTEM.h" #include "Files.h" #include "Modules.h" -#include "Out.h" #include "Reals.h" typedef @@ -813,10 +812,10 @@ void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ) if ('9' < ch) { if (('A' <= ch && ch <= 'F')) { hex = 1; - ch = (CHAR)((INT16)ch - 7); + ch = __CHR((INT16)ch - 7); } else if (('a' <= ch && ch <= 'f')) { hex = 1; - ch = (CHAR)((INT16)ch - 39); + ch = __CHR((INT16)ch - 39); } else { break; } @@ -1058,7 +1057,7 @@ void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n) x0 = x; } do { - a[__X(i, 24)] = (CHAR)(__MOD(x0, 10) + 48); + a[__X(i, 24)] = __CHR(__MOD(x0, 10) + 48); x0 = __DIV(x0, 10); i += 1; } while (!(x0 == 0)); @@ -1085,9 +1084,9 @@ void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x) do { y = __MASK(x, -16); if (y < 10) { - a[__X(i, 20)] = (CHAR)(y + 48); + a[__X(i, 20)] = __CHR(y + 48); } else { - a[__X(i, 20)] = (CHAR)(y + 55); + a[__X(i, 20)] = __CHR(y + 55); } x = __ASHR(x, 4); i += 1; @@ -1163,8 +1162,8 @@ void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n) } 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)); + Texts_Write(&*W, W__typ, __CHR(__DIV(e, 10) + 48)); + Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48)); } } @@ -1314,7 +1313,7 @@ void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n) } else { Texts_Write(&*W, W__typ, ' '); } - e = (INT16)__ASHR((e - 1023) * 77, 8); + e = __SHORT(__ASHR((e - 1023) * 77, 8), 32768); if (e >= 0) { x = x / (LONGREAL)Reals_TenL(e); } else { @@ -1345,10 +1344,10 @@ void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n) } else { Texts_Write(&*W, W__typ, '+'); } - Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 100) + 48)); + Texts_Write(&*W, W__typ, __CHR(__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)); + Texts_Write(&*W, W__typ, __CHR(__DIV(e, 10) + 48)); + Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48)); } } @@ -1375,8 +1374,8 @@ static void WritePair__44 (CHAR ch, INT32 x); static void WritePair__44 (CHAR ch, INT32 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)((int)__MOD(x, 10) + 48)); + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, __CHR(__DIV(x, 10) + 48)); + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, __CHR((int)__MOD(x, 10) + 48)); } void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d) @@ -1810,7 +1809,6 @@ export void *Texts__init(void) __DEFMOD; __MODULE_IMPORT(Files); __MODULE_IMPORT(Modules); - __MODULE_IMPORT(Out); __MODULE_IMPORT(Reals); __REGMOD("Texts", EnumPtrs); __INITYP(Texts_FontDesc, Texts_FontDesc, 0); diff --git a/bootstrap/windows-48/Texts.h b/bootstrap/windows-48/Texts.h index 5d3316e2..fd0c0fa5 100644 --- a/bootstrap/windows-48/Texts.h +++ b/bootstrap/windows-48/Texts.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Texts__h #define Texts__h diff --git a/bootstrap/windows-48/VT100.c b/bootstrap/windows-48/VT100.c index 9cd5cf4d..346fb37b 100644 --- a/bootstrap/windows-48/VT100.c +++ b/bootstrap/windows-48/VT100.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -34,6 +34,7 @@ static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len); export void VT100_HVP (INT16 n, INT16 m); export void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len); export void VT100_RCP (void); +export void VT100_Reset (void); static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end); export void VT100_SCP (void); export void VT100_SD (INT16 n); @@ -74,7 +75,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len) } e = s; do { - b[__X(e, 21)] = (CHAR)((int)__MOD(int_, 10) + 48); + b[__X(e, 21)] = __CHR((int)__MOD(int_, 10) + 48); int_ = __DIV(int_, 10); e += 1; } while (!(int_ == 0)); @@ -136,6 +137,15 @@ static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len) __DEL(letter); } +void VT100_Reset (void) +{ + CHAR cmd[6]; + __COPY("\033", cmd, 6); + Strings_Append((CHAR*)"c", 2, (void*)cmd, 6); + Out_String(cmd, 6); + Out_Ln(); +} + void VT100_CUU (INT16 n) { VT100_EscSeq(n, (CHAR*)"A", 2); @@ -256,6 +266,7 @@ export void *VT100__init(void) __REGCMD("DECTCEMh", VT100_DECTCEMh); __REGCMD("DECTCEMl", VT100_DECTCEMl); __REGCMD("RCP", VT100_RCP); + __REGCMD("Reset", VT100_Reset); __REGCMD("SCP", VT100_SCP); /* BEGIN */ __COPY("\033", VT100_CSI, 5); diff --git a/bootstrap/windows-48/VT100.h b/bootstrap/windows-48/VT100.h index 8f60c652..4e708647 100644 --- a/bootstrap/windows-48/VT100.h +++ b/bootstrap/windows-48/VT100.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef VT100__h #define VT100__h @@ -25,6 +25,7 @@ import void VT100_EL (INT16 n); import void VT100_HVP (INT16 n, INT16 m); import void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len); import void VT100_RCP (void); +import void VT100_Reset (void); import void VT100_SCP (void); import void VT100_SD (INT16 n); import void VT100_SGR (INT16 n); diff --git a/bootstrap/windows-48/extTools.c b/bootstrap/windows-48/extTools.c index fa840303..ce2fc413 100644 --- a/bootstrap/windows-48/extTools.c +++ b/bootstrap/windows-48/extTools.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -7,18 +7,22 @@ #include "SYSTEM.h" #include "Configuration.h" +#include "Heap.h" #include "Modules.h" #include "OPM.h" #include "Out.h" #include "Platform.h" #include "Strings.h" +typedef + CHAR extTools_CommandString[4096]; -static CHAR extTools_CFLAGS[1023]; + +static extTools_CommandString extTools_CFLAGS; export void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len); -static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len); +static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len, CHAR *additionalopts, ADDRESS additionalopts__len); export void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len); static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRESS cmd__len); @@ -26,14 +30,17 @@ static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRES static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRESS cmd__len) { INT16 r, status, exitcode; + extTools_CommandString fullcmd; __DUP(title, title__len, CHAR); __DUP(cmd, cmd__len, CHAR); if (__IN(18, OPM_Options, 32)) { - Out_String(title, title__len); + Out_String((CHAR*)" ", 3); Out_String(cmd, cmd__len); Out_Ln(); } - r = Platform_System(cmd, cmd__len); + __COPY(cmd, fullcmd, 4096); + Heap_GC(0); + r = Platform_System(fullcmd, 4096); status = __MASK(r, -128); exitcode = __ASHR(r, 8); if (exitcode > 127) { @@ -63,50 +70,55 @@ static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRES __DEL(cmd); } -static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len) +static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len, CHAR *additionalopts, ADDRESS additionalopts__len) { - __COPY("gcc -g", s, s__len); + __DUP(additionalopts, additionalopts__len, CHAR); + __COPY("gcc -fPIC -g -Wno-stringop-overflow", s, s__len); Strings_Append((CHAR*)" -I \"", 6, (void*)s, s__len); Strings_Append(OPM_ResourceDir, 1024, (void*)s, s__len); Strings_Append((CHAR*)"/include\" ", 11, (void*)s, s__len); - Platform_GetEnv((CHAR*)"CFLAGS", 7, (void*)extTools_CFLAGS, 1023); - Strings_Append(extTools_CFLAGS, 1023, (void*)s, s__len); + Strings_Append(additionalopts, additionalopts__len, (void*)s, s__len); Strings_Append((CHAR*)" ", 2, (void*)s, s__len); + Platform_GetEnv((CHAR*)"CFLAGS", 7, (void*)extTools_CFLAGS, 4096); + Strings_Append(extTools_CFLAGS, 4096, (void*)s, s__len); + Strings_Append((CHAR*)" ", 2, (void*)s, s__len); + __DEL(additionalopts); } void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len) { - CHAR cmd[1023]; + extTools_CommandString cmd; __DUP(moduleName, moduleName__len, CHAR); - extTools_InitialiseCompilerCommand((void*)cmd, 1023); - Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 1023); - Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023); - Strings_Append((CHAR*)".c", 3, (void*)cmd, 1023); - extTools_execute((CHAR*)"C compile: ", 12, cmd, 1023); + extTools_InitialiseCompilerCommand((void*)cmd, 4096, (CHAR*)"", 1); + Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 4096); + Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096); + Strings_Append((CHAR*)".c", 3, (void*)cmd, 4096); + extTools_execute((CHAR*)"C compile: ", 12, cmd, 4096); __DEL(moduleName); } void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len) { - CHAR cmd[1023]; + extTools_CommandString cmd; __DUP(additionalopts, additionalopts__len, CHAR); - extTools_InitialiseCompilerCommand((void*)cmd, 1023); - Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023); - Strings_Append((CHAR*)".c ", 4, (void*)cmd, 1023); - Strings_Append(additionalopts, additionalopts__len, (void*)cmd, 1023); + extTools_InitialiseCompilerCommand((void*)cmd, 4096, additionalopts, additionalopts__len); + Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096); + Strings_Append((CHAR*)".c ", 4, (void*)cmd, 4096); if (statically) { - Strings_Append((CHAR*)" -static", 9, (void*)cmd, 1023); + Strings_Append((CHAR*)" -static", 9, (void*)cmd, 4096); } - Strings_Append((CHAR*)" -o ", 5, (void*)cmd, 1023); - Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023); - Strings_Append((CHAR*)" -L\"", 5, (void*)cmd, 1023); - Strings_Append(OPM_InstallDir, 1024, (void*)cmd, 1023); - Strings_Append((CHAR*)"/lib\"", 6, (void*)cmd, 1023); - Strings_Append((CHAR*)" -l voc", 8, (void*)cmd, 1023); - Strings_Append((CHAR*)"-O", 3, (void*)cmd, 1023); - Strings_Append(OPM_Model, 10, (void*)cmd, 1023); - Strings_Append((CHAR*)"", 1, (void*)cmd, 1023); - extTools_execute((CHAR*)"C compile and link: ", 21, cmd, 1023); + Strings_Append((CHAR*)" -o ", 5, (void*)cmd, 4096); + Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096); + if (!statically || 1) { + Strings_Append((CHAR*)" -L\"", 5, (void*)cmd, 4096); + Strings_Append(OPM_InstallDir, 1024, (void*)cmd, 4096); + Strings_Append((CHAR*)"/lib\"", 6, (void*)cmd, 4096); + Strings_Append((CHAR*)" -lvoc", 7, (void*)cmd, 4096); + Strings_Append((CHAR*)"-O", 3, (void*)cmd, 4096); + Strings_Append(OPM_Model, 10, (void*)cmd, 4096); + Strings_Append((CHAR*)"", 1, (void*)cmd, 4096); + } + extTools_execute((CHAR*)"C compile and link: ", 21, cmd, 4096); __DEL(additionalopts); } @@ -115,6 +127,7 @@ export void *extTools__init(void) { __DEFMOD; __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Heap); __MODULE_IMPORT(Modules); __MODULE_IMPORT(OPM); __MODULE_IMPORT(Out); diff --git a/bootstrap/windows-48/extTools.h b/bootstrap/windows-48/extTools.h index a93b6c85..686f0b4e 100644 --- a/bootstrap/windows-48/extTools.h +++ b/bootstrap/windows-48/extTools.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef extTools__h #define extTools__h diff --git a/bootstrap/windows-88/Compiler.c b/bootstrap/windows-88/Compiler.c index 993c2bac..4460479d 100644 --- a/bootstrap/windows-88/Compiler.c +++ b/bootstrap/windows-88/Compiler.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspamS */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspamS */ #define SHORTINT INT8 #define INTEGER INT16 @@ -89,7 +89,7 @@ static void Compiler_PropagateElementaryTypeSizes (void) OPT_sintobj->typ = OPT_sinttyp; OPT_intobj->typ = OPT_inttyp; OPT_lintobj->typ = OPT_linttyp; - switch (OPM_LongintSize) { + switch (OPM_SetSize) { case 4: OPT_settyp = OPT_set32typ; break; diff --git a/bootstrap/windows-88/Configuration.c b/bootstrap/windows-88/Configuration.c index 80b87b1d..fa87c9de 100644 --- a/bootstrap/windows-88/Configuration.c +++ b/bootstrap/windows-88/Configuration.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -8,7 +8,7 @@ #include "SYSTEM.h" -export CHAR Configuration_versionLong[75]; +export CHAR Configuration_versionLong[76]; @@ -19,6 +19,6 @@ export void *Configuration__init(void) __DEFMOD; __REGMOD("Configuration", 0); /* BEGIN */ - __MOVE("2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75); + __MOVE("2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 76); __ENDMOD; } diff --git a/bootstrap/windows-88/Configuration.h b/bootstrap/windows-88/Configuration.h index cdc285e5..c3c54eed 100644 --- a/bootstrap/windows-88/Configuration.h +++ b/bootstrap/windows-88/Configuration.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Configuration__h #define Configuration__h @@ -6,7 +6,7 @@ #include "SYSTEM.h" -import CHAR Configuration_versionLong[75]; +import CHAR Configuration_versionLong[76]; import void *Configuration__init(void); diff --git a/bootstrap/windows-88/Files.c b/bootstrap/windows-88/Files.c index 508dc245..07655515 100644 --- a/bootstrap/windows-88/Files.c +++ b/bootstrap/windows-88/Files.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -26,7 +26,7 @@ typedef Files_BufDesc *Files_Buffer; typedef - CHAR Files_FileName[101]; + CHAR Files_FileName[256]; typedef struct Files_FileDesc { @@ -49,6 +49,7 @@ typedef } Files_Rider; +export INT16 Files_MaxPathLength, Files_MaxNameLength; static Files_FileDesc *Files_files; static INT16 Files_tempno; static CHAR Files_HOME[1024]; @@ -86,6 +87,7 @@ export INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ); export void Files_Purge (Files_File f); export void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); export void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x); +export void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n); export void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x); export void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x); @@ -130,17 +132,17 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode) Out_String((CHAR*)": ", 3); if (f != NIL) { if (f->registerName[0] != 0x00) { - Out_String(f->registerName, 101); + Out_String(f->registerName, 256); } else { - Out_String(f->workName, 101); + Out_String(f->workName, 256); } if (f->fd != 0) { - Out_String((CHAR*)"f.fd = ", 8); + Out_String((CHAR*)", f.fd = ", 10); Out_Int(f->fd, 1); } } if (errcode != 0) { - Out_String((CHAR*)" errcode = ", 12); + Out_String((CHAR*)", errcode = ", 13); Out_Int(errcode, 1); } Out_Ln(); @@ -150,76 +152,75 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode) static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len) { - INT16 i, j; + INT16 i, j, ld, ln; __DUP(dir, dir__len, CHAR); __DUP(name, name__len, CHAR); + ld = Strings_Length(dir, dir__len); + ln = Strings_Length(name, name__len); + while ((ld > 0 && dir[__X(ld - 1, dir__len)] == '/')) { + ld -= 1; + } + if (((ld + ln) + 2) > dest__len) { + Files_Err((CHAR*)"File name too long", 19, NIL, 0); + } i = 0; + while (i < ld) { + dest[__X(i, dest__len)] = dir[__X(i, dir__len)]; + i += 1; + } + if (i > 0) { + dest[__X(i, dest__len)] = '/'; + i += 1; + } 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]; + while (j < ln) { + dest[__X(i, dest__len)] = name[__X(j, name__len)]; i += 1; j += 1; } - dest[i] = 0x00; + dest[__X(i, dest__len)] = 0x00; __DEL(dir); __DEL(name); } static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len) { - INT32 n, i, j; + INT16 i, n; __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; - } + if (finalName[0] == '/') { + __COPY(finalName, name, name__len); + } else { + Files_MakeFileName(Platform_CWD, 4096, finalName, finalName__len, (void*)name, name__len); } - j = 0; - while (finalName[j] != 0x00) { - name[i] = finalName[j]; - i += 1; - j += 1; - } - i -= 1; - while (name[i] != '/') { + i = Strings_Length(name, name__len) - 1; + while ((i > 0 && name[__X(i, name__len)] != '/')) { i -= 1; } - name[i + 1] = '.'; - name[i + 2] = 't'; - name[i + 3] = 'm'; - name[i + 4] = 'p'; - name[i + 5] = '.'; + if ((i + 16) >= name__len) { + Files_Err((CHAR*)"File name too long", 19, NIL, 0); + } + Files_tempno += 1; + n = Files_tempno; + name[__X(i + 1, name__len)] = '.'; + name[__X(i + 2, name__len)] = 't'; + name[__X(i + 3, name__len)] = 'm'; + name[__X(i + 4, name__len)] = 'p'; + name[__X(i + 5, name__len)] = '.'; i += 6; while (n > 0) { - name[i] = (CHAR)((int)__MOD(n, 10) + 48); + name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48); n = __DIV(n, 10); i += 1; } - name[i] = '.'; + name[__X(i, name__len)] = '.'; i += 1; n = Platform_PID; while (n > 0) { - name[i] = (CHAR)((int)__MOD(n, 10) + 48); + name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48); n = __DIV(n, 10); i += 1; } - name[i] = 0x00; + name[__X(i, name__len)] = 0x00; __DEL(finalName); } @@ -237,11 +238,11 @@ static void Files_Deregister (CHAR *name, ADDRESS name__len) if (osfile != NIL) { __ASSERT(!osfile->tempFile, 0); __ASSERT(osfile->fd >= 0, 0); - __MOVE(osfile->workName, osfile->registerName, 101); - Files_GetTempName(osfile->registerName, 101, (void*)osfile->workName, 101); + __MOVE(osfile->workName, osfile->registerName, 256); + Files_GetTempName(osfile->registerName, 256, (void*)osfile->workName, 256); osfile->tempFile = 1; osfile->state = 0; - error = Platform_Rename((void*)osfile->registerName, 101, (void*)osfile->workName, 101); + error = Platform_Rename((void*)osfile->registerName, 256, (void*)osfile->workName, 256); if (error != 0) { Files_Err((CHAR*)"Couldn't rename previous version of file being registered", 58, osfile, error); } @@ -257,17 +258,17 @@ static void Files_Create (Files_File f) CHAR err[32]; if (f->fd == -1) { if (f->state == 1) { - Files_GetTempName(f->registerName, 101, (void*)f->workName, 101); + Files_GetTempName(f->registerName, 256, (void*)f->workName, 256); f->tempFile = 1; } else { __ASSERT(f->state == 2, 0); - Files_Deregister(f->registerName, 101); - __MOVE(f->registerName, f->workName, 101); + Files_Deregister(f->registerName, 256); + __MOVE(f->registerName, f->workName, 256); f->registerName[0] = 0x00; f->tempFile = 0; } - error = Platform_Unlink((void*)f->workName, 101); - error = Platform_New((void*)f->workName, 101, &f->fd); + error = Platform_Unlink((void*)f->workName, 256); + error = Platform_New((void*)f->workName, 256, &f->fd); done = error == 0; if (done) { f->next = Files_files; @@ -320,8 +321,8 @@ void Files_Close (Files_File f) 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]); + while ((i < 4 && f->bufs[__X(i, 4)] != NIL)) { + Files_Flush(f->bufs[__X(i, 4)]); i += 1; } } @@ -338,7 +339,7 @@ Files_File Files_New (CHAR *name, ADDRESS name__len) __DUP(name, name__len, CHAR); __NEW(f, Files_FileDesc); f->workName[0] = 0x00; - __COPY(name, f->registerName, 101); + __COPY(name, f->registerName, 256); f->fd = -1; f->state = 1; f->len = 0; @@ -360,35 +361,35 @@ static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len) *pos += 1; } } else { - ch = (Files_SearchPath->data)[*pos]; + ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])]; while (ch == ' ' || ch == ';') { *pos += 1; - ch = (Files_SearchPath->data)[*pos]; + ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])]; } if (ch == '~') { *pos += 1; - ch = (Files_SearchPath->data)[*pos]; - while (Files_HOME[i] != 0x00) { - dir[i] = Files_HOME[i]; + ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])]; + while (Files_HOME[__X(i, 1024)] != 0x00) { + dir[__X(i, dir__len)] = Files_HOME[__X(i, 1024)]; i += 1; } if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) { - while ((i > 0 && dir[i - 1] != '/')) { + while ((i > 0 && dir[__X(i - 1, dir__len)] != '/')) { i -= 1; } } } while ((ch != 0x00 && ch != ';')) { - dir[i] = ch; + dir[__X(i, dir__len)] = ch; i += 1; *pos += 1; - ch = (Files_SearchPath->data)[*pos]; + ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])]; } - while ((i > 0 && dir[i - 1] == ' ')) { + while ((i > 0 && dir[__X(i - 1, dir__len)] == ' ')) { i -= 1; } } - dir[i] = 0x00; + dir[__X(i, dir__len)] = 0x00; } static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len) @@ -399,7 +400,7 @@ static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len) ch = name[0]; while ((ch != 0x00 && ch != '/')) { i += 1; - ch = name[i]; + ch = name[__X(i, name__len)]; } return ch == '/'; } @@ -414,9 +415,9 @@ static Files_File Files_CacheEntry (Platform_FileIdentity 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; + if (f->bufs[__X(i, 4)] != NIL) { + f->bufs[__X(i, 4)]->org = -1; + f->bufs[__X(i, 4)] = NIL; } i += 1; } @@ -483,7 +484,7 @@ Files_File Files_Old (CHAR *name, ADDRESS name__len) f->pos = 0; f->swapper = -1; error = Platform_Size(fd, &f->len); - __COPY(name, f->workName, 101); + __COPY(name, f->workName, 256); f->registerName[0] = 0x00; f->tempFile = 0; f->identity = identity; @@ -515,9 +516,9 @@ void Files_Purge (Files_File f) INT16 error; i = 0; while (i < 4) { - if (f->bufs[i] != NIL) { - f->bufs[i]->org = -1; - f->bufs[i] = NIL; + if (f->bufs[__X(i, 4)] != NIL) { + f->bufs[__X(i, 4)]->org = -1; + f->bufs[__X(i, 4)] = NIL; } i += 1; } @@ -561,22 +562,22 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos) offset = __MASK(pos, -4096); org = pos - offset; i = 0; - while ((((i < 4 && f->bufs[i] != NIL)) && org != f->bufs[i]->org)) { + while ((((i < 4 && f->bufs[__X(i, 4)] != NIL)) && org != f->bufs[__X(i, 4)]->org)) { i += 1; } if (i < 4) { - if (f->bufs[i] == NIL) { + if (f->bufs[__X(i, 4)] == NIL) { __NEW(buf, Files_BufDesc); buf->chg = 0; buf->org = -1; buf->f = f; - f->bufs[i] = buf; + f->bufs[__X(i, 4)] = buf; } else { - buf = f->bufs[i]; + buf = f->bufs[__X(i, 4)]; } } else { f->swapper = __MASK(f->swapper + 1, -4); - buf = f->bufs[f->swapper]; + buf = f->bufs[__X(f->swapper, 4)]; Files_Flush(buf); } if (buf->org != org) { @@ -623,7 +624,7 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x) } Files_Assert(offset <= buf->size); if (offset < buf->size) { - *x = buf->data[offset]; + *x = buf->data[__X(offset, 4096)]; (*r).offset = offset + 1; } else if ((*r).org + offset < buf->f->len) { Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset); @@ -635,6 +636,11 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x) } } +void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x) +{ + Files_Read(&*r, r__typ, &*x); +} + void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n) { INT32 xpos, min, restInBuf, offset; @@ -661,7 +667,7 @@ void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x } else { min = n; } - __MOVE((ADDRESS)&buf->data[offset], (ADDRESS)&x[xpos], min); + __MOVE((ADDRESS)&buf->data[__X(offset, 4096)], (ADDRESS)&x[__X(xpos, x__len)], min); offset += min; (*r).offset = offset; xpos += min; @@ -690,7 +696,7 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x) offset = (*r).offset; } Files_Assert(offset < 4096); - buf->data[offset] = x; + buf->data[__X(offset, 4096)] = x; buf->chg = 1; if (offset == buf->size) { buf->size += 1; @@ -724,7 +730,7 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS } else { min = n; } - __MOVE((ADDRESS)&x[xpos], (ADDRESS)&buf->data[offset], min); + __MOVE((ADDRESS)&x[__X(xpos, x__len)], (ADDRESS)&buf->data[__X(offset, 4096)], min); offset += min; (*r).offset = offset; Files_Assert(offset <= 4096); @@ -819,12 +825,12 @@ void Files_Register (Files_File f) } Files_Close(f); if (f->registerName[0] != 0x00) { - Files_Deregister(f->registerName, 101); - Files_Rename(f->workName, 101, f->registerName, 101, &errcode); + Files_Deregister(f->registerName, 256); + Files_Rename(f->workName, 256, f->registerName, 256, &errcode); if (errcode != 0) { Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode); } - __MOVE(f->registerName, f->workName, 101); + __MOVE(f->registerName, f->workName, 256); f->registerName[0] = 0x00; f->tempFile = 0; } @@ -845,7 +851,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *de j = 0; while (i > 0) { i -= 1; - dest[j] = src[i]; + dest[__X(j, dest__len)] = src[__X(i, src__len)]; j += 1; } } else { @@ -902,7 +908,7 @@ void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len) i = 0; do { Files_Read(&*R, R__typ, (void*)&ch); - x[i] = ch; + x[__X(i, x__len)] = ch; i += 1; } while (!(ch == 0x00)); } @@ -912,16 +918,16 @@ void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len) INT16 i; i = 0; do { - Files_Read(&*R, R__typ, (void*)&x[i]); + Files_Read(&*R, R__typ, (void*)&x[__X(i, x__len)]); i += 1; - } while (!(x[i - 1] == 0x00 || x[i - 1] == 0x0a)); - if (x[i - 1] == 0x0a) { + } while (!(x[__X(i - 1, x__len)] == 0x00 || x[__X(i - 1, x__len)] == 0x0a)); + if (x[__X(i - 1, x__len)] == 0x0a) { i -= 1; } - if ((i > 0 && x[i - 1] == 0x0d)) { + if ((i > 0 && x[__X(i - 1, x__len)] == 0x0d)) { i -= 1; } - x[i] = 0x00; + x[__X(i, x__len)] = 0x00; } void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len) @@ -949,18 +955,18 @@ void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x) void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x) { CHAR b[2]; - b[0] = (CHAR)x; - b[1] = (CHAR)__ASHR(x, 8); + b[0] = __CHR(x); + b[1] = __CHR(__ASHR(x, 8)); Files_WriteBytes(&*R, R__typ, (void*)b, 2, 2); } void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 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); + b[0] = __CHR(x); + b[1] = __CHR(__ASHR(x, 8)); + b[2] = __CHR(__ASHR(x, 16)); + b[3] = __CHR(__ASHR(x, 24)); Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4); } @@ -968,11 +974,13 @@ void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x) { CHAR b[4]; INT32 i; - i = (INT32)x; - b[0] = (CHAR)i; - b[1] = (CHAR)__ASHR(i, 8); - b[2] = (CHAR)__ASHR(i, 16); - b[3] = (CHAR)__ASHR(i, 24); + UINT64 y; + y = x; + i = __VAL(INT32, y); + b[0] = __CHR(i); + b[1] = __CHR(__ASHR(i, 8)); + b[2] = __CHR(__ASHR(i, 16)); + b[3] = __CHR(__ASHR(i, 24)); Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4); } @@ -994,7 +1002,7 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len { INT16 i; i = 0; - while (x[i] != 0x00) { + while (x[__X(i, x__len)] != 0x00) { i += 1; } Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1); @@ -1003,10 +1011,10 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x) { while (x < -64 || x > 63) { - Files_Write(&*R, R__typ, (CHAR)(__MASK(x, -128) + 128)); + Files_Write(&*R, R__typ, __CHR(__MASK(x, -128) + 128)); x = __ASHR(x, 7); } - Files_Write(&*R, R__typ, (CHAR)__MASK(x, -128)); + Files_Write(&*R, R__typ, __CHR(__MASK(x, -128))); } void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len) @@ -1043,7 +1051,7 @@ static void Files_Finalize (SYSTEM_PTR o) if (f->fd >= 0) { Files_CloseOSFile(f); if (f->tempFile) { - res = Platform_Unlink((void*)f->workName, 101); + res = Platform_Unlink((void*)f->workName, 256); } } } @@ -1065,7 +1073,7 @@ static void EnumPtrs(void (*P)(void*)) P(Files_SearchPath); } -__TDESC(Files_FileDesc, 1, 4) = {__TDFLDS("FileDesc", 288), {240, 248, 256, 264, -40}}; +__TDESC(Files_FileDesc, 1, 4) = {__TDFLDS("FileDesc", 600), {552, 560, 568, 576, -40}}; __TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4120), {0, -16}}; __TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 24), {8, -16}}; @@ -1085,5 +1093,7 @@ export void *Files__init(void) Heap_FileCount = 0; Files_HOME[0] = 0x00; Platform_GetEnv((CHAR*)"HOME", 5, (void*)Files_HOME, 1024); + Files_MaxPathLength = Platform_MaxPathLength(); + Files_MaxNameLength = Platform_MaxNameLength(); __ENDMOD; } diff --git a/bootstrap/windows-88/Files.h b/bootstrap/windows-88/Files.h index 74f5c8ca..8a7e59f8 100644 --- a/bootstrap/windows-88/Files.h +++ b/bootstrap/windows-88/Files.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Files__h #define Files__h @@ -11,7 +11,7 @@ typedef typedef struct Files_FileDesc { INT64 _prvt0; - char _prvt1[280]; + char _prvt1[592]; } Files_FileDesc; typedef @@ -23,6 +23,7 @@ typedef } Files_Rider; +import INT16 Files_MaxPathLength, Files_MaxNameLength; import ADDRESS *Files_FileDesc__typ; import ADDRESS *Files_Rider__typ; @@ -40,6 +41,7 @@ import INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ); import void Files_Purge (Files_File f); import void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); import void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x); +import void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x); import void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n); import void Files_ReadInt (Files_Rider *R, ADDRESS *R__typ, INT16 *x); import void Files_ReadLInt (Files_Rider *R, ADDRESS *R__typ, INT32 *x); diff --git a/bootstrap/windows-88/Heap.c b/bootstrap/windows-88/Heap.c index aeebff17..7b004b60 100644 --- a/bootstrap/windows-88/Heap.c +++ b/bootstrap/windows-88/Heap.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tsSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -68,9 +68,10 @@ static INT64 Heap_freeList[10]; static INT64 Heap_bigBlocks; export INT64 Heap_allocated; static BOOLEAN Heap_firstTry; +static INT16 Heap_ldUnit; export INT64 Heap_heap; static INT64 Heap_heapMin, Heap_heapMax; -export INT64 Heap_heapsize; +export INT64 Heap_heapsize, Heap_heapMinExpand; static Heap_FinNode Heap_fin; static INT16 Heap_lockdepth; static BOOLEAN Heap_interrupted; @@ -228,10 +229,10 @@ static INT64 Heap_NewChunk (INT64 blksz) static void Heap_ExtendHeap (INT64 blksz) { INT64 size, chnk, j, next; - if (Heap_uLT(320000, blksz)) { + if (Heap_uLT(Heap_heapMinExpand, blksz)) { size = blksz; } else { - size = 320000; + size = Heap_heapMinExpand; } chnk = Heap_NewChunk(size); if (chnk != 0) { @@ -248,6 +249,8 @@ static void Heap_ExtendHeap (INT64 blksz) __PUT(chnk, next, INT64); __PUT(j, chnk, INT64); } + } else if (!Heap_firstTry) { + Heap_heapMinExpand = 32; } } @@ -257,16 +260,16 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag) SYSTEM_PTR new; Heap_Lock(); __GET(tag, blksz, INT64); - i0 = __ASHR(blksz, 5); + i0 = __LSH(blksz, -Heap_ldUnit, 64); i = i0; - if (Heap_uLT(i, 9)) { + if (i < 9) { adr = Heap_freeList[i]; while (adr == 0) { i += 1; adr = Heap_freeList[i]; } } - if (Heap_uLT(i, 9)) { + if (i < 9) { __GET(adr + 24, next, INT64); Heap_freeList[i] = next; if (i != i0) { @@ -289,16 +292,17 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag) if (Heap_firstTry) { Heap_GC(1); blksz += 32; - if (Heap_uLT(Heap_heapsize - Heap_allocated, blksz) || Heap_uLT(__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2), Heap_heapsize)) { - Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 96), 7) - Heap_heapsize); + t = __LSH(Heap_allocated + blksz, -(2 + Heap_ldUnit), 64) * 160; + if (Heap_uLT(Heap_heapsize, t)) { + Heap_ExtendHeap(t - 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); + Heap_ExtendHeap(blksz); new = Heap_NEWREC(tag); } + Heap_firstTry = 1; Heap_Unlock(); return new; } else { @@ -443,7 +447,7 @@ static void Heap_Scan (void) __PUT(start, start + 8, INT64); __PUT(start + 8, freesize, INT64); __PUT(start + 16, -8, INT64); - i = __ASHR(freesize, 5); + i = __LSH(freesize, -Heap_ldUnit, 64); freesize = 0; if (Heap_uLT(i, 9)) { __PUT(start + 24, Heap_freeList[i], INT64); @@ -469,7 +473,7 @@ static void Heap_Scan (void) __PUT(start, start + 8, INT64); __PUT(start + 8, freesize, INT64); __PUT(start + 16, -8, INT64); - i = __ASHR(freesize, 5); + i = __LSH(freesize, -Heap_ldUnit, 64); freesize = 0; if (Heap_uLT(i, 9)) { __PUT(start + 24, Heap_freeList[i], INT64); @@ -661,79 +665,77 @@ void Heap_GC (BOOLEAN markStack) Heap_Module m; INT64 i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23; INT64 cand[10000]; - if (Heap_lockdepth == 0 || (Heap_lockdepth == 1 && !markStack)) { - Heap_Lock(); - m = (Heap_Module)(ADDRESS)Heap_modules; - while (m != NIL) { - if (m->enumPtrs != NIL) { - (*m->enumPtrs)(Heap_MarkP); - } - m = m->next; + Heap_Lock(); + m = (Heap_Module)(ADDRESS)Heap_modules; + while (m != NIL) { + if (m->enumPtrs != NIL) { + (*m->enumPtrs)(Heap_MarkP); } - 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(32, (void*)cand, 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(); + 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(32, (void*)cand, 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) @@ -756,6 +758,8 @@ void Heap_InitHeap (void) Heap_heapMin = -1; Heap_heapMax = 0; Heap_bigBlocks = 0; + Heap_heapMinExpand = 256000; + Heap_ldUnit = 5; Heap_heap = Heap_NewChunk(256000); __PUT(Heap_heap, 0, INT64); Heap_firstTry = 1; diff --git a/bootstrap/windows-88/Heap.h b/bootstrap/windows-88/Heap.h index ff1a1b07..45a9c6d2 100644 --- a/bootstrap/windows-88/Heap.h +++ b/bootstrap/windows-88/Heap.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tsSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */ #ifndef Heap__h #define Heap__h @@ -48,7 +48,7 @@ typedef import SYSTEM_PTR Heap_modules; import INT64 Heap_allocated; import INT64 Heap_heap; -import INT64 Heap_heapsize; +import INT64 Heap_heapsize, Heap_heapMinExpand; import INT16 Heap_FileCount; import ADDRESS *Heap_ModuleDesc__typ; diff --git a/bootstrap/windows-88/Modules.c b/bootstrap/windows-88/Modules.c index 62030574..7a49b8ff 100644 --- a/bootstrap/windows-88/Modules.c +++ b/bootstrap/windows-88/Modules.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -404,7 +404,7 @@ static void Modules_errint (INT32 l) if (l >= 10) { Modules_errint(__DIV(l, 10)); } - Modules_errch((CHAR)((int)__MOD(l, 10) + 48)); + Modules_errch(__CHR((int)__MOD(l, 10) + 48)); } static void Modules_DisplayHaltCode (INT32 code) diff --git a/bootstrap/windows-88/Modules.h b/bootstrap/windows-88/Modules.h index 5e518753..ee65a938 100644 --- a/bootstrap/windows-88/Modules.h +++ b/bootstrap/windows-88/Modules.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Modules__h #define Modules__h diff --git a/bootstrap/windows-88/OPB.c b/bootstrap/windows-88/OPB.c index 19e40505..913fbf2d 100644 --- a/bootstrap/windows-88/OPB.c +++ b/bootstrap/windows-88/OPB.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -261,7 +261,7 @@ static void OPB_CharToString (OPT_Node n) { CHAR ch; n->typ = OPT_stringtyp; - ch = (CHAR)n->conval->intval; + ch = __CHR(n->conval->intval); n->conval->ext = OPT_NewExt(); if (ch == 0x00) { n->conval->intval2 = 1; @@ -597,7 +597,7 @@ void OPB_MOp (INT8 op, OPT_Node *x) case 22: if (f == 3) { if (z->class == 7) { - z->conval->intval = (INT16)__CAP((CHAR)z->conval->intval); + z->conval->intval = (INT16)__CAP(__CHR(z->conval->intval)); z->obj = NIL; } else { z = NewOp__29(op, typ, z); @@ -1136,7 +1136,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ) OPB_err(203); r = (LONGREAL)1; } - (*x)->conval->intval = (INT32)__ENTIER(r); + (*x)->conval->intval = __SHORT(__ENTIER(r), 2147483648LL); OPB_SetIntType(*x); } } @@ -1626,6 +1626,7 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode) if (x == y) { } else if ((((y->comp == 2 && y->BaseTyp == x->BaseTyp)) && y->n <= x->n)) { } else if ((y->comp == 3 && y->BaseTyp == x->BaseTyp)) { + OPB_err(113); } else if (x->BaseTyp == OPT_chartyp) { if (g == 8) { if (ynode->conval->intval2 > x->n) { diff --git a/bootstrap/windows-88/OPB.h b/bootstrap/windows-88/OPB.h index 71d82def..f66fcd66 100644 --- a/bootstrap/windows-88/OPB.h +++ b/bootstrap/windows-88/OPB.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPB__h #define OPB__h diff --git a/bootstrap/windows-88/OPC.c b/bootstrap/windows-88/OPC.c index a5f41a8e..7b92ccc1 100644 --- a/bootstrap/windows-88/OPC.c +++ b/bootstrap/windows-88/OPC.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -618,31 +618,33 @@ 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 __", 11); - OPC_Ident(obj); - OPC_DeclareParams(obj->link, 1); - OPM_WriteString((CHAR*)" __SEND(", 9); - if (obj->link->typ->form == 11) { - OPM_WriteString((CHAR*)"__TYPEOF(", 10); - OPC_Ident(obj->link); + if ((obj->mode == 13 && obj == OPC_BaseTProc(obj))) { + if (OPM_currFile == 1 || (OPM_currFile == 0 && obj->vis == 1)) { + OPM_WriteString((CHAR*)"#define __", 11); + OPC_Ident(obj); + OPC_DeclareParams(obj->link, 1); + OPM_WriteString((CHAR*)" __SEND(", 9); + if (obj->link->typ->form == 11) { + OPM_WriteString((CHAR*)"__TYPEOF(", 10); + OPC_Ident(obj->link); + OPM_Write(')'); + } else { + OPC_Ident(obj->link); + OPM_WriteString((CHAR*)"__typ", 6); + } + OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16)); + if (obj->typ == OPT_notyp) { + OPM_WriteString((CHAR*)"void", 5); + } else { + OPC_Ident(obj->typ->strobj); + } + OPM_WriteString((CHAR*)"(*)", 4); + OPC_AnsiParamList(obj->link, 0); + OPM_WriteString((CHAR*)", ", 3); + OPC_DeclareParams(obj->link, 1); OPM_Write(')'); - } else { - OPC_Ident(obj->link); - OPM_WriteString((CHAR*)"__typ", 6); + OPM_WriteLn(); } - OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16)); - if (obj->typ == OPT_notyp) { - OPM_WriteString((CHAR*)"void", 5); - } else { - OPC_Ident(obj->typ->strobj); - } - OPM_WriteString((CHAR*)"(*)", 4); - OPC_AnsiParamList(obj->link, 0); - OPM_WriteString((CHAR*)", ", 3); - OPC_DeclareParams(obj->link, 1); - OPM_Write(')'); - OPM_WriteLn(); } OPC_DefineTProcMacros(obj->right, &*empty); } @@ -652,7 +654,7 @@ static void OPC_DefineType (OPT_Struct str) { OPT_Object obj = NIL, field = NIL, par = NIL; BOOLEAN empty; - if (OPM_currFile == 1 || str->ref < 255) { + if ((OPM_currFile == 1 || str->ref < 255) || (((OPM_currFile == 0 && str->strobj != NIL)) && str->strobj->vis == 1)) { obj = str->strobj; if (obj == NIL || OPC_Undefined(obj)) { if (obj != NIL) { @@ -681,6 +683,10 @@ static void OPC_DefineType (OPT_Struct str) OPC_DefineType(str->BaseTyp); } } else if (__IN(str->comp, 0x0c, 32)) { + if ((str->BaseTyp->strobj != NIL && str->BaseTyp->strobj->linkadr == 1)) { + OPM_Mark(244, str->txtpos); + str->BaseTyp->strobj->linkadr = 2; + } OPC_DefineType(str->BaseTyp); } else if (str->form == 12) { if (str->BaseTyp != OPT_notyp) { @@ -715,6 +721,13 @@ static void OPC_DefineType (OPT_Struct str) if (!empty) { OPM_WriteLn(); } + } else if ((obj->typ->form == 11 && obj->typ->BaseTyp->comp == 4)) { + empty = 1; + OPC_DeclareTProcs(obj->typ->BaseTyp->link, &empty); + OPC_DefineTProcMacros(obj->typ->BaseTyp->link, &empty); + if (!empty) { + OPM_WriteLn(); + } } } } @@ -1138,7 +1151,7 @@ static void OPC_GenHeaderMsg (void) OPM_WriteString((CHAR*)"/* ", 4); OPM_WriteString((CHAR*)"voc", 4); OPM_Write(' '); - OPM_WriteString(Configuration_versionLong, 75); + OPM_WriteString(Configuration_versionLong, 76); OPM_Write(' '); i = 0; while (i <= 31) { @@ -1739,7 +1752,7 @@ static void OPC_CharacterLiteral (INT64 c) if ((c == 92 || c == 39) || c == 63) { OPM_Write('\\'); } - OPM_Write((CHAR)c); + OPM_Write(__CHR(c)); OPM_Write('\''); } } @@ -1755,16 +1768,16 @@ static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l) c = (INT16)s[__X(i, s__len)]; if (c < 32 || c > 126) { OPM_Write('\\'); - OPM_Write((CHAR)(48 + __ASHR(c, 6))); + OPM_Write(__CHR(48 + __ASHR(c, 6))); c = __MASK(c, -64); - OPM_Write((CHAR)(48 + __ASHR(c, 3))); + OPM_Write(__CHR(48 + __ASHR(c, 3))); c = __MASK(c, -8); - OPM_Write((CHAR)(48 + c)); + OPM_Write(__CHR(48 + c)); } else { if ((c == 92 || c == 34) || c == 63) { OPM_Write('\\'); } - OPM_Write((CHAR)c); + OPM_Write(__CHR(c)); } i += 1; } @@ -1830,6 +1843,12 @@ void OPC_IntLiteral (INT64 n, INT32 size) void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim) { + INT64 d; + d = dim; + while (d > 0) { + array = array->BaseTyp; + d -= 1; + } if (array->comp == 3) { OPC_CompleteIdent(obj); OPM_WriteString((CHAR*)"__len", 6); @@ -1837,10 +1856,6 @@ void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim) OPM_WriteInt(dim); } } else { - while (dim > 0) { - array = array->BaseTyp; - dim -= 1; - } OPM_WriteInt(array->n); } } diff --git a/bootstrap/windows-88/OPC.h b/bootstrap/windows-88/OPC.h index 38a2b01d..3bfd88b8 100644 --- a/bootstrap/windows-88/OPC.h +++ b/bootstrap/windows-88/OPC.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPC__h #define OPC__h diff --git a/bootstrap/windows-88/OPM.c b/bootstrap/windows-88/OPM.c index 143546fd..b486b3b9 100644 --- a/bootstrap/windows-88/OPM.c +++ b/bootstrap/windows-88/OPM.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -19,6 +19,8 @@ typedef CHAR OPM_FileName[32]; +static CHAR OPM_currentComment[256]; +static BOOLEAN OPM_hasComment; static CHAR OPM_SourceFileName[256]; static CHAR OPM_GlobalModel[10]; export CHAR OPM_Model[10]; @@ -27,7 +29,7 @@ export INT16 OPM_AddressSize; static INT16 OPM_GlobalAlignment; export INT16 OPM_Alignment; export UINT32 OPM_GlobalOptions, OPM_Options; -export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; +export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize; export INT64 OPM_MaxIndex; export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; export BOOLEAN OPM_noerr; @@ -59,6 +61,7 @@ static void OPM_FindInstallDir (void); static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos); static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len); export void OPM_Get (CHAR *ch); +export void OPM_GetComment (CHAR *text, ADDRESS text__len); export void OPM_Init (BOOLEAN *done); export void OPM_InitOptions (void); export INT16 OPM_Integer (INT64 n); @@ -82,6 +85,7 @@ static void OPM_ScanOptions (CHAR *s, ADDRESS s__len); static void OPM_ShowLine (INT64 pos); export INT64 OPM_SignedMaximum (INT32 bytecount); export INT64 OPM_SignedMinimum (INT32 bytecount); +export void OPM_StoreComment (CHAR *text, ADDRESS text__len); export void OPM_SymRCh (CHAR *ch); export INT32 OPM_SymRInt (void); export INT64 OPM_SymRInt64 (void); @@ -157,6 +161,36 @@ void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len) __DEL(modname); } +void OPM_StoreComment (CHAR *text, ADDRESS text__len) +{ + INT16 i; + __DUP(text, text__len, CHAR); + i = 0; + while ((i < 255 && text[__X(i, text__len)] != 0x00)) { + OPM_currentComment[__X(i, 256)] = text[__X(i, text__len)]; + i += 1; + } + OPM_currentComment[__X(i, 256)] = 0x00; + OPM_hasComment = 1; + __DEL(text); +} + +void OPM_GetComment (CHAR *text, ADDRESS text__len) +{ + INT16 i; + if (OPM_hasComment) { + i = 0; + while ((((i < text__len && i < 256)) && OPM_currentComment[__X(i, 256)] != 0x00)) { + text[__X(i, text__len)] = OPM_currentComment[__X(i, 256)]; + i += 1; + } + text[__X(i, text__len)] = 0x00; + OPM_hasComment = 0; + } else { + text[0] = 0x00; + } +} + INT64 OPM_SignedMaximum (INT32 bytecount) { INT64 result; @@ -272,7 +306,7 @@ BOOLEAN OPM_OpenPar (void) if (Modules_ArgCount == 1) { OPM_LogWLn(); OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20); - OPM_LogWStr(Configuration_versionLong, 75); + OPM_LogWStr(Configuration_versionLong, 76); OPM_LogW('.'); OPM_LogWLn(); OPM_LogWStr((CHAR*)"Based on Ofront by J. Templ and Software Templ OEG.", 52); @@ -338,7 +372,7 @@ BOOLEAN OPM_OpenPar (void) OPM_LogWLn(); OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95); OPM_LogWLn(); - OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); + OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER and SET, 64 bit LONGINT.", 95); OPM_LogWLn(); OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95); OPM_LogWLn(); @@ -410,21 +444,25 @@ void OPM_InitOptions (void) OPM_ShortintSize = 1; OPM_IntegerSize = 2; OPM_LongintSize = 4; + OPM_SetSize = 4; break; case 'C': OPM_ShortintSize = 2; OPM_IntegerSize = 4; OPM_LongintSize = 8; + OPM_SetSize = 4; break; case 'V': OPM_ShortintSize = 1; OPM_IntegerSize = 4; OPM_LongintSize = 8; + OPM_SetSize = 8; break; default: OPM_ShortintSize = 1; OPM_IntegerSize = 2; OPM_LongintSize = 4; + OPM_SetSize = 4; break; } __MOVE(OPM_InstallDir, OPM_ResourceDir, 1024); @@ -606,7 +644,7 @@ static void OPM_ShowLine (INT64 pos) if (pos >= (INT64)OPM_ErrorLineLimitPos) { pos = OPM_ErrorLineLimitPos - 1; } - i = (INT16)OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos); + i = __SHORTF(OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos), 32768); while (i > 0) { OPM_LogW(' '); i -= 1; @@ -759,7 +797,7 @@ void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done) Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, 0); Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&tag); Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ver); - if (tag != 0xf7 || ver != 0x83) { + if (tag != 0xf7 || ver != 0x84) { if (!__IN(4, OPM_Options, 32)) { OPM_err(-306); } @@ -830,7 +868,7 @@ void OPM_NewSym (CHAR *modName, ADDRESS modName__len) if (OPM_newSFile != NIL) { Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, 0); Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7); - Files_Write(&OPM_newSF, Files_Rider__typ, 0x83); + Files_Write(&OPM_newSF, Files_Rider__typ, 0x84); } else { OPM_err(153); } @@ -865,17 +903,17 @@ void OPM_WriteHex (INT64 i) { CHAR s[3]; INT32 digit; - digit = __ASHR((INT32)i, 4); + digit = __ASHR(__SHORT(i, 2147483648LL), 4); if (digit < 10) { - s[0] = (CHAR)(48 + digit); + s[0] = __CHR(48 + digit); } else { - s[0] = (CHAR)(87 + digit); + s[0] = __CHR(87 + digit); } - digit = __MASK((INT32)i, -16); + digit = __MASK(__SHORT(i, 2147483648LL), -16); if (digit < 10) { - s[1] = (CHAR)(48 + digit); + s[1] = __CHR(48 + digit); } else { - s[1] = (CHAR)(87 + digit); + s[1] = __CHR(87 + digit); } s[2] = 0x00; OPM_WriteString(s, 3); @@ -897,11 +935,11 @@ void OPM_WriteInt (INT64 i) __MOVE("LL", s, 3); k = 2; } - s[__X(k, 26)] = (CHAR)(__MOD(i1, 10) + 48); + s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48); i1 = __DIV(i1, 10); k += 1; while (i1 > 0) { - s[__X(k, 26)] = (CHAR)(__MOD(i1, 10) + 48); + s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48); i1 = __DIV(i1, 10); k += 1; } @@ -924,13 +962,13 @@ void OPM_WriteReal (LONGREAL r, CHAR suffx) CHAR s[32]; CHAR ch; INT16 i; - if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == ((INT32)__ENTIER(r)))) { + if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == (__SHORT(__ENTIER(r), 2147483648LL)))) { if (suffx == 'f') { OPM_WriteString((CHAR*)"(REAL)", 7); } else { OPM_WriteString((CHAR*)"(LONGREAL)", 11); } - OPM_WriteInt((INT32)__ENTIER(r)); + OPM_WriteInt(__SHORT(__ENTIER(r), 2147483648LL)); } else { Texts_OpenWriter(&W, Texts_Writer__typ); if (suffx == 'f') { @@ -1139,5 +1177,7 @@ export void *OPM__init(void) OPM_MinReal = -OPM_MaxReal; OPM_MinLReal = -OPM_MaxLReal; OPM_FindInstallDir(); + OPM_hasComment = 0; + OPM_currentComment[0] = 0x00; __ENDMOD; } diff --git a/bootstrap/windows-88/OPM.h b/bootstrap/windows-88/OPM.h index 96318bea..64c15a28 100644 --- a/bootstrap/windows-88/OPM.h +++ b/bootstrap/windows-88/OPM.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPM__h #define OPM__h @@ -9,7 +9,7 @@ import CHAR OPM_Model[10]; import INT16 OPM_AddressSize, OPM_Alignment; import UINT32 OPM_GlobalOptions, OPM_Options; -import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize; +import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize, OPM_SetSize; import INT64 OPM_MaxIndex; import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal; import BOOLEAN OPM_noerr; @@ -30,6 +30,7 @@ import void OPM_FPrintLReal (INT32 *fp, LONGREAL val); import void OPM_FPrintReal (INT32 *fp, REAL val); import void OPM_FPrintSet (INT32 *fp, UINT64 val); import void OPM_Get (CHAR *ch); +import void OPM_GetComment (CHAR *text, ADDRESS text__len); import void OPM_Init (BOOLEAN *done); import void OPM_InitOptions (void); import INT16 OPM_Integer (INT64 n); @@ -48,6 +49,7 @@ import BOOLEAN OPM_OpenPar (void); import void OPM_RegisterNewSym (void); import INT64 OPM_SignedMaximum (INT32 bytecount); import INT64 OPM_SignedMinimum (INT32 bytecount); +import void OPM_StoreComment (CHAR *text, ADDRESS text__len); import void OPM_SymRCh (CHAR *ch); import INT32 OPM_SymRInt (void); import INT64 OPM_SymRInt64 (void); diff --git a/bootstrap/windows-88/OPP.c b/bootstrap/windows-88/OPP.c index 52620168..3fed2e31 100644 --- a/bootstrap/windows-88/OPP.c +++ b/bootstrap/windows-88/OPP.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -634,7 +634,7 @@ static void OPP_StandProcCall (OPT_Node *x) OPT_Node y = NIL; INT8 m; INT16 n; - m = (INT8)((INT16)(*x)->obj->adr); + m = __SHORT(__SHORT((*x)->obj->adr, 32768), 128); n = 0; if (OPP_sym == 30) { OPS_Get(&OPP_sym); @@ -943,7 +943,7 @@ static void GetCode__19 (void) (*ext)[__X(n + 1, 256)] = OPS_str[__X(n, 256)]; n += 1; } - (*ext)[0] = (CHAR)n; + (*ext)[0] = __CHR(n); OPS_Get(&OPP_sym); } else { for (;;) { @@ -956,14 +956,14 @@ static void GetCode__19 (void) n = 1; } OPS_Get(&OPP_sym); - (*ext)[__X(n, 256)] = (CHAR)c; + (*ext)[__X(n, 256)] = __CHR(c); } if (OPP_sym == 19) { OPS_Get(&OPP_sym); } else if (OPP_sym == 35) { OPP_err(19); } else { - (*ext)[0] = (CHAR)n; + (*ext)[0] = __CHR(n); break; } } diff --git a/bootstrap/windows-88/OPP.h b/bootstrap/windows-88/OPP.h index aa076aaa..3d8cefe8 100644 --- a/bootstrap/windows-88/OPP.h +++ b/bootstrap/windows-88/OPP.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPP__h #define OPP__h diff --git a/bootstrap/windows-88/OPS.c b/bootstrap/windows-88/OPS.c index bf9f1af5..a25a2c12 100644 --- a/bootstrap/windows-88/OPS.c +++ b/bootstrap/windows-88/OPS.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -56,11 +56,11 @@ static void OPS_Str (INT8 *sym) OPS_err(241); break; } - OPS_str[i] = OPS_ch; + OPS_str[__X(i, 256)] = OPS_ch; i += 1; } OPM_Get(&OPS_ch); - OPS_str[i] = 0x00; + OPS_str[__X(i, 256)] = 0x00; OPS_intval = i + 1; if (OPS_intval == 2) { *sym = 35; @@ -76,7 +76,7 @@ static void OPS_Identifier (INT8 *sym) INT16 i; i = 0; do { - OPS_name[i] = OPS_ch; + OPS_name[__X(i, 256)] = 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)); @@ -84,7 +84,7 @@ static void OPS_Identifier (INT8 *sym) OPS_err(240); i -= 1; } - OPS_name[i] = 0x00; + OPS_name[__X(i, 256)] = 0x00; *sym = 38; } @@ -143,7 +143,7 @@ static void OPS_Number (void) 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; + dig[__X(n, 24)] = OPS_ch; n += 1; } m += 1; @@ -173,7 +173,7 @@ static void OPS_Number (void) OPS_numtyp = 1; if (n <= 2) { while (i < n) { - OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1); + OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[__X(i, 24)], 1); i += 1; } } else { @@ -187,7 +187,7 @@ static void OPS_Number (void) OPS_intval = -1; } while (i < n) { - OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1); + OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[__X(i, 24)], 1); i += 1; } } else { @@ -196,7 +196,7 @@ static void OPS_Number (void) } else { OPS_numtyp = 2; while (i < n) { - d = Ord__7(dig[i], 0); + d = Ord__7(dig[__X(i, 24)], 0); i += 1; if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) { OPS_intval = OPS_intval * 10 + (INT64)d; @@ -214,7 +214,7 @@ static void OPS_Number (void) expCh = 'E'; while (n > 0) { n -= 1; - f = (Ord__7(dig[n], 0) + f) / (LONGREAL)(LONGREAL)10; + f = (Ord__7(dig[__X(n, 24)], 0) + f) / (LONGREAL)(LONGREAL)10; } if (OPS_ch == 'E' || OPS_ch == 'D') { expCh = OPS_ch; @@ -279,32 +279,74 @@ static void Comment__2 (void); static void Comment__2 (void) { + BOOLEAN isExported; + CHAR commentText[256]; + INT16 i, nestLevel; + CHAR prevCh, nextCh; + i = 0; + while (i <= 255) { + commentText[__X(i, 256)] = 0x00; + i += 1; + } + isExported = 0; + i = 0; + nestLevel = 1; + prevCh = 0x00; OPM_Get(&OPS_ch); - for (;;) { - for (;;) { - while (OPS_ch == '(') { + if (OPS_ch == '*') { + isExported = 1; + OPM_Get(&OPS_ch); + if (OPS_ch == ')') { + commentText[0] = 0x00; + OPM_StoreComment(commentText, 256); + OPM_Get(&OPS_ch); + return; + } + } + while ((nestLevel > 0 && OPS_ch != 0x00)) { + if ((prevCh == '(' && OPS_ch == '*')) { + nestLevel += 1; + prevCh = 0x00; + } else if ((prevCh == '*' && OPS_ch == ')')) { + nestLevel -= 1; + if (nestLevel == 0) { OPM_Get(&OPS_ch); - if (OPS_ch == '*') { - Comment__2(); + } else { + prevCh = 0x00; + } + } else { + if ((((isExported && nestLevel == 1)) && prevCh != 0x00)) { + if (i < 255) { + commentText[__X(i, 256)] = prevCh; + i += 1; } } - if (OPS_ch == '*') { - OPM_Get(&OPS_ch); - break; - } - if (OPS_ch == 0x00) { - break; - } + prevCh = OPS_ch; + } + if (nestLevel > 0) { OPM_Get(&OPS_ch); } - if (OPS_ch == ')') { - OPM_Get(&OPS_ch); - break; + } + if (OPS_ch == 0x00) { + OPS_err(5); + } + if ((((((isExported && nestLevel == 0)) && prevCh != 0x00)) && prevCh != '*')) { + if (i < 255) { + commentText[__X(i, 256)] = prevCh; + i += 1; + } else { + OPM_LogWStr((CHAR*)"Truncating final comment character", 35); + OPM_LogWLn(); } - if (OPS_ch == 0x00) { - OPS_err(5); - break; + } + if (isExported) { + if (i >= 256) { + OPM_LogWStr((CHAR*)"Warning: commentText overflow", 30); + OPM_LogWLn(); + i = 255; } + commentText[__X(i, 256)] = 0x00; + OPM_StoreComment(commentText, 256); } } diff --git a/bootstrap/windows-88/OPS.h b/bootstrap/windows-88/OPS.h index 09a33705..19e222ac 100644 --- a/bootstrap/windows-88/OPS.h +++ b/bootstrap/windows-88/OPS.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPS__h #define OPS__h diff --git a/bootstrap/windows-88/OPT.c b/bootstrap/windows-88/OPT.c index d89ea5c8..c3999981 100644 --- a/bootstrap/windows-88/OPT.c +++ b/bootstrap/windows-88/OPT.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -83,6 +83,7 @@ typedef OPT_Const conval; INT32 adr, linkadr; INT16 x; + OPT_ConstExt comment; } OPT_ObjDesc; typedef @@ -173,6 +174,7 @@ 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_OutTruncatedName (CHAR *text, ADDRESS text__len); export OPT_Struct OPT_SetType (INT32 size); export OPT_Struct OPT_ShorterOrLongerType (OPT_Struct x, INT16 dir); export INT32 OPT_SizeAlignment (INT32 size); @@ -352,7 +354,7 @@ void OPT_TypSize (OPT_Struct typ) } typ->size = offset; typ->align = base; - typ->sysflag = __MASK(typ->sysflag, -256) + (INT16)__ASHL(offset - off0, 8); + typ->sysflag = __MASK(typ->sysflag, -256) + __SHORT(__ASHL(offset - off0, 8), 32768); } else if (c == 2) { OPT_TypSize(typ->BaseTyp); typ->size = typ->n * typ->BaseTyp->size; @@ -388,6 +390,10 @@ OPT_Object OPT_NewObj (void) { OPT_Object obj = NIL; __NEW(obj, OPT_ObjDesc); + obj->typ = NIL; + obj->conval = NIL; + obj->comment = NIL; + obj->name[0] = 0x00; return obj; } @@ -554,6 +560,8 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj) OPT_Object ob0 = NIL, ob1 = NIL; BOOLEAN left; INT8 mnolev; + CHAR commentText[256]; + INT16 j; ob0 = OPT_topScope; ob1 = ob0->right; left = 0; @@ -585,6 +593,16 @@ void OPT_Insert (OPS_Name name, OPT_Object *obj) __COPY(name, ob1->name, 256); mnolev = OPT_topScope->mnolev; ob1->mnolev = mnolev; + OPM_GetComment((void*)commentText, 256); + if (commentText[0] != 0x00) { + ob1->comment = __NEWARR(NIL, 1, 1, 1, 0, ((INT64)(256))); + j = 0; + while ((j < 255 && commentText[__X(j, 256)] != 0x00)) { + (*ob1->comment)[__X(j, 256)] = commentText[__X(j, 256)]; + j += 1; + } + (*ob1->comment)[__X(j, 256)] = 0x00; + } break; } } @@ -1103,6 +1121,13 @@ static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par) tag = OPM_SymRInt(); last = NIL; while (tag != 18) { + if (tag < 0 || tag > 100) { + OPM_LogWStr((CHAR*)"ERROR: Invalid tag value in InSign: ", 37); + OPM_LogWNum(tag, 0); + OPM_LogWLn(); + OPM_err(155); + return; + } new = OPT_NewObj(); new->mnolev = -mno; if (last == NIL) { @@ -1251,7 +1276,7 @@ static void OPT_InStruct (OPT_Struct *typ) obj->vis = 0; tag = OPM_SymRInt(); if (tag == 35) { - (*typ)->sysflag = (INT16)OPM_SymRInt(); + (*typ)->sysflag = __SHORTF(OPM_SymRInt(), 32768); tag = OPM_SymRInt(); } switch (tag) { @@ -1381,7 +1406,37 @@ static OPT_Object OPT_InObj (INT8 mno) OPT_Struct typ = NIL; INT32 tag; OPT_ConstExt ext = NIL; + OPS_Name commentText; + BOOLEAN hasComment; + INT16 j; + INT32 len; tag = OPT_impCtxt.nextTag; + hasComment = 0; + while (tag == 41) { + len = OPM_SymRInt(); + if (len < 0) { + len = 0; + } + if (len > 255) { + len = 255; + } + i = 0; + while (i < len) { + OPM_SymRCh(&commentText[__X(i, 256)]); + i += 1; + } + commentText[__X(i, 256)] = 0x00; + hasComment = 1; + tag = OPM_SymRInt(); + } + OPT_impCtxt.nextTag = tag; + if (tag < 0 || tag > 50) { + OPM_LogWStr((CHAR*)"ERROR: Invalid tag in InObj: ", 30); + OPM_LogWNum(tag, 0); + OPM_LogWLn(); + OPM_err(155); + return NIL; + } if (tag == 19) { OPT_InStruct(&typ); obj = typ->strobj; @@ -1397,7 +1452,7 @@ static OPT_Object OPT_InObj (INT8 mno) obj->conval = OPT_NewConst(); OPT_InConstant(tag, obj->conval); obj->typ = OPT_InTyp(tag); - } else if (tag >= 31) { + } else if ((tag >= 31 && tag <= 33)) { obj->conval = OPT_NewConst(); obj->conval->intval = -1; OPT_InSign(mno, &obj->typ, &obj->link); @@ -1412,8 +1467,8 @@ static OPT_Object OPT_InObj (INT8 mno) obj->mode = 9; ext = OPT_NewExt(); obj->conval->ext = ext; - s = (INT16)OPM_SymRInt(); - (*ext)[0] = (CHAR)s; + s = __SHORTF(OPM_SymRInt(), 32768); + (*ext)[0] = __CHR(s); i = 1; while (i <= s) { OPM_SymRCh(&(*ext)[__X(i, 256)]); @@ -1424,20 +1479,37 @@ static OPT_Object OPT_InObj (INT8 mno) OPM_LogWStr((CHAR*)"unhandled case at InObj, tag = ", 32); OPM_LogWNum(tag, 0); OPM_LogWLn(); + OPM_err(155); + return NIL; break; } } else if (tag == 20) { obj->mode = 5; OPT_InStruct(&obj->typ); - } else { + } else if (tag == 21 || tag == 22) { obj->mode = 1; if (tag == 22) { obj->vis = 2; } OPT_InStruct(&obj->typ); + } else { + OPM_LogWStr((CHAR*)"ERROR: Unexpected tag in InObj: ", 33); + OPM_LogWNum(tag, 0); + OPM_LogWLn(); + OPM_err(155); + return NIL; } OPT_InName((void*)obj->name, 256); } + if ((hasComment && obj != NIL)) { + obj->comment = __NEWARR(NIL, 1, 1, 1, 0, ((INT64)(256))); + j = 0; + while ((((j < 255 && j < len)) && commentText[__X(j, 256)] != 0x00)) { + (*obj->comment)[__X(j, 256)] = commentText[__X(j, 256)]; + j += 1; + } + (*obj->comment)[__X(j, 256)] = 0x00; + } 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); @@ -1752,7 +1824,7 @@ static void OPT_OutConstant (OPT_Object obj) OPM_SymWInt(f); switch (f) { case 2: case 3: - OPM_SymWCh((CHAR)obj->conval->intval); + OPM_SymWCh(__CHR(obj->conval->intval)); break; case 4: OPM_SymWInt(obj->conval->intval); @@ -1780,13 +1852,40 @@ static void OPT_OutConstant (OPT_Object obj) } } +static void OPT_OutTruncatedName (CHAR *text, ADDRESS text__len) +{ + INT16 i; + __DUP(text, text__len, CHAR); + i = 0; + while ((i < 255 && text[__X(i, text__len)] != 0x00)) { + OPM_SymWCh(text[__X(i, text__len)]); + i += 1; + } + OPM_SymWCh(0x00); + __DEL(text); +} + static void OPT_OutObj (OPT_Object obj) { INT16 i, j; OPT_ConstExt ext = NIL; + INT16 k, l; if (obj != NIL) { OPT_OutObj(obj->left); if (__IN(obj->mode, 0x06ea, 32)) { + if (obj->comment != NIL) { + OPM_SymWInt(41); + k = 0; + while ((k < 255 && (*obj->comment)[__X(k, 256)] != 0x00)) { + k += 1; + } + OPM_SymWInt(k); + l = 0; + while (l < k) { + OPM_SymWCh((*obj->comment)[__X(l, 256)]); + l += 1; + } + } if (obj->history == 4) { OPT_FPrintErr(obj, 250); } else if (obj->vis != 0) { @@ -2026,7 +2125,7 @@ static void EnumPtrs(void (*P)(void*)) } __TDESC(OPT_ConstDesc, 1, 1) = {__TDFLDS("ConstDesc", 40), {0, -16}}; -__TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 336), {0, 8, 16, 24, 304, 312, -56}}; +__TDESC(OPT_ObjDesc, 1, 7) = {__TDFLDS("ObjDesc", 344), {0, 8, 16, 24, 304, 312, 336, -64}}; __TDESC(OPT_StrDesc, 1, 3) = {__TDFLDS("StrDesc", 72), {48, 56, 64, -32}}; __TDESC(OPT_NodeDesc, 1, 6) = {__TDFLDS("NodeDesc", 56), {0, 8, 16, 32, 40, 48, -56}}; __TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 5184), {16, 24, 32, 40, 48, 56, 64, 72, 80, 88, 96, 104, 112, 120, 128, 136, diff --git a/bootstrap/windows-88/OPT.h b/bootstrap/windows-88/OPT.h index 63bf2070..cf456af5 100644 --- a/bootstrap/windows-88/OPT.h +++ b/bootstrap/windows-88/OPT.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPT__h #define OPT__h @@ -61,6 +61,7 @@ typedef OPT_Const conval; INT32 adr, linkadr; INT16 x; + OPT_ConstExt comment; } OPT_ObjDesc; typedef diff --git a/bootstrap/windows-88/OPV.c b/bootstrap/windows-88/OPV.c index 69e2f94e..26c1c715 100644 --- a/bootstrap/windows-88/OPV.c +++ b/bootstrap/windows-88/OPV.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -112,7 +112,7 @@ static void OPV_Stamp (OPS_Name s) i += 2; k = 0; do { - n[__X(k, 10)] = (CHAR)((int)__MOD(j, 10) + 48); + n[__X(k, 10)] = __CHR((int)__MOD(j, 10) + 48); j = __DIV(j, 10); k += 1; } while (!(j == 0)); @@ -317,15 +317,27 @@ static INT16 OPV_Precedence (INT16 class, INT16 subclass, INT16 form, INT16 comp static void OPV_Len (OPT_Node n, INT64 dim) { + INT64 d; + OPT_Struct array = NIL; 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[", 7); - OPM_WriteInt(dim); - OPM_Write(']'); + d = dim; + array = n->typ; + while (d > 0) { + array = array->BaseTyp; + d -= 1; + } + if (array->comp == 3) { + OPV_design(n->left, 10); + OPM_WriteString((CHAR*)"->len[", 7); + OPM_WriteInt(dim); + OPM_Write(']'); + } else { + OPM_WriteInt(array->n); + } } else { OPC_Len(n->obj, n->typ, dim); } @@ -370,6 +382,7 @@ static void OPV_SizeCast (OPT_Node n, INT32 to) OPM_WriteInt(__ASHL(to, 3)); OPM_WriteString((CHAR*)")", 2); } + OPV_Entier(n, 9); } } @@ -381,7 +394,6 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec) if (to == 7) { if (from == 7) { OPV_SizeCast(n, newtype->size); - OPV_Entier(n, 9); } else { OPM_WriteString((CHAR*)"__SETOF(", 9); OPV_Entier(n, -1); @@ -391,7 +403,6 @@ static void OPV_Convert (OPT_Node n, OPT_Struct newtype, INT16 prec) } } else if (to == 4) { OPV_SizeCast(n, newtype->size); - OPV_Entier(n, 9); } else if (to == 3) { if (__IN(2, OPM_Options, 32)) { OPM_WriteString((CHAR*)"__CHR", 6); @@ -1183,7 +1194,7 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x) base = base->BaseTyp; } if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) { - OPC_Ident(base->strobj); + OPC_Andent(base); OPM_WriteString((CHAR*)"__typ", 6); } else if (base->form == 11) { OPM_WriteString((CHAR*)"POINTER__typ", 13); diff --git a/bootstrap/windows-88/OPV.h b/bootstrap/windows-88/OPV.h index c6a107b6..fbabd8f4 100644 --- a/bootstrap/windows-88/OPV.h +++ b/bootstrap/windows-88/OPV.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef OPV__h #define OPV__h diff --git a/bootstrap/windows-88/Out.c b/bootstrap/windows-88/Out.c index 01e91698..b43e55f1 100644 --- a/bootstrap/windows-88/Out.c +++ b/bootstrap/windows-88/Out.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -80,7 +80,7 @@ void Out_String (CHAR *str, ADDRESS str__len) error = Platform_Write(Platform_StdOut, (ADDRESS)str, l); } else { __MOVE((ADDRESS)str, (ADDRESS)&Out_buf[__X(Out_in, 128)], l); - Out_in += (INT16)l; + Out_in += __SHORT(l, 32768); } __DEL(str); } @@ -98,11 +98,11 @@ void Out_Int (INT64 x, INT64 n) if (x < 0) { x = -x; } - s[0] = (CHAR)(48 + __MOD(x, 10)); + s[0] = __CHR(48 + __MOD(x, 10)); x = __DIV(x, 10); i = 1; while (x != 0) { - s[__X(i, 22)] = (CHAR)(48 + __MOD(x, 10)); + s[__X(i, 22)] = __CHR(48 + __MOD(x, 10)); x = __DIV(x, 10); i += 1; } @@ -138,9 +138,9 @@ void Out_Hex (INT64 x, INT64 n) x = __ROTL(x, 4, 64); n -= 1; if (__MASK(x, -16) < 10) { - Out_Char((CHAR)(__MASK(x, -16) + 48)); + Out_Char(__CHR(__MASK(x, -16) + 48)); } else { - Out_Char((CHAR)((__MASK(x, -16) - 10) + 65)); + Out_Char(__CHR((__MASK(x, -16) - 10) + 65)); } } } @@ -154,7 +154,7 @@ void Out_Ln (void) static void Out_digit (INT64 n, CHAR *s, ADDRESS s__len, INT16 *i) { *i -= 1; - s[__X(*i, s__len)] = (CHAR)(__MOD(n, 10) + 48); + s[__X(*i, s__len)] = __CHR(__MOD(n, 10) + 48); } static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i) @@ -166,7 +166,7 @@ static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 if (l > *i) { l = *i; } - *i -= (INT16)l; + *i -= __SHORT(l, 32768); j = 0; while (j < l) { s[__X(*i + j, s__len)] = t[__X(j, t__len)]; @@ -248,7 +248,7 @@ static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_) if (nn) { x = -x; } - e = (INT16)__ASHR((e - 1023) * 77, 8); + e = __SHORT(__ASHR((e - 1023) * 77, 8), 32768); if (e >= 0) { x = x / (LONGREAL)Out_Ten(e); } else { diff --git a/bootstrap/windows-88/Out.h b/bootstrap/windows-88/Out.h index e1285046..a72547f4 100644 --- a/bootstrap/windows-88/Out.h +++ b/bootstrap/windows-88/Out.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Out__h #define Out__h diff --git a/bootstrap/windows-88/Platform.c b/bootstrap/windows-88/Platform.c index 1304f291..563f6417 100644 --- a/bootstrap/windows-88/Platform.c +++ b/bootstrap/windows-88/Platform.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -44,6 +44,8 @@ export BOOLEAN Platform_Inaccessible (INT16 e); export BOOLEAN Platform_Interrupted (INT16 e); export BOOLEAN Platform_IsConsole (INT64 h); export void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d); +export INT16 Platform_MaxNameLength (void); +export INT16 Platform_MaxPathLength (void); export INT16 Platform_New (CHAR *n, ADDRESS n__len, INT64 *h); export BOOLEAN Platform_NoSuchDirectory (INT16 e); export INT64 Platform_OSAllocate (INT64 size); @@ -88,6 +90,7 @@ export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS #define Platform_ETIMEDOUT() WSAETIMEDOUT #define Platform_GetConsoleMode(h, m) GetConsoleMode((HANDLE)h, (DWORD*)m) #define Platform_GetTickCount() (LONGINT)(UINT32)GetTickCount() +#define Platform_MAXPATH() MAX_PATH #define Platform_SetConsoleMode(h, m) SetConsoleMode((HANDLE)h, (DWORD)m) #define Platform_SetInterruptHandler(h) SystemSetInterruptHandler((ADDRESS)h) #define Platform_SetQuitHandler(h) SystemSetQuitHandler((ADDRESS)h) @@ -191,6 +194,16 @@ BOOLEAN Platform_Interrupted (INT16 e) return e == Platform_EINTR(); } +INT16 Platform_MaxNameLength (void) +{ + return Platform_MAXPATH(); +} + +INT16 Platform_MaxPathLength (void) +{ + return Platform_MAXPATH(); +} + INT64 Platform_OSAllocate (INT64 size) { return Platform_allocate(size); diff --git a/bootstrap/windows-88/Platform.h b/bootstrap/windows-88/Platform.h index 99405d0b..1259a228 100644 --- a/bootstrap/windows-88/Platform.h +++ b/bootstrap/windows-88/Platform.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Platform__h #define Platform__h @@ -41,6 +41,8 @@ import BOOLEAN Platform_Inaccessible (INT16 e); import BOOLEAN Platform_Interrupted (INT16 e); import BOOLEAN Platform_IsConsole (INT64 h); import void Platform_MTimeAsClock (Platform_FileIdentity i, INT32 *t, INT32 *d); +import INT16 Platform_MaxNameLength (void); +import INT16 Platform_MaxPathLength (void); import INT16 Platform_New (CHAR *n, ADDRESS n__len, INT64 *h); import BOOLEAN Platform_NoSuchDirectory (INT16 e); import INT64 Platform_OSAllocate (INT64 size); diff --git a/bootstrap/windows-88/Reals.c b/bootstrap/windows-88/Reals.c index d1eb72f6..512ec2c4 100644 --- a/bootstrap/windows-88/Reals.c +++ b/bootstrap/windows-88/Reals.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -67,9 +67,9 @@ void Reals_SetExpo (REAL *x, INT16 ex) { CHAR c; __GET((ADDRESS)x + 3, c, CHAR); - __PUT((ADDRESS)x + 3, (CHAR)(__ASHL(__ASHR((INT16)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR); + __PUT((ADDRESS)x + 3, __CHR(__ASHL(__ASHR((INT16)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR); __GET((ADDRESS)x + 2, c, CHAR); - __PUT((ADDRESS)x + 2, (CHAR)(__MASK((INT16)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR); + __PUT((ADDRESS)x + 2, __CHR(__MASK((INT16)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR); } INT16 Reals_ExpoL (LONGREAL x) @@ -87,21 +87,21 @@ void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len) } k = 0; if (n > 9) { - i = (INT32)__ENTIER(x / (LONGREAL)(LONGREAL)1000000000); - j = (INT32)__ENTIER(x - i * (LONGREAL)1000000000); + i = __SHORT(__ENTIER(x / (LONGREAL)(LONGREAL)1000000000), 2147483648LL); + j = __SHORT(__ENTIER(x - i * (LONGREAL)1000000000), 2147483648LL); if (j < 0) { j = 0; } while (k < 9) { - d[__X(k, d__len)] = (CHAR)((int)__MOD(j, 10) + 48); + d[__X(k, d__len)] = __CHR((int)__MOD(j, 10) + 48); j = __DIV(j, 10); k += 1; } } else { - i = (INT32)__ENTIER(x); + i = __SHORT(__ENTIER(x), 2147483648LL); } while (k < n) { - d[__X(k, d__len)] = (CHAR)((int)__MOD(i, 10) + 48); + d[__X(k, d__len)] = __CHR((int)__MOD(i, 10) + 48); i = __DIV(i, 10); k += 1; } @@ -115,9 +115,9 @@ void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len) static CHAR Reals_ToHex (INT16 i) { if (i < 10) { - return (CHAR)(i + 48); + return __CHR(i + 48); } else { - return (CHAR)(i + 55); + return __CHR(i + 55); } __RETCHK; } diff --git a/bootstrap/windows-88/Reals.h b/bootstrap/windows-88/Reals.h index 170d1785..93e7fa75 100644 --- a/bootstrap/windows-88/Reals.h +++ b/bootstrap/windows-88/Reals.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Reals__h #define Reals__h diff --git a/bootstrap/windows-88/Strings.c b/bootstrap/windows-88/Strings.c index 225bd40a..4b18812f 100644 --- a/bootstrap/windows-88/Strings.c +++ b/bootstrap/windows-88/Strings.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -6,6 +6,7 @@ #define SET UINT32 #include "SYSTEM.h" +#include "Reals.h" @@ -19,6 +20,8 @@ export INT16 Strings_Length (CHAR *s, ADDRESS s__len); export BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len); export INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos); export void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len); +export void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r); +export void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r); INT16 Strings_Length (CHAR *s, ADDRESS s__len) @@ -31,7 +34,7 @@ INT16 Strings_Length (CHAR *s, ADDRESS s__len) } if (i <= 32767) { __DEL(s); - return (INT16)i; + return __SHORT(i, 32768); } else { __DEL(s); return 32767; @@ -123,7 +126,7 @@ void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHA INT16 len, destLen, i; __DUP(source, source__len, CHAR); len = Strings_Length(source, source__len); - destLen = (INT16)dest__len - 1; + destLen = __SHORT(dest__len, 32768) - 1; if (pos < 0) { pos = 0; } @@ -236,10 +239,135 @@ BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS return __retval; } +void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r) +{ + INT16 p, e; + REAL y, g; + BOOLEAN neg, negE; + __DUP(s, s__len, CHAR); + p = 0; + while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { + p += 1; + } + if (s[__X(p, s__len)] == '-') { + neg = 1; + p += 1; + } else { + neg = 0; + } + while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { + p += 1; + } + y = (REAL)0; + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + y = y * (REAL)10 + ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + if (s[__X(p, s__len)] == '.') { + p += 1; + g = (REAL)1; + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + g = g / (REAL)(REAL)10; + y = y + g * ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + } + if (s[__X(p, s__len)] == 'D' || s[__X(p, s__len)] == 'E') { + p += 1; + e = 0; + if (s[__X(p, s__len)] == '-') { + negE = 1; + p += 1; + } else { + negE = 0; + } + while (s[__X(p, s__len)] == '0') { + p += 1; + } + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + e = e * 10 + ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + if (negE) { + y = y / (REAL)Reals_Ten(e); + } else { + y = y * Reals_Ten(e); + } + } + if (neg) { + y = -y; + } + *r = y; + __DEL(s); +} + +void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r) +{ + INT16 p, e; + LONGREAL y, g; + BOOLEAN neg, negE; + __DUP(s, s__len, CHAR); + p = 0; + while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { + p += 1; + } + if (s[__X(p, s__len)] == '-') { + neg = 1; + p += 1; + } else { + neg = 0; + } + while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') { + p += 1; + } + y = (LONGREAL)0; + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + y = y * (LONGREAL)10 + ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + if (s[__X(p, s__len)] == '.') { + p += 1; + g = (LONGREAL)1; + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + g = g / (LONGREAL)(LONGREAL)10; + y = y + g * ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + } + if (s[__X(p, s__len)] == 'D' || s[__X(p, s__len)] == 'E') { + p += 1; + e = 0; + if (s[__X(p, s__len)] == '-') { + negE = 1; + p += 1; + } else { + negE = 0; + } + while (s[__X(p, s__len)] == '0') { + p += 1; + } + while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) { + e = e * 10 + ((INT16)s[__X(p, s__len)] - 48); + p += 1; + } + if (negE) { + y = y / (LONGREAL)Reals_Ten(e); + } else { + y = y * Reals_Ten(e); + } + } + if (neg) { + y = -y; + } + *r = y; + __DEL(s); +} + export void *Strings__init(void) { __DEFMOD; + __MODULE_IMPORT(Reals); __REGMOD("Strings", 0); /* BEGIN */ __ENDMOD; diff --git a/bootstrap/windows-88/Strings.h b/bootstrap/windows-88/Strings.h index 4d98f1a3..f0e3ae34 100644 --- a/bootstrap/windows-88/Strings.h +++ b/bootstrap/windows-88/Strings.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Strings__h #define Strings__h @@ -17,6 +17,8 @@ import INT16 Strings_Length (CHAR *s, ADDRESS s__len); import BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len); import INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos); import void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len); +import void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r); +import void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r); import void *Strings__init(void); diff --git a/bootstrap/windows-88/Texts.c b/bootstrap/windows-88/Texts.c index 565de43f..77dc1bac 100644 --- a/bootstrap/windows-88/Texts.c +++ b/bootstrap/windows-88/Texts.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -8,7 +8,6 @@ #include "SYSTEM.h" #include "Files.h" #include "Modules.h" -#include "Out.h" #include "Reals.h" typedef @@ -813,10 +812,10 @@ void Texts_Scan (Texts_Scanner *S, ADDRESS *S__typ) if ('9' < ch) { if (('A' <= ch && ch <= 'F')) { hex = 1; - ch = (CHAR)((INT16)ch - 7); + ch = __CHR((INT16)ch - 7); } else if (('a' <= ch && ch <= 'f')) { hex = 1; - ch = (CHAR)((INT16)ch - 39); + ch = __CHR((INT16)ch - 39); } else { break; } @@ -1058,7 +1057,7 @@ void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n) x0 = x; } do { - a[__X(i, 24)] = (CHAR)(__MOD(x0, 10) + 48); + a[__X(i, 24)] = __CHR(__MOD(x0, 10) + 48); x0 = __DIV(x0, 10); i += 1; } while (!(x0 == 0)); @@ -1085,9 +1084,9 @@ void Texts_WriteHex (Texts_Writer *W, ADDRESS *W__typ, INT32 x) do { y = __MASK(x, -16); if (y < 10) { - a[__X(i, 20)] = (CHAR)(y + 48); + a[__X(i, 20)] = __CHR(y + 48); } else { - a[__X(i, 20)] = (CHAR)(y + 55); + a[__X(i, 20)] = __CHR(y + 55); } x = __ASHR(x, 4); i += 1; @@ -1163,8 +1162,8 @@ void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n) } 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)); + Texts_Write(&*W, W__typ, __CHR(__DIV(e, 10) + 48)); + Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48)); } } @@ -1314,7 +1313,7 @@ void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n) } else { Texts_Write(&*W, W__typ, ' '); } - e = (INT16)__ASHR((e - 1023) * 77, 8); + e = __SHORT(__ASHR((e - 1023) * 77, 8), 32768); if (e >= 0) { x = x / (LONGREAL)Reals_TenL(e); } else { @@ -1345,10 +1344,10 @@ void Texts_WriteLongReal (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x, INT16 n) } else { Texts_Write(&*W, W__typ, '+'); } - Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 100) + 48)); + Texts_Write(&*W, W__typ, __CHR(__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)); + Texts_Write(&*W, W__typ, __CHR(__DIV(e, 10) + 48)); + Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48)); } } @@ -1375,8 +1374,8 @@ static void WritePair__44 (CHAR ch, INT32 x); static void WritePair__44 (CHAR ch, INT32 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)((int)__MOD(x, 10) + 48)); + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, __CHR(__DIV(x, 10) + 48)); + Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, __CHR((int)__MOD(x, 10) + 48)); } void Texts_WriteDate (Texts_Writer *W, ADDRESS *W__typ, INT32 t, INT32 d) @@ -1810,7 +1809,6 @@ export void *Texts__init(void) __DEFMOD; __MODULE_IMPORT(Files); __MODULE_IMPORT(Modules); - __MODULE_IMPORT(Out); __MODULE_IMPORT(Reals); __REGMOD("Texts", EnumPtrs); __INITYP(Texts_FontDesc, Texts_FontDesc, 0); diff --git a/bootstrap/windows-88/Texts.h b/bootstrap/windows-88/Texts.h index bdd9fada..081eec2c 100644 --- a/bootstrap/windows-88/Texts.h +++ b/bootstrap/windows-88/Texts.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef Texts__h #define Texts__h diff --git a/bootstrap/windows-88/VT100.c b/bootstrap/windows-88/VT100.c index 9cd5cf4d..346fb37b 100644 --- a/bootstrap/windows-88/VT100.c +++ b/bootstrap/windows-88/VT100.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -34,6 +34,7 @@ static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len); export void VT100_HVP (INT16 n, INT16 m); export void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len); export void VT100_RCP (void); +export void VT100_Reset (void); static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end); export void VT100_SCP (void); export void VT100_SD (INT16 n); @@ -74,7 +75,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len) } e = s; do { - b[__X(e, 21)] = (CHAR)((int)__MOD(int_, 10) + 48); + b[__X(e, 21)] = __CHR((int)__MOD(int_, 10) + 48); int_ = __DIV(int_, 10); e += 1; } while (!(int_ == 0)); @@ -136,6 +137,15 @@ static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len) __DEL(letter); } +void VT100_Reset (void) +{ + CHAR cmd[6]; + __COPY("\033", cmd, 6); + Strings_Append((CHAR*)"c", 2, (void*)cmd, 6); + Out_String(cmd, 6); + Out_Ln(); +} + void VT100_CUU (INT16 n) { VT100_EscSeq(n, (CHAR*)"A", 2); @@ -256,6 +266,7 @@ export void *VT100__init(void) __REGCMD("DECTCEMh", VT100_DECTCEMh); __REGCMD("DECTCEMl", VT100_DECTCEMl); __REGCMD("RCP", VT100_RCP); + __REGCMD("Reset", VT100_Reset); __REGCMD("SCP", VT100_SCP); /* BEGIN */ __COPY("\033", VT100_CSI, 5); diff --git a/bootstrap/windows-88/VT100.h b/bootstrap/windows-88/VT100.h index 8f60c652..4e708647 100644 --- a/bootstrap/windows-88/VT100.h +++ b/bootstrap/windows-88/VT100.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef VT100__h #define VT100__h @@ -25,6 +25,7 @@ import void VT100_EL (INT16 n); import void VT100_HVP (INT16 n, INT16 m); import void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len); import void VT100_RCP (void); +import void VT100_Reset (void); import void VT100_SCP (void); import void VT100_SD (INT16 n); import void VT100_SGR (INT16 n); diff --git a/bootstrap/windows-88/extTools.c b/bootstrap/windows-88/extTools.c index fa840303..ce2fc413 100644 --- a/bootstrap/windows-88/extTools.c +++ b/bootstrap/windows-88/extTools.c @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #define SHORTINT INT8 #define INTEGER INT16 @@ -7,18 +7,22 @@ #include "SYSTEM.h" #include "Configuration.h" +#include "Heap.h" #include "Modules.h" #include "OPM.h" #include "Out.h" #include "Platform.h" #include "Strings.h" +typedef + CHAR extTools_CommandString[4096]; -static CHAR extTools_CFLAGS[1023]; + +static extTools_CommandString extTools_CFLAGS; export void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len); -static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len); +static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len, CHAR *additionalopts, ADDRESS additionalopts__len); export void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len); static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRESS cmd__len); @@ -26,14 +30,17 @@ static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRES static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRESS cmd__len) { INT16 r, status, exitcode; + extTools_CommandString fullcmd; __DUP(title, title__len, CHAR); __DUP(cmd, cmd__len, CHAR); if (__IN(18, OPM_Options, 32)) { - Out_String(title, title__len); + Out_String((CHAR*)" ", 3); Out_String(cmd, cmd__len); Out_Ln(); } - r = Platform_System(cmd, cmd__len); + __COPY(cmd, fullcmd, 4096); + Heap_GC(0); + r = Platform_System(fullcmd, 4096); status = __MASK(r, -128); exitcode = __ASHR(r, 8); if (exitcode > 127) { @@ -63,50 +70,55 @@ static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRES __DEL(cmd); } -static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len) +static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len, CHAR *additionalopts, ADDRESS additionalopts__len) { - __COPY("gcc -g", s, s__len); + __DUP(additionalopts, additionalopts__len, CHAR); + __COPY("gcc -fPIC -g -Wno-stringop-overflow", s, s__len); Strings_Append((CHAR*)" -I \"", 6, (void*)s, s__len); Strings_Append(OPM_ResourceDir, 1024, (void*)s, s__len); Strings_Append((CHAR*)"/include\" ", 11, (void*)s, s__len); - Platform_GetEnv((CHAR*)"CFLAGS", 7, (void*)extTools_CFLAGS, 1023); - Strings_Append(extTools_CFLAGS, 1023, (void*)s, s__len); + Strings_Append(additionalopts, additionalopts__len, (void*)s, s__len); Strings_Append((CHAR*)" ", 2, (void*)s, s__len); + Platform_GetEnv((CHAR*)"CFLAGS", 7, (void*)extTools_CFLAGS, 4096); + Strings_Append(extTools_CFLAGS, 4096, (void*)s, s__len); + Strings_Append((CHAR*)" ", 2, (void*)s, s__len); + __DEL(additionalopts); } void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len) { - CHAR cmd[1023]; + extTools_CommandString cmd; __DUP(moduleName, moduleName__len, CHAR); - extTools_InitialiseCompilerCommand((void*)cmd, 1023); - Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 1023); - Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023); - Strings_Append((CHAR*)".c", 3, (void*)cmd, 1023); - extTools_execute((CHAR*)"C compile: ", 12, cmd, 1023); + extTools_InitialiseCompilerCommand((void*)cmd, 4096, (CHAR*)"", 1); + Strings_Append((CHAR*)"-c ", 4, (void*)cmd, 4096); + Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096); + Strings_Append((CHAR*)".c", 3, (void*)cmd, 4096); + extTools_execute((CHAR*)"C compile: ", 12, cmd, 4096); __DEL(moduleName); } void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len) { - CHAR cmd[1023]; + extTools_CommandString cmd; __DUP(additionalopts, additionalopts__len, CHAR); - extTools_InitialiseCompilerCommand((void*)cmd, 1023); - Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023); - Strings_Append((CHAR*)".c ", 4, (void*)cmd, 1023); - Strings_Append(additionalopts, additionalopts__len, (void*)cmd, 1023); + extTools_InitialiseCompilerCommand((void*)cmd, 4096, additionalopts, additionalopts__len); + Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096); + Strings_Append((CHAR*)".c ", 4, (void*)cmd, 4096); if (statically) { - Strings_Append((CHAR*)" -static", 9, (void*)cmd, 1023); + Strings_Append((CHAR*)" -static", 9, (void*)cmd, 4096); } - Strings_Append((CHAR*)" -o ", 5, (void*)cmd, 1023); - Strings_Append(moduleName, moduleName__len, (void*)cmd, 1023); - Strings_Append((CHAR*)" -L\"", 5, (void*)cmd, 1023); - Strings_Append(OPM_InstallDir, 1024, (void*)cmd, 1023); - Strings_Append((CHAR*)"/lib\"", 6, (void*)cmd, 1023); - Strings_Append((CHAR*)" -l voc", 8, (void*)cmd, 1023); - Strings_Append((CHAR*)"-O", 3, (void*)cmd, 1023); - Strings_Append(OPM_Model, 10, (void*)cmd, 1023); - Strings_Append((CHAR*)"", 1, (void*)cmd, 1023); - extTools_execute((CHAR*)"C compile and link: ", 21, cmd, 1023); + Strings_Append((CHAR*)" -o ", 5, (void*)cmd, 4096); + Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096); + if (!statically || 1) { + Strings_Append((CHAR*)" -L\"", 5, (void*)cmd, 4096); + Strings_Append(OPM_InstallDir, 1024, (void*)cmd, 4096); + Strings_Append((CHAR*)"/lib\"", 6, (void*)cmd, 4096); + Strings_Append((CHAR*)" -lvoc", 7, (void*)cmd, 4096); + Strings_Append((CHAR*)"-O", 3, (void*)cmd, 4096); + Strings_Append(OPM_Model, 10, (void*)cmd, 4096); + Strings_Append((CHAR*)"", 1, (void*)cmd, 4096); + } + extTools_execute((CHAR*)"C compile and link: ", 21, cmd, 4096); __DEL(additionalopts); } @@ -115,6 +127,7 @@ export void *extTools__init(void) { __DEFMOD; __MODULE_IMPORT(Configuration); + __MODULE_IMPORT(Heap); __MODULE_IMPORT(Modules); __MODULE_IMPORT(OPM); __MODULE_IMPORT(Out); diff --git a/bootstrap/windows-88/extTools.h b/bootstrap/windows-88/extTools.h index a93b6c85..686f0b4e 100644 --- a/bootstrap/windows-88/extTools.h +++ b/bootstrap/windows-88/extTools.h @@ -1,4 +1,4 @@ -/* voc 2.00 [2016/12/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */ +/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */ #ifndef extTools__h #define extTools__h diff --git a/doc/Compiling.md b/doc/Compiling.md index abeaf6c2..ebb84ce9 100644 --- a/doc/Compiling.md +++ b/doc/Compiling.md @@ -57,11 +57,13 @@ The following options designate the main module: | Compiler option | Use | | :-------------: | --------------------------- | -| ```-m``` | Generate loadable binary using dynamic library loading (on systems that support it). | -| ```-M``` | Generate loadable binary with all library references statically linked. | +| ```-m``` | Generate loadable binary using dynamic library loading (*see note*) | +| ```-M``` | Generate loadable binary with all library references statically linked (*see note*) | For a main module, no .sym or .h files are generated, and the C compiler is called with additional parameters to generate the execututable binary, linking the object files needed for imported modules. +*Note:* not all systems support both static and dynamic linking: some support only static; some support only dynamic. When a system only supports one, ```-m``` and ```-M``` behave the same. + ### Separate compilation Each module may be compiled by a separate command line, although the imports of a module must be compiled before the module is compiled. All three generated files (.sym, .c and .h) must be retained at least until all modules dependent on this module have been compiled. diff --git a/doc/Files.md b/doc/Files.md new file mode 100644 index 00000000..54355260 --- /dev/null +++ b/doc/Files.md @@ -0,0 +1,70 @@ +## Oberon's Files.Mod - differences from POSIX style file APIs + +Most operating systems provide file access in a similar and familiar manner: + - A new file is initially created as an entry in a filesystem directory referencing an empty file. + - File writes add to this file though buffers that will be flushed when full and at file close. + - Following file close the file is inacccessible until reopened. + +#### Why is a file *always* indexed in the filesystem directory? + +Before computers, files would be stored in filing cabinets for long term storage and retrieval, but they would also live independent of filing cabinets, for example in in-trays or out-trays, or loose on desks while being assembled. + +A file outside the filing cabinet might be being in the process of updating and so in an incomplete or inconsistant state. A file in the filing cabinet might be considered complete and consistent. + +#### Oberon Files.Mod behaviour + +Oberons filesystem behaviour is arguably closer to pre-computer usage. Files can easily exist independent of the filesystem directory: + + - Files.New creates a Files.File object that is fully writeable (and readable) but which is not (yet) indexed in the the filesystem. + - Files.Register puts the files name into the filesystem directory. + - Files.Delete takes the files name out of the filesystem directory. + - Neither Register nor Delete affect the file content or access to it. + - The files disk space will be recovered when there is neither a Files.File object referencing the file, nor is its file name present in the directory. + +For example it would be possible for a program to create a new file (Files.New), and then repeatedly put it into the directory (Files.Register) and take it out of the directory (Files.Delete) while at all times the Files.File returned by Files.New remains valid and the content and connected riders are unaffected by the directory changes. + +#### Comparing the Posix and Oberon approaches to file creation. + +On a real Oberon system, file access is independent of the file directory and the Oberon APIs directly reflect the system implementation. + +On a POSIX like system some Oberon APIs require implementation workarounds. This table illustrates Oberon behaviour by describing how it is implemented on top of a POSIX like filesystem. + +|Oberon API|Oberon behaviour|C API|C behaviour| +|---|---|---|---| +|Files.New(name)|Creates a file handle (Files.File) but does not touch the disk.|fopen(name, "w")|Creates an empty file and returns a handle. The empty file is immediately visible to other processes.| +|Files.Set(rider,file,pos)|Creates a rider at a given file position. Multiple riders may be created on the same file at the same or different positions.|----|----| +|Files.WriteBytes(rider,bytes,len)|Buffers are allocated to store written data (current implementation is up to 4 buffers, each 4kb).
Until the buffers are full nothing is written to disk and no file is created in the OS|fwrite()|Data is written to a buffer up to a system dependant size, nothing is written to disk.| +|Files.WriteBytes beyond buffer size|Once more than 16kb has been written, Vishap Oberon creates a temporary file to back up least recently accessed buffers.|fwrite()...|Once the internal buffer is full it is written to the named disk file| +|Files.Register|If all data is still in buffers (no temp file has been created), an OS file is created using the name originally passed to Files.New.
If a temporary file had been created it is renamed to the name originally passed to Files.New.
All buffered data is flushed to the file.|(no equivalent)|| +|Files.Delete|If there is no Files.File in the same program referencing the file then unlink/DeleteFile is called.
If there is a Files.File the OS file is renamed as a temporary file.
Any riders active on the file remain valid.
The file can be reregistered later.|unlink() or DeleteFile()|The file is marked for deletion and will be removed from the filesystem directory when no processes have it open.
Neither Windows nor Linux allow the file to be put back into the directory.| +|Files.Close|Any buffered data is flushed to disk. *The file object and all riders remain valid, data can still be read and written*.|close|Any buffered data is flushed to disk. The file handle is no longer valid for use.| + +Note that the Oberon approach results naturally in files not being visible to other processes until the writer has written a complete set of data. + +On other systems one common workaround is to write to a temporary file, and then rename it to it's public name, taking care of course to create the temporary file on the same device/partition where it will be published. + +Another workaround is to use file locking to keep the file inaccessible until the full set of data is written, of course taking care to avoid deadlocks. + + +### More on the Vishap Oberon emulation of Oberon system file access. + +Emulation of Oberon system behaviour is part of the Vishap Oberon run time system linked into each program. When multiple Oberon programs are running there are necessarily multiple run time systems running. + +#### Two programs writing to the same file + +Each run time system provides Oberon like buffer management. For example, each run time system ensures that multiple riders based on the same file share the same file buffers, such that writes to one of the riders are immediately availble to all (suitably positioned) other riders. + +It is a limitation that this parallel read and write behaviour does not work accross multiple porgams. + +#### Deleting and re-registering files + +Each run time system tracks deletes and registers to provide Oberon system behaviour, allowing a file to be registered, deleted, and re-registered as often as desired. (When the file is deleted, the run time system converts it back to a temporary file.) + +It is a limitation that the run time system does not provide full Oberon behaviour when a file is opened that is also in use by another program, or for which there are other hard links. + +#### Details + +|Activity|Behaviour| +|---|---| +|Rider buffering|File decriptors and buffers are not shared between multiple instances of the runtime system, therefore if two separate programs call Files.Old on the same file, writes to a rider in one program will usually not be reflected by reads in another program.
Further if both programs are writing to parts of the file that fall in the same buffer area, data will likely be lost: the second program to flush its buffer will overwrite new data written by the program that flushed first. While this is expected behaviour for most operating systems, it is not Oberon behaviour.| +|Register and Delete|When an Oberon program program calls Files.Delete passing a filename for which there is a Files.File instance, its runtime system renames the file as a temporary file and records that it is unregistered. The file continues to be accessible by all programs that have it open. When the program that deleted it completes it will call unlink, causing the OS to actually remove it once no programs have it open. This much is valid Oberon system behaviour.
However only the runtime system of the program that deleted the file knows that it is now unregistered and can successfully register it again. Run time systems of other running Vishap Oberon programs still think the file is registered and will be unable to Register it themselves.| \ No newline at end of file diff --git a/doc/Installation.md b/doc/Installation.md index 37840f74..d9ad75cd 100644 --- a/doc/Installation.md +++ b/doc/Installation.md @@ -54,7 +54,8 @@ Example pre-requisite installation commands: | --------- | ------------ | | Debian/Ubuntu/Mint ... | `apt-get install git` | | Fedora/RHEL/CentOS ... | `yum install git gcc glibc-static` (`dnf` instead of `yum` on recent Fedoras) | -| FreeBSD/OpenBSD/NetBSD | `pkg install git` | +| FreeBSD/NetBSD | `pkg install git` | +| OpenBSD | `pkg_add git gcc` | | OpenSUSE | `zypper install gcc git-core make glibc-devel-static` | On Mac OS (Darwin) just type the git command. OS/X will tell you that it is not installed and ask if you want to install it (say yes). Note that Darwin builds always use clang, the OS will redirect attempts to use gcc to clang. @@ -77,11 +78,11 @@ This will create a subdirectory 'voc' which includes the following files and dir | make.cmd | Makefile specifically for native Microsoft C builds. No tests. | -#### 3. Build and install the Oberon compiler and library +#### 3. Build the Oberon compiler and library ``` cd voc -[sudo] make full +make full ``` The makefile will: diff --git a/doc/ctags.md b/doc/ctags.md new file mode 100644 index 00000000..d6e8a40d --- /dev/null +++ b/doc/ctags.md @@ -0,0 +1,82 @@ +## Code navigation with ctags + +[`ctags`](https://github.com/universal-ctags/ctags) is a tool that creates an index file for names in various programming langauges, which helps code comprehension by giving information to text editors to search, locate, and interactively suggest names, identifiers, symbols etc. Particularly for Oberon, the `oberon.ctags` file, located in the project root, contains definitions for Oberon modules and procedures (but not receiver procedures). + +Below you can find installation instructions and usage examples for `ctags` to navigate Oberon source code, in particular, using the universal tags implementation (not tested with other implementations), with `vim` (you can find or add guides for your text editor). + +## Install universal tags + +#### Use your package manager + +`pacman -S ctags` (arch linux) +`apt install universal-ctags` (debian, ubuntu) +`brew install universal-ctags` (macOS) +... + +#### Compile from source + +`git clone https://github.com/universal-ctags/ctags.git` +follow [build instructions](https://github.com/universal-ctags/ctags/blob/master/README.md#how-to-build-and-install) + +## Using ctags with vim and Oberon + +the following instructions are for POSIX systems, but can be easily adapted to other systems + +#### Configuration + +First, generate tags in project root +`make tags` + +When you add or change names in source files, you have to regenerate the `tags` file. That can be done by running `make tags` again. Optionally, use a `vim` plugin such as [vim-gutentags](https://github.com/ludovicchabant/vim-gutentags) to automate this process. Install it (or skip this step): + +`git clone https://github.com/ludovicchabant/vim-gutentags ~/.vim/plugin/` + +or wherever your vim global plugin directory is specified in `:h plugin`. + +Add this to your `~/.vimrc` +``` +" search upwards for tags file until home directory +set tags=./tags;~ +" qualified name metadata for plugin +let g:gutentags_ctags_extra_args = ['--extras=+q'] +``` + +To use `oberon.ctags` with a plugin or for Oberon language detection outside its directory: +`cp oberon.ctags ~/.config/ctags/` +or +`cp oberon.ctags $XDG_CONFIG_HOME/ctags/` + +#### Usage examples + +tags documentation is in vim +`:h tags` + +some examples: +``` +vim -t "Compiler" +vim -t "OPS.Get" +vim -c ":ts Platform.Read" +vim -c ":ta BrowserCmd.ShowDef" +``` + +Inside vim when you have cursor on the first letter `M` of `Module.Procedure`, do this to jump to procedure definition: +`v 3e ` *(visually select the fully qualified name)* +module definition: +`` +To come back: +`` + +Putting cursor on `P` of `Module.Procedure` is not guaranteed to resolve correctly to the correct module, so choose the fully qualified name. This is a [known limitation](https://docs.ctags.io/en/latest/man/ctags-faq.7.html#how-do-i-jump-to-the-tag-i-want-instead-of-the-wrong-one-by-the-same-name) of `ctags` (any suggestions for handling this better are welcome). + +To address this, you can visually select as in the above examples, or resolve ambiguities interactively: +`g ` +`:ts Write` +`:ts Platform.Write` +or make vim see the qualified name as a complete keyword: +`iskeyword+=.` +in `.vimrc` +`autocmd FileType oberon,modula2 setlocal iskeyword+=.` + +**TODO** +There is some auto-completion, but it doesn't work well. One idea is to define a custom `omnifunc` that suggests only exported symbols (`*`) from a file (module scope is file), so that when you type `OPS.` and press `` you can have useful suggestions (similar to `showdef`). + diff --git a/make.cmd b/make.cmd index 6eb498e5..a47b97f0 100644 --- a/make.cmd +++ b/make.cmd @@ -1,26 +1,30 @@ @echo off -:: mscmake.cmd - Build Oberon with Microsoft C compiler. +:: make.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 +:: As of December 2016 the Microsoft 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/ +:: See: http://landinghub.visualstudio.com/visual-cpp-build-tools :: With this installed, from the start button select: -:: All Apps / Visual C++ Build Tools / Visual C++ x86 Native Build Tools Command Prompt +:: All Apps / Visual C++ Build Tools / Visual C++ 2015 x86 Native Build Tools Command Prompt +:: or All Apps / Visual C++ Build Tools / Visual C++ 2015 x64 Native Build Tools Command Prompt + + :: Create configuration and parameter files. -cl -nologo -Isrc\runtime src\tools\make\configure.c >nul +cl -nologo -Isrc\runtime src\tools\make\configure.c >msc-listing || type msc-listing setlocal -configure.exe >nul +configure.exe 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 @@ -33,7 +37,6 @@ set MODEL=2 for /F %%d in ('cd');do set ROOTDIR=%%d - :: Process target parameter if "%1" equ "" ( @@ -51,30 +54,98 @@ goto :eof @echo. @echo Usage: @echo. -@echo. make full - Make and install compiler (from administrator prompt) +@echo. make full - Make compiler to 'install' subdirectory +@echo. make install - Install 'install' subdir to OS. Requires administrator privileges @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) +@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 +echo. +echo.--- Compiler build started --- +echo. +call :compiler || exit /b +echo. +echo.--- Compiler build successfull --- +echo. +call :browsercmd || exit /b +echo. +echo.--- Library build started --- +echo. +call :library || exit /b +echo. +echo.--- Library build successfull --- +echo. +call :makeinstalldir || exit /b +goto :eof + + + + +:makeinstalldir +rmdir /s /q "%ROOTDIR%\install" >nul 2>&1 +mkdir "%ROOTDIR%\install" >nul 2>&1 + +mkdir "%ROOTDIR%\install\bin" >nul 2>&1 +copy %OBECOMP% "%ROOTDIR%\install\bin" >nul +copy %BUILDDIR%\showdef.exe "%ROOTDIR%\install\bin" >nul + +mkdir "%ROOTDIR%\install\2" >nul 2>&1 +mkdir "%ROOTDIR%\install\2\include" >nul 2>&1 +mkdir "%ROOTDIR%\install\2\sym" >nul 2>&1 +copy %BUILDDIR%\2\*.h "%ROOTDIR%\install\2\include" >nul +copy %BUILDDIR%\2\*.sym "%ROOTDIR%\install\2\sym" >nul + +mkdir "%ROOTDIR%\install\C" >nul 2>&1 +mkdir "%ROOTDIR%\install\C\include" >nul 2>&1 +mkdir "%ROOTDIR%\install\C\sym" >nul 2>&1 +copy %BUILDDIR%\C\*.h "%ROOTDIR%\install\C\include" >nul +copy %BUILDDIR%\C\*.sym "%ROOTDIR%\install\C\sym" >nul + +mkdir "%ROOTDIR%\install\lib" >nul 2>&1 +copy %BUILDDIR%\2\lib%ONAME%* "%ROOTDIR%\install\lib" >nul +copy %BUILDDIR%\C\lib%ONAME%* "%ROOTDIR%\install\lib" >nul + +echo. +echo Now add %ROOTDIR%\install\bin to your path, for example with the command: +echo PATH %ROOTDIR%\install\bin;%%PATH%% +echo. +goto :eof + + + +:install whoami /groups | find "12288" >nul if errorlevel 1 ( -echo make full - administrator rights required. Please run under an administrator command prompt. +echo make install - administrator rights required. Please run under an administrator command prompt. goto :eof ) -call :uninstall || exit /b -call :clean || exit /b -call :compiler || exit /b -call :browsercmd || exit /b -call :library || exit /b -call :install || exit /b -call :showpath || exit /b +echo Installing to %INSTALLDIR% +rmdir /s /q "%INSTALLDIR%" >nul 2>&1 +xcopy /E /I /Y "%ROOTDIR%\install" "%INSTALLDIR%" >nul +echo. +echo Now add %INSTALLDIR%\bin to your path, for example with the command: +echo PATH %INSTALLDIR%\bin;%%PATH%% +echo. +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 +) +echo Uninstalling %INSTALLDIR% +rmdir /s /q "%INSTALLDIR%" >nul 2>&1 goto :eof @@ -89,6 +160,7 @@ goto :eof :clean +echo.--- Cleaning branch ... %OS% %COMPILER% %DATAMODEL% --- rd /s /q %BUILDDIR% 2>nul del /q %OBECOMP% 2>nul goto :eof @@ -101,37 +173,38 @@ 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. PLATFORM: %PLATFORM% +echo. OS: %OS% +echo. BUILDDIR: %BUILDDIR% +echo. INSTALLDIR: %INSTALLDIR% echo. Oberon characteristics: -echo. MODEL: %MODEL% -echo. ADRSIZE: %ADRSIZE% -echo. ALIGNMENT: %ALIGNMENT% +echo. MODEL: %MODEL% +echo. ADRSIZE: %ADRSIZE% +echo. ALIGNMENT: %ALIGNMENT% echo. C compiler: -echo. COMPILER: %COMPILER% -echo. COMPILE: %COMPILE% -echo. DATAMODEL: %DATAMODEL% +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 Out.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 -c SYSTEM.c Configuration.c Platform.c Heap.c || exit /b +cl -nologo /Zi -c Out.c Reals.c Strings.c Modules.c || exit /b +cl -nologo /Zi -c Files.c Texts.c VT100.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 Compiler.c /Fe%ROOTDIR%\%OBECOMP% /link /INCREMENTAL:NO ^ -SYSTEM.obj Configuration.obj Platform.obj Heap.obj ^ -Out.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 +SYSTEM.obj Configuration.obj Platform.obj Heap.obj Out.obj Reals.obj ^ +Modules.obj Files.obj Strings.obj Texts.obj VT100.obj extTools.obj ^ +OPM.obj OPS.obj OPT.obj OPC.obj OPV.obj OPB.obj OPP.obj || exit /b +cd %ROOTDIR% copy src\runtime\*.c %BUILDDIR% >nul copy src\runtime\*.h %BUILDDIR% >nul +copy src\runtime\*.Txt %BUILDDIR% >nul +copy src\runtime\*.Txt %ROOTDIR% >nul echo.%OBECOMP% created. -cd %ROOTDIR% goto :eof @@ -169,14 +242,13 @@ del *.sym >nul 2>nul %ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../Configuration.Mod || exit /b %ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/runtime/Platform%PLATFORM%.Mod || exit /b %ROOTDIR%\%OBECOMP% -SsfFapx -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/runtime/Heap.Mod || exit /b +%ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/runtime/Reals.Mod || exit /b %ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/runtime/Strings.Mod || exit /b %ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/runtime/Out.Mod || exit /b %ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/runtime/Modules.Mod || exit /b %ROOTDIR%\%OBECOMP% -SsfFx -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/runtime/Files.Mod || exit /b -%ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/runtime/Reals.Mod || exit /b %ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/runtime/Texts.Mod || exit /b %ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/runtime/VT100.Mod || exit /b -%ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/compiler/errors.Mod || exit /b %ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/compiler/OPM.Mod || exit /b %ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/compiler/extTools.Mod || exit /b %ROOTDIR%\%OBECOMP% -SsfFx -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/compiler/OPS.Mod || exit /b @@ -186,7 +258,12 @@ del *.sym >nul 2>nul %ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/compiler/OPB.Mod || exit /b %ROOTDIR%\%OBECOMP% -SsfF -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/compiler/OPP.Mod || exit /b %ROOTDIR%\%OBECOMP% -Ssfm -A%ADRSIZE%%ALIGNMENT% -O%MODEL% ../../src/compiler/Compiler.Mod || exit /b + cd %ROOTDIR% +copy src\runtime\*.c %BUILDDIR% >nul +copy src\runtime\*.h %BUILDDIR% >nul +copy src\runtime\*.Txt %BUILDDIR% >nul + echo.%BUILDDIR% filled with compiler C source. goto :eof @@ -197,10 +274,11 @@ goto :eof echo. echo.Making symbol browser cd %BUILDDIR% +%ROOTDIR%/%OBECOMP% -fSs ../../src/runtime/Oberon.Mod %ROOTDIR%/%OBECOMP% -fSm ../../src/tools/browser/BrowserCmd.Mod -cl -nologo BrowserCmd.c /Feshowdef.exe ^ +cl -nologo BrowserCmd.c Oberon.c /Feshowdef.exe ^ Platform.obj Texts.obj OPT.obj Heap.obj Out.obj SYSTEM.obj OPM.obj OPS.obj OPV.obj ^ - Files.obj Reals.obj Modules.obj VT100.obj errors.obj Configuration.obj Strings.obj ^ + Files.obj Reals.obj Modules.obj VT100.obj Configuration.obj Strings.obj ^ OPC.obj cd %ROOTDIR% goto :eof @@ -208,55 +286,6 @@ 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 -copy %OBECOMP% "%INSTALLDIR%\bin" >nul -copy %BUILDDIR%\showdef.exe "%INSTALLDIR%\bin" >nul - -mkdir "%INSTALLDIR%\2" >nul 2>&1 -mkdir "%INSTALLDIR%\2\include" >nul 2>&1 -mkdir "%INSTALLDIR%\2\sym" >nul 2>&1 -copy %BUILDDIR%\2\*.h "%INSTALLDIR%\2\include" >nul -copy %BUILDDIR%\2\*.sym "%INSTALLDIR%\2\sym" >nul - -mkdir "%INSTALLDIR%\C" >nul 2>&1 -mkdir "%INSTALLDIR%\C\include" >nul 2>&1 -mkdir "%INSTALLDIR%\C\sym" >nul 2>&1 -copy %BUILDDIR%\C\*.h "%INSTALLDIR%\C\include" >nul -copy %BUILDDIR%\C\*.sym "%INSTALLDIR%\C\sym" >nul - -mkdir "%INSTALLDIR%\lib" >nul 2>&1 -copy %BUILDDIR%\2\lib%ONAME%* "%INSTALLDIR%\lib" >nul -copy %BUILDDIR%\C\lib%ONAME%* "%INSTALLDIR%\lib" >nul -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 - - -:showpath -echo. -echo Now add %INSTALLDIR%\bin to your path, for example with the command: -echo PATH %INSTALLDIR%\bin;%%PATH%% -echo. -goto :eof - - :runtime echo. echo.Making runtime library for -O%MODEL% @@ -264,6 +293,7 @@ cd %BUILDDIR%\%MODEL% %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/Platform%PLATFORM%.Mod %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/Heap.Mod %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/Modules.Mod +%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/Reals.Mod %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/Strings.Mod %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/Out.Mod %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/In.Mod @@ -271,7 +301,6 @@ cd %BUILDDIR%\%MODEL% %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/Files.Mod %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/Math.Mod %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/MathL.Mod -%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/Reals.Mod %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/Texts.Mod %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/runtime/Oberon.Mod cd %ROOTDIR% @@ -346,6 +375,7 @@ goto :eof :ulm echo.Making ulm library for -O%MODEL% cd %BUILDDIR%\%MODEL% +%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmTypes.Mod || exit /b %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmObjects.Mod || exit /b %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmPriorities.Mod || exit /b %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmDisciplines.Mod || exit /b @@ -357,7 +387,6 @@ cd %BUILDDIR%\%MODEL% %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmResources.Mod || exit /b %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmForwarders.Mod || exit /b %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmRelatedEvents.Mod || exit /b -%ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmTypes.Mod || exit /b %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmStreams.Mod || exit /b %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmStrings.Mod || exit /b %ROOTDIR%\%OBECOMP% -Ffs -O%MODEL% ../../../src/library/ulm/ulmSysTypes.Mod || exit /b diff --git a/makefile b/makefile index 8186e175..08b69845 100644 --- a/makefile +++ b/makefile @@ -19,6 +19,7 @@ # # clang # gcc +# tcc # i686-w64-mingw32-gcc (32 bit cygwin only) # x86_64-w64-mingw32-gcc (64 bit cygwin only) # @@ -81,6 +82,8 @@ usage: @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 O2library - Build all library files with Oberon-2 type sizes" + @echo " make OClibrary - Build all library files with Component Pascal type sizes" @echo " make install - Install built compiler and library in /opt or C:\\PROGRAM FILES*" @echo " (Needs root access)" @echo "" @@ -88,8 +91,11 @@ usage: @echo " make bootstrap - Update bootstrap C source directories." @echo " make revertbootstrap - Use git checkout to restore bootstrap C source directories" - - +# Code navigation helper +# doc/ctags.md +.PHONY: tags +tags: + ctags -R --options=oberon.ctags --extras=+q # Generate config files Configuration.Make and Configuration.Mod FORCE: diff --git a/oberon.ctags b/oberon.ctags new file mode 100644 index 00000000..f0ef512f --- /dev/null +++ b/oberon.ctags @@ -0,0 +1,14 @@ +# universal tags +# ctags -R --options=oberon.ctags --extras=+q + +--langdef=Oberon{_autoFQTag} + +--map-Oberon=+.mod +--map-Oberon=+.Mod + +--kinddef-Oberon=m,module,modules +--kinddef-Oberon=p,procedure,procedures + +--regex-Oberon=/^\s*MODULE\s+([a-zA-Z][a-zA-Z0-9]*)\s*;/\1/m/{scope=push} +--regex-Oberon=/^\s*PROCEDURE\s*(\^|-)?\s*([a-zA-Z][a-zA-Z0-9]*)/\2/p/{scope=ref} + diff --git a/src/compiler/Compiler.Mod b/src/compiler/Compiler.Mod old mode 100644 new mode 100755 index 6148fea2..5855a008 --- a/src/compiler/Compiler.Mod +++ b/src/compiler/Compiler.Mod @@ -66,7 +66,7 @@ MODULE Compiler; (* J. Templ 3.2.95 *) OPT.intobj.typ := OPT.inttyp; OPT.lintobj.typ := OPT.linttyp; - CASE OPM.LongintSize OF + CASE OPM.SetSize OF |4: OPT.settyp := OPT.set32typ ELSE OPT.settyp := OPT.set64typ END; diff --git a/src/compiler/OPB.Mod b/src/compiler/OPB.Mod index 84085804..3ff7fffc 100644 --- a/src/compiler/OPB.Mod +++ b/src/compiler/OPB.Mod @@ -1,5 +1,5 @@ +(* Oberon Portable build parse tree (front end) *) MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) -(* build parse tree *) IMPORT OPT, OPS, OPM, SYSTEM; @@ -893,6 +893,25 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) IF x = y THEN (* ok *) ELSIF (y.comp = OPT.Array) & (y.BaseTyp = x.BaseTyp) & (y.n <= x.n) THEN (* OK by Oberon-07/2013 *) ELSIF (y.comp = OPT.DynArr) & (y.BaseTyp = x.BaseTyp) THEN (* OK by Oberon-07/2013, length tested at runtime *) + err(113) + (* if no error issued the compiler will crash later + in OPC.CompleteIdent because NIL will be passed to it + from OPC.Len + which is called from OPV.stat + OPV.stat gets n: OPT.node + where both n^.left.obj and n^.right.obj are NIL. + n^.right.obj is then passed to OPC.Len + + at this point, in this ELSIF body + x^.comp = OPT.Array + x^.strobj.name= + y^.strobj is NIL already! + + it's interesting that OPT.InStruct functions + Sarr case is entered, but not Sdarr + + issuing error for now to eliminate compiler crash. + *) ELSIF x^.BaseTyp = OPT.chartyp THEN (* Assign to (static) ARRAY OF CHAR *) IF g = OPT.String THEN (*check length of string*) IF ynode^.conval^.intval2 > x^.n THEN err(114) END diff --git a/src/compiler/OPC.Mod b/src/compiler/OPC.Mod index 376ba412..80e6bd66 100644 --- a/src/compiler/OPC.Mod +++ b/src/compiler/OPC.Mod @@ -409,22 +409,24 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) BEGIN IF obj # NIL THEN DefineTProcMacros(obj^.left, empty); - IF (obj^.mode = OPT.TProc) & (obj = BaseTProc(obj)) & ((OPM.currFile # OPM.HeaderFile) OR (obj^.vis = OPT.external)) THEN - OPM.WriteString("#define __"); - Ident(obj); - DeclareParams(obj^.link, TRUE); - OPM.WriteString(" __SEND("); - IF obj^.link^.typ^.form = OPT.Pointer THEN - OPM.WriteString("__TYPEOF("); Ident(obj^.link); OPM.Write(")") - ELSE Ident(obj^.link); OPM.WriteString(TagExt) - END ; - Str1(", #, ", obj^.adr DIV 10000H); - IF obj^.typ = OPT.notyp THEN OPM.WriteString('void') ELSE Ident(obj^.typ^.strobj) END ; - OPM.WriteString("(*)"); - AnsiParamList(obj^.link, FALSE); - OPM.WriteString(", "); - DeclareParams(obj^.link, TRUE); - OPM.Write(")"); OPM.WriteLn + IF (obj^.mode = OPT.TProc) & (obj = BaseTProc(obj)) THEN + IF (OPM.currFile = OPM.BodyFile) OR ((OPM.currFile = OPM.HeaderFile) & (obj^.vis = OPT.external)) THEN + OPM.WriteString("#define __"); + Ident(obj); + DeclareParams(obj^.link, TRUE); + OPM.WriteString(" __SEND("); + IF obj^.link^.typ^.form = OPT.Pointer THEN + OPM.WriteString("__TYPEOF("); Ident(obj^.link); OPM.Write(")") + ELSE Ident(obj^.link); OPM.WriteString(TagExt) + END ; + Str1(", #, ", obj^.adr DIV 10000H); + IF obj^.typ = OPT.notyp THEN OPM.WriteString('void') ELSE Ident(obj^.typ^.strobj) END ; + OPM.WriteString("(*)"); + AnsiParamList(obj^.link, FALSE); + OPM.WriteString(", "); + DeclareParams(obj^.link, TRUE); + OPM.Write(")"); OPM.WriteLn + END END ; DefineTProcMacros(obj^.right, empty) END @@ -433,7 +435,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) PROCEDURE DefineType(str: OPT.Struct); (* define a type object *) VAR obj, field, par: OPT.Object; empty: BOOLEAN; BEGIN - IF (OPM.currFile = OPM.BodyFile) OR (str^.ref < OPM.MaxStruct (*for hidden exports*) ) THEN + IF (OPM.currFile = OPM.BodyFile) OR (str^.ref < OPM.MaxStruct (*for hidden exports*) ) OR ((OPM.currFile = OPM.HeaderFile) & (str^.strobj # NIL) & (str^.strobj^.vis = OPT.external)) THEN obj := str^.strobj; IF (obj = NIL) OR Undefined(obj) THEN IF obj # NIL THEN (* check for cycles *) @@ -453,6 +455,9 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) ELSIF str^.form = OPT.Pointer THEN IF str^.BaseTyp^.comp # OPT.Record THEN DefineType(str^.BaseTyp) END ELSIF str^.comp IN {OPT.Array, OPT.DynArr} THEN + IF (str^.BaseTyp^.strobj # NIL) & (str^.BaseTyp^.strobj^.linkadr = ProcessingType) THEN (*cyclic base type*) + OPM.Mark(244, str^ .txtpos); str^.BaseTyp^.strobj^.linkadr := PredefinedType + END ; DefineType(str^.BaseTyp) ELSIF str^.form = OPT.ProcTyp THEN IF str^.BaseTyp # OPT.notyp THEN DefineType(str^.BaseTyp) END ; @@ -472,6 +477,11 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) IF obj^.typ^.comp = OPT.Record THEN empty := TRUE; DeclareTProcs(str^.link, empty); DefineTProcMacros(str^.link, empty); IF ~empty THEN OPM.WriteLn END + ELSIF (obj^.typ^.form = OPT.Pointer) & (obj^.typ^.BaseTyp^.comp = OPT.Record) THEN + empty := TRUE; + DeclareTProcs(obj^.typ^.BaseTyp^.link, empty); + DefineTProcMacros(obj^.typ^.BaseTyp^.link, empty); + IF ~empty THEN OPM.WriteLn END END END END @@ -1212,12 +1222,15 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) END IntLiteral; PROCEDURE Len* (obj: OPT.Object; array: OPT.Struct; dim: SYSTEM.INT64); + VAR + d: SYSTEM.INT64; BEGIN + d := dim; + WHILE d > 0 DO array := array^.BaseTyp; DEC(d) END; IF array^.comp = OPT.DynArr THEN CompleteIdent(obj); OPM.WriteString(LenExt); IF dim # 0 THEN OPM.WriteInt(dim) END ELSE (* array *) - WHILE dim > 0 DO array := array^.BaseTyp; DEC(dim) END; OPM.WriteInt(array.n) END END Len; diff --git a/src/compiler/OPM.Mod b/src/compiler/OPM.Mod old mode 100644 new mode 100755 index 85392b15..ab3d7dae --- a/src/compiler/OPM.Mod +++ b/src/compiler/OPM.Mod @@ -8,6 +8,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) CONST OptionChar* = "-"; + MaxCommentLen* = 1024; (* compiler option flag bits; don't change the encoding *) inxchk* = 0; (* index check on *) @@ -76,15 +77,16 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) BFext = ".c"; (* body file extension *) HFext = ".h"; (* header file extension *) SFtag = 0F7X; (* symbol file tag *) - SFver = 083X; (* symbol file version. Increment if symbol file format is changed. *) - - + SFver = 084X; (* symbol file version. Increment if symbol file format is changed. *) TYPE FileName = ARRAY 32 OF CHAR; VAR + currentComment: ARRAY MaxCommentLen OF CHAR; + hasComment: BOOLEAN; + SourceFileName : ARRAY 256 OF CHAR; GlobalModel, Model*: ARRAY 10 OF CHAR; (* 2: S8/I16/L32, C: S16/I32/L64, V:S8/I32/L64 *) @@ -92,7 +94,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) GlobalAlignment, Alignment*: INTEGER; GlobalOptions*, Options*: SET; - ShortintSize*, IntegerSize*, LongintSize*: INTEGER; + ShortintSize*, IntegerSize*, LongintSize*, SetSize*: INTEGER; MaxIndex*: SYSTEM.INT64; @@ -150,6 +152,33 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) LogW("."); END LogCompiling; + (* for exported comments *) + PROCEDURE StoreComment*(text: ARRAY OF CHAR); + VAR i: INTEGER; + BEGIN + i := 0; + WHILE (i < MaxCommentLen - 1) & (text[i] # 0X) DO + currentComment[i] := text[i]; INC(i) + END; + currentComment[i] := 0X; + hasComment := TRUE; + END StoreComment; + + PROCEDURE GetComment*(VAR text: ARRAY OF CHAR); + VAR i: INTEGER; + BEGIN + IF hasComment THEN + i := 0; + WHILE (i < LEN(text)) & (i < MaxCommentLen) & (currentComment[i] # 0X) DO + text[i] := currentComment[i]; INC(i) + END; + text[i] := 0X; + hasComment := FALSE + ELSE + text[0] := 0X + END; + END GetComment; + (* Integer size support *) @@ -273,7 +302,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) LogWLn; LogWStr(" Size model for elementary types (default O2)"); LogWLn; LogWStr(" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET."); LogWLn; - LogWStr(" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET."); LogWLn; + LogWStr(" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER and SET, 64 bit LONGINT."); LogWLn; LogWStr(" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET."); LogWLn; LogWLn; LogWStr(" Target machine address size and alignment (default is that of the running compiler binary)"); LogWLn; @@ -328,10 +357,10 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) MaxIndex := SignedMaximum(AddressSize); CASE Model[0] OF - |'2': ShortintSize := 1; IntegerSize := 2; LongintSize := 4 - |'C': ShortintSize := 2; IntegerSize := 4; LongintSize := 8 - |'V': ShortintSize := 1; IntegerSize := 4; LongintSize := 8 - ELSE ShortintSize := 1; IntegerSize := 2; LongintSize := 4 + |'2': ShortintSize := 1; IntegerSize := 2; LongintSize := 4; SetSize := 4; + |'C': ShortintSize := 2; IntegerSize := 4; LongintSize := 8; SetSize := 4; + |'V': ShortintSize := 1; IntegerSize := 4; LongintSize := 8; SetSize := 8; + ELSE ShortintSize := 1; IntegerSize := 2; LongintSize := 4; SetSize := 4; END; (*IF verbose IN Options THEN VerboseListSizes END;*) @@ -830,4 +859,7 @@ BEGIN MinReal := -MaxReal; MinLReal := -MaxLReal; FindInstallDir; + + hasComment := FALSE; + currentComment[0] := 0X; END OPM. diff --git a/src/compiler/OPP.Mod b/src/compiler/OPP.Mod index 2b9fb0b1..96117cad 100644 --- a/src/compiler/OPP.Mod +++ b/src/compiler/OPP.Mod @@ -1,3 +1,4 @@ +(* OPP - Oberon Portable Parser (front end) *) MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) IMPORT diff --git a/src/compiler/OPS.Mod b/src/compiler/OPS.Mod index 909cdee2..f81bcae6 100644 --- a/src/compiler/OPS.Mod +++ b/src/compiler/OPS.Mod @@ -1,9 +1,10 @@ +(* Oberon Portable Scanner (front end) *) MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *) IMPORT OPM, SYSTEM; CONST - MaxStrLen* = 256; + MaxStrLen* = 1024; MaxIdLen = 256; @@ -189,22 +190,99 @@ MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *) PROCEDURE Get*(VAR sym: SHORTINT); VAR s: SHORTINT; - PROCEDURE Comment; (* do not read after end of file *) - BEGIN OPM.Get(ch); - LOOP - LOOP - WHILE ch = "(" DO OPM.Get(ch); - IF ch = "*" THEN Comment END - END ; - IF ch = "*" THEN OPM.Get(ch); EXIT END ; - IF ch = OPM.Eot THEN EXIT END ; + PROCEDURE Comment; + VAR + isExported: BOOLEAN; + commentText: ARRAY OPM.MaxCommentLen OF CHAR; + i: INTEGER; + nestLevel: INTEGER; + prevCh: CHAR; + BEGIN + FOR i := 0 TO LEN(commentText) - 1 DO + commentText[i] := 0X + END; + + isExported := FALSE; + i := 0; + nestLevel := 1; + prevCh := 0X; + + OPM.Get(ch); + + IF ch = "*" THEN + isExported := TRUE; + OPM.Get(ch); + IF ch = ")" THEN + (* Empty exported comment (**), handle and return *) + commentText[0] := 0X; + OPM.StoreComment(commentText); + OPM.Get(ch); (* consume character after closing comment *) + RETURN + END + END; + + WHILE (nestLevel > 0) & (ch # OPM.Eot) DO + IF (prevCh = "(") & (ch = "*") THEN + INC(nestLevel); + prevCh := ch; (* Don't set to 0X - keep the '*' *) OPM.Get(ch) - END ; - IF ch = ")" THEN OPM.Get(ch); EXIT END ; - IF ch = OPM.Eot THEN err(5); EXIT END - END + ELSIF (prevCh = "*") & (ch = ")") THEN + DEC(nestLevel); + IF nestLevel = 0 THEN + OPM.Get(ch); (* move past ')' *) + ELSE + prevCh := ch; (* Keep the ')' *) + OPM.Get(ch) + END + ELSE + IF isExported & (nestLevel = 1) THEN + IF i < OPM.MaxCommentLen - 1 THEN + (* Handle all characters including newlines *) + IF (ch = 0DX) OR (ch = 0AX) THEN + (* Add newline if buffer is empty or last char isn't already a newline *) + IF (i = 0) OR (commentText[i-1] # 0AX) THEN + commentText[i] := 0AX; INC(i) + END; + (* Handle CRLF by skipping the LF if we just saw CR *) + IF (ch = 0DX) THEN + prevCh := ch; OPM.Get(ch); + IF ch = 0AX THEN + prevCh := ch; OPM.Get(ch) + END + ELSE + prevCh := ch; OPM.Get(ch) + END + ELSIF ch >= " " THEN + commentText[i] := ch; INC(i); + prevCh := ch; OPM.Get(ch) + ELSE + (* Skip control characters *) + prevCh := ch; OPM.Get(ch) + END + ELSE + prevCh := ch; OPM.Get(ch) + END + ELSE + prevCh := ch; OPM.Get(ch) + END + END + END; + + IF ch = OPM.Eot THEN + err(5) + END; + + IF isExported THEN + IF i >= OPM.MaxCommentLen THEN + OPM.LogWStr("Warning: commentText overflow"); OPM.LogWLn; + i := OPM.MaxCommentLen - 1 + END; + commentText[i] := 0X; + OPM.StoreComment(commentText) + END; END Comment; + BEGIN OPM.errpos := OPM.curpos-1; WHILE ch <= " " DO (*ignore control characters*) diff --git a/src/compiler/OPT.Mod b/src/compiler/OPT.Mod index 2641703e..228a8226 100644 --- a/src/compiler/OPT.Mod +++ b/src/compiler/OPT.Mod @@ -1,3 +1,4 @@ +(* OPT - Oberon Portable Symbol Table (front end) *) MODULE OPT; (* NW, RC 6.3.89 / 23.1.92 *) (* object model 24.2.94 *) (* @@ -45,7 +46,8 @@ TYPE typ*: Struct; conval*: Const; adr*, linkadr*: LONGINT; - x*: INTEGER (* linkadr and x can be freely used by the backend *) + x*: INTEGER; (* linkadr and x can be freely used by the backend *) + comment*: ConstExt; END; CONST @@ -177,6 +179,7 @@ CONST Shdptr* = 27; Shdpro* = 28; Stpro* = 29; Shdtpro* = 30; Sxpro* = 31; Sipro* = 32; Scpro* = 33; Sstruct* = 34; Ssys* = 35; Sptr* = 36; Sarr* = 37; Sdarr* = 38; Srec* = 39; Spro* = 40; Slink* = 37; + Scomment* = 41; TYPE ImpCtxt = RECORD @@ -366,7 +369,15 @@ END NewConst; PROCEDURE NewObj*(): Object; VAR obj: Object; -BEGIN NEW(obj); RETURN obj +BEGIN + NEW(obj); + (* lets fully init pointers *) + obj^.typ := NIL; + obj^.conval := NIL; + obj^.comment := NIL; + obj^.name := ""; + + RETURN obj END NewObj; PROCEDURE NewStr*(form, comp: SHORTINT): Struct; @@ -467,8 +478,16 @@ BEGIN END FindField; PROCEDURE Insert*(VAR name: OPS.Name; VAR obj: Object); - VAR ob0, ob1: Object; left: BOOLEAN; mnolev: SHORTINT; -BEGIN ob0 := topScope; ob1 := ob0^.right; left := FALSE; +VAR + ob0, ob1: Object; + left: BOOLEAN; + mnolev: SHORTINT; + commentText: ARRAY OPM.MaxCommentLen OF CHAR; + j: INTEGER; +BEGIN + ob0 := topScope; + ob1 := ob0^.right; + left := FALSE; LOOP IF ob1 # NIL THEN IF name < ob1^.name THEN ob0 := ob1; ob1 := ob0^.left; left := TRUE @@ -479,13 +498,24 @@ BEGIN ob0 := topScope; ob1 := ob0^.right; left := FALSE; IF left THEN ob0^.left := ob1 ELSE ob0^.right := ob1 END; ob1^.left := NIL; ob1^.right := NIL; COPY(name, ob1^.name); mnolev := topScope^.mnolev; ob1^.mnolev := mnolev; + (* Attach pending comment *) + OPM.GetComment(commentText); + IF commentText[0] # 0X THEN + NEW(ob1^.comment); + (*COPY(commentText, ob1^.comment^);*) + j := 0; + WHILE (j < OPM.MaxCommentLen - 1) & (commentText[j] # 0X) DO + ob1^.comment^[j] := commentText[j]; + INC(j) + END; + ob1^.comment^[j] := 0X; + END; EXIT END END; obj := ob1 END Insert; - (*-------------------------- Fingerprinting --------------------------*) (* Fingerprints prevent structural type equivalence. *) @@ -781,6 +811,7 @@ BEGIN conval^.intval := OPM.ConstNotAlloc | NilTyp: conval^.intval := OPM.nilval ELSE OPM.LogWStr("unhandled case in InConstant(), f = "); OPM.LogWNum(f, 0); OPM.LogWLn; + OPM.err(155) (* Symbol file corrupted *) END END InConstant; @@ -790,13 +821,25 @@ PROCEDURE InSign(mno: SHORTINT; VAR res: Struct; VAR par: Object); VAR last, new: Object; tag: LONGINT; BEGIN InStruct(res); - tag := OPM.SymRInt(); last := NIL; + tag := OPM.SymRInt(); + last := NIL; WHILE tag # Send DO - new := NewObj(); new^.mnolev := -mno; + + (* Add bounds checking *) + IF (tag < 0) OR (tag > 100) THEN + OPM.LogWStr("ERROR: Invalid tag value in InSign: "); OPM.LogWNum(tag, 0); OPM.LogWLn; + OPM.err(155); (* symbol file corrupted *) + RETURN + END; + + new := NewObj(); + new^.mnolev := -mno; IF last = NIL THEN par := new ELSE last^.link := new END; IF tag = Svalpar THEN new^.mode := Var ELSE new^.mode := VarPar END; - InStruct(new^.typ); new^.adr := OPM.SymRInt(); InName(new^.name); - last := new; tag := OPM.SymRInt() + InStruct(new^.typ); + new^.adr := OPM.SymRInt(); InName(new^.name); + last := new; + tag := OPM.SymRInt(); END END InSign; @@ -972,11 +1015,52 @@ BEGIN END END InStruct; + PROCEDURE InObj(mno: SHORTINT): Object; (* first number in impCtxt.nextTag *) VAR i, s: INTEGER; ch: CHAR; obj, old: Object; typ: Struct; tag: LONGINT; ext: ConstExt; + commentText: ARRAY OPM.MaxCommentLen OF CHAR; + hasComment : BOOLEAN; + j: INTEGER; + len: LONGINT; BEGIN tag := impCtxt.nextTag; + hasComment := FALSE; + + (* checking for comment first, but not processing it yet *) + WHILE tag = Scomment DO (* Handle multiple consecutive comments *) + len := OPM.SymRInt(); (* read length *) + + (* Ensure length is within bounds *) + IF len < 0 THEN len := 0 END; + IF len > OPS.MaxStrLen - 1 THEN len := OPS.MaxStrLen - 1 END; + + i := 0; + WHILE i < len DO + OPM.SymRCh(commentText[i]); INC(i) + END; + commentText[i] := 0X; + hasComment := TRUE; (* Only keep the last comment if there are multiple *) + + tag := OPM.SymRInt(); (* continue stream *) + END; + + (* Now tag should be a valid object tag *) + (*impCtxt.nextTag := tag;*) + + (* Additional validation for constants *) + IF (tag <= Pointer) & (tag = Undef) THEN + OPM.err(155); (* Symbol file error *) + RETURN NIL + END; + + (* Validate tag value *) + IF (tag < 0) OR (tag > 50) THEN + OPM.LogWStr("ERROR: Invalid tag in InObj: "); OPM.LogWNum(tag, 0); OPM.LogWLn; + OPM.err(155); (* Symbol file error *) + RETURN NIL + END; + IF tag = Stype THEN InStruct(typ); obj := typ^.strobj; IF ~impCtxt.self THEN obj^.vis := external END (* type name visible now, obj^.fprint already done *) @@ -985,7 +1069,7 @@ BEGIN IF tag <= Pointer THEN (* Constant *) obj^.mode := Con; obj^.conval := NewConst(); InConstant(tag, obj^.conval); obj^.typ := InTyp(tag) - ELSIF tag >= Sxpro THEN + ELSIF (tag >= Sxpro) & (tag <= Scpro) THEN (* Procedure tags *) obj^.conval := NewConst(); obj^.conval^.intval := -1; InSign(mno, obj^.typ, obj^.link); @@ -997,16 +1081,33 @@ BEGIN s := SHORT(OPM.SymRInt()); ext^[0] := CHR(s); i := 1; WHILE i <= s DO OPM.SymRCh(ext^[i]); INC(i) END ELSE OPM.LogWStr("unhandled case at InObj, tag = "); OPM.LogWNum(tag, 0); OPM.LogWLn; + OPM.err(155); RETURN NIL END ELSIF tag = Salias THEN obj^.mode := Typ; InStruct(obj^.typ) - ELSE + ELSIF (tag = Svar) OR (tag = Srvar) THEN obj^.mode := Var; IF tag = Srvar THEN obj^.vis := externalR END; InStruct(obj^.typ) + ELSE + OPM.LogWStr("ERROR: Unexpected tag in InObj: "); OPM.LogWNum(tag, 0); OPM.LogWLn; + OPM.err(155); (* Symbol file error *) + RETURN NIL END; InName(obj^.name) END; + + (* attaching exported comment after the object was created *) + IF hasComment & (obj # NIL) THEN + NEW(obj^.comment); + j := 0; + WHILE (j < OPM.MaxCommentLen - 1) & (j < len) & (commentText[j] # 0X) DO + obj^.comment^[j] := commentText[j]; + INC(j) + END; + obj^.comment^[j] := 0X; + END; + FPrintObj(obj); IF (obj^.mode = Var) & ((obj^.typ^.strobj = NIL) OR (obj^.typ^.strobj^.name = "")) THEN (* compute a global fingerprint to avoid structural type equivalence for anonymous types *) @@ -1039,6 +1140,8 @@ BEGIN RETURN obj END InObj; + + PROCEDURE Import*(aliasName: OPS.Name; VAR name: OPS.Name; VAR done: BOOLEAN); VAR obj: Object; mno: SHORTINT; (* done used in Browser *) BEGIN @@ -1225,45 +1328,75 @@ END Import; END END OutConstant; - PROCEDURE OutObj(obj: Object); - VAR i, j: INTEGER; ext: ConstExt; - BEGIN - IF obj # NIL THEN - OutObj(obj^.left); - IF obj^.mode IN {Con, Typ, Var, LProc, XProc, CProc, IProc} THEN - IF obj^.history = removed THEN FPrintErr(obj, 250) - ELSIF obj^.vis # internal THEN - CASE obj^.history OF - | inserted: FPrintErr(obj, 253) - | same: (* ok *) - | pbmodified: FPrintErr(obj, 252) - | pvmodified: FPrintErr(obj, 251) - ELSE OPM.LogWStr("unhandled case at OutObj, obj^.history = "); OPM.LogWNum(obj^.history, 0); OPM.LogWLn; - END; - CASE obj^.mode OF - | Con: OutConstant(obj); OutName(obj^.name) - | Typ: IF obj^.typ^.strobj = obj THEN OPM.SymWInt(Stype); OutStr(obj^.typ) - ELSE OPM.SymWInt(Salias); OutStr(obj^.typ); OutName(obj^.name) - END - | Var: IF obj^.vis = externalR THEN OPM.SymWInt(Srvar) ELSE OPM.SymWInt(Svar) END; - OutStr(obj^.typ); OutName(obj^.name); - IF (obj^.typ^.strobj = NIL) OR (obj^.typ^.strobj^.name = "") THEN - (* compute fingerprint to avoid structural type equivalence *) - OPM.FPrint(expCtxt.reffp, obj^.typ^.ref) - END - | XProc: OPM.SymWInt(Sxpro); OutSign(obj^.typ, obj^.link); OutName(obj^.name) - | IProc: OPM.SymWInt(Sipro); OutSign(obj^.typ, obj^.link); OutName(obj^.name) - | CProc: OPM.SymWInt(Scpro); OutSign(obj^.typ, obj^.link); ext := obj^.conval^.ext; - j := ORD(ext^[0]); i := 1; OPM.SymWInt(j); - WHILE i <= j DO OPM.SymWCh(ext^[i]); INC(i) END; - OutName(obj^.name) - ELSE OPM.LogWStr("unhandled case at OutObj, obj.mode = "); OPM.LogWNum(obj.mode, 0); OPM.LogWLn; +PROCEDURE OutTruncatedName(text: ARRAY OF CHAR); +VAR i: INTEGER; +BEGIN + i := 0; + WHILE (i < OPS.MaxStrLen - 1) & (text[i] # 0X) DO + OPM.SymWCh(text[i]); INC(i) + END; + OPM.SymWCh(0X) +END OutTruncatedName; + + +PROCEDURE OutObj(obj: Object); + VAR i, j: INTEGER; ext: ConstExt; + k, l: INTEGER; +BEGIN + IF obj # NIL THEN + OutObj(obj^.left); + IF obj^.mode IN {Con, Typ, Var, LProc, XProc, CProc, IProc} THEN + (* Write comment BEFORE the object *) + IF obj^.comment # NIL THEN + (* Only write comments for objects that make sense *) + IF (obj^.mode IN {Con, Typ, Var, XProc, IProc, CProc}) & (obj^.vis # internal) THEN + OPM.SymWInt(Scomment); + (* Calculate actual length of comment text *) + k := 0; + WHILE (k < OPM.MaxCommentLen - 1) & (obj^.comment^[k] # 0X) DO INC(k) END; + OPM.SymWInt(k); (* length prefix *) + (* Write comment data as individual characters *) + l := 0; + WHILE l < k DO + OPM.SymWCh(obj^.comment^[l]); INC(l) END END + (* If condition is false, we skip the comment entirely *) END; - OutObj(obj^.right) - END - END OutObj; + + IF obj^.history = removed THEN FPrintErr(obj, 250) + ELSIF obj^.vis # internal THEN + CASE obj^.history OF + | inserted: FPrintErr(obj, 253) + | same: (* ok *) + | pbmodified: FPrintErr(obj, 252) + | pvmodified: FPrintErr(obj, 251) + ELSE OPM.LogWStr("unhandled case at OutObj, obj^.history = "); OPM.LogWNum(obj^.history, 0); OPM.LogWLn; + END; + CASE obj^.mode OF + | Con: OutConstant(obj); OutName(obj^.name) + | Typ: IF obj^.typ^.strobj = obj THEN OPM.SymWInt(Stype); OutStr(obj^.typ) + ELSE OPM.SymWInt(Salias); OutStr(obj^.typ); OutName(obj^.name) + END + | Var: IF obj^.vis = externalR THEN OPM.SymWInt(Srvar) ELSE OPM.SymWInt(Svar) END; + OutStr(obj^.typ); OutName(obj^.name); + IF (obj^.typ^.strobj = NIL) OR (obj^.typ^.strobj^.name = "") THEN + (* compute fingerprint to avoid structural type equivalence *) + OPM.FPrint(expCtxt.reffp, obj^.typ^.ref) + END + | XProc: OPM.SymWInt(Sxpro); OutSign(obj^.typ, obj^.link); OutName(obj^.name) + | IProc: OPM.SymWInt(Sipro); OutSign(obj^.typ, obj^.link); OutName(obj^.name) + | CProc: OPM.SymWInt(Scpro); OutSign(obj^.typ, obj^.link); ext := obj^.conval^.ext; + j := ORD(ext^[0]); i := 1; OPM.SymWInt(j); + WHILE i <= j DO OPM.SymWCh(ext^[i]); INC(i) END; + OutName(obj^.name) + ELSE OPM.LogWStr("unhandled case at OutObj, obj.mode = "); OPM.LogWNum(obj.mode, 0); OPM.LogWLn; + END + END + END; + OutObj(obj^.right) + END +END OutObj; PROCEDURE Export*(VAR ext, new: BOOLEAN); VAR i: INTEGER; nofmod: SHORTINT; done: BOOLEAN; diff --git a/src/compiler/OPV.Mod b/src/compiler/OPV.Mod index d0cbde89..c6b26c05 100644 --- a/src/compiler/OPV.Mod +++ b/src/compiler/OPV.Mod @@ -1,3 +1,4 @@ +(* OPV - parse tree traverser (back end) *) MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 26.7.2002 jt bug fix OPS.in Len: wrong result if called for fixed OPT.Array @@ -204,14 +205,22 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 END; END Precedence; - PROCEDURE^ expr (n: OPT.Node; prec: INTEGER); + PROCEDURE^ expr (n: OPT.Node; prec: INTEGER); PROCEDURE^ design(n: OPT.Node; prec: INTEGER); PROCEDURE Len(n: OPT.Node; dim: SYSTEM.INT64); + VAR + d: SYSTEM.INT64; array: OPT.Struct; BEGIN WHILE (n^.class = OPT.Nindex) & (n^.typ^.comp = OPT.DynArr(*26.7.2002*)) DO INC(dim); n := n^.left END ; IF (n^.class = OPT.Nderef) & (n^.typ^.comp = OPT.DynArr) THEN - design(n^.left, 10); OPM.WriteString("->len["); OPM.WriteInt(dim); OPM.Write("]") + d := dim; array := n^.typ; + WHILE d > 0 DO array := array^.BaseTyp; DEC(d) END; + IF array^.comp = OPT.DynArr THEN + design(n^.left, 10); OPM.WriteString("->len["); OPM.WriteInt(dim); OPM.Write("]") + ELSE + OPM.WriteInt(array^.n) + END ELSE OPC.Len(n^.obj, n^.typ, dim) END @@ -241,7 +250,8 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 ELSE IF (n.typ.size # to) & ((n.typ.size > OPM.CIntSize) OR (to # OPM.CIntSize)) THEN OPM.WriteString("(INT"); OPM.WriteInt(to*8); OPM.WriteString(")") - END + END; + Entier(n, 9) END END SizeCast; @@ -250,13 +260,13 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 BEGIN from := n^.typ^.form; to := newtype.form; IF to = OPT.Set THEN IF from = OPT.Set THEN (* Sets of different size *) - SizeCast(n, newtype.size); Entier(n, 9) + SizeCast(n, newtype.size); ELSE (* Set from integer *) OPM.WriteString("__SETOF("); Entier(n, MinPrec); OPM.WriteString(","); OPM.WriteInt(newtype.size*8); OPM.Write(CloseParen) END ELSIF to = OPT.Int THEN (* integers of different size *) - SizeCast(n, newtype.size); Entier(n, 9) + SizeCast(n, newtype.size); ELSIF to = OPT.Char THEN IF OPM.ranchk IN OPM.Options THEN OPM.WriteString("__CHR"); IF SideEffects(n) THEN OPM.Write("F") END ; @@ -723,7 +733,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 design(d, MinPrec); OPM.WriteString(" = __NEWARR("); WHILE base^.comp = OPT.Array DO INC(nofdim); base := base^.BaseTyp END ; IF (base^.comp = OPT.Record) & (OPC.NofPtrs(base) # 0) THEN - OPC.Ident(base^.strobj); OPM.WriteString(DynTypExt) + OPC.Andent(base); OPM.WriteString(DynTypExt) ELSIF base^.form = OPT.Pointer THEN OPM.WriteString("POINTER__typ") ELSE OPM.WriteString("NIL") END ; diff --git a/src/compiler/extTools.Mod b/src/compiler/extTools.Mod index 10163ced..c51d8c4d 100644 --- a/src/compiler/extTools.Mod +++ b/src/compiler/extTools.Mod @@ -1,19 +1,34 @@ MODULE extTools; -IMPORT Strings, Out, Configuration, Platform, Modules, OPM; +IMPORT Strings, Out, Configuration, Platform, Modules, Heap, OPM; -VAR CFLAGS: ARRAY 1023 OF CHAR; +TYPE CommandString = ARRAY 4096 OF CHAR; + +VAR CFLAGS: CommandString; PROCEDURE execute(title: ARRAY OF CHAR; cmd: ARRAY OF CHAR); - VAR r, status, exitcode: INTEGER; + VAR r, status, exitcode: INTEGER; fullcmd: CommandString; BEGIN IF OPM.verbose IN OPM.Options THEN - Out.String(title); Out.String(cmd); Out.Ln + Out.String(" "); Out.String(cmd); Out.Ln END; - r := Platform.System(cmd); - status := r MOD 128; - exitcode := r DIV 256; + + (* Hack to suppress unwanted filename display by Microsoft C compiler on successful compilations. *) + IF Configuration.compiler = "MSC" THEN + fullcmd := "cmd /c "; + Strings.Append(cmd, fullcmd); + Strings.Append(" >msc-listing || type msc-listing", fullcmd) + ELSE + COPY(cmd, fullcmd); + END; + + (* Get GC to run file finalizers closing generated C files as otherwise Microsoft C cannot open them. *) + Heap.GC(FALSE); + + r := Platform.System(fullcmd); + + status := r MOD 128; exitcode := r DIV 256; IF exitcode > 127 THEN exitcode := exitcode - 256 END; (* Handle signed exit code *) IF r # 0 THEN @@ -29,12 +44,14 @@ BEGIN END execute; -PROCEDURE InitialiseCompilerCommand(VAR s: ARRAY OF CHAR); +PROCEDURE InitialiseCompilerCommand(VAR s: ARRAY OF CHAR; additionalopts: ARRAY OF CHAR); BEGIN COPY(Configuration.compile, s); Strings.Append(' -I "', s); Strings.Append(OPM.ResourceDir, s); Strings.Append('/include" ', s); + Strings.Append(additionalopts, s); + Strings.Append(" ", s); Platform.GetEnv("CFLAGS", CFLAGS); Strings.Append (CFLAGS, s); Strings.Append (" ", s); @@ -43,9 +60,9 @@ END InitialiseCompilerCommand; PROCEDURE Assemble*(moduleName: ARRAY OF CHAR); VAR - cmd: ARRAY 1023 OF CHAR; + cmd: CommandString; BEGIN - InitialiseCompilerCommand(cmd); + InitialiseCompilerCommand(cmd, ""); Strings.Append("-c ", cmd); Strings.Append(moduleName, cmd); Strings.Append(".c", cmd); @@ -55,25 +72,52 @@ PROCEDURE Assemble*(moduleName: ARRAY OF CHAR); PROCEDURE LinkMain*(VAR moduleName: ARRAY OF CHAR; statically: BOOLEAN; additionalopts: ARRAY OF CHAR); VAR - cmd: ARRAY 1023 OF CHAR; + cmd: CommandString; BEGIN - InitialiseCompilerCommand(cmd); - Strings.Append(moduleName, cmd); - Strings.Append(".c ", cmd); - Strings.Append(additionalopts, cmd); + InitialiseCompilerCommand(cmd, additionalopts); + Strings.Append(moduleName, cmd); + Strings.Append(".c ", cmd); IF statically THEN - Strings.Append(Configuration.staticLink, cmd) + IF Configuration.os = "darwin" THEN + Strings.Append(OPM.InstallDir, cmd); + Strings.Append('/lib/lib', cmd); + Strings.Append(Configuration.name, cmd); + Strings.Append('-O', cmd); + Strings.Append(OPM.Model, cmd); + Strings.Append('.a', cmd); + ELSE + Strings.Append(Configuration.staticLink, cmd) + END + END; + Strings.Append(Configuration.objflag, cmd); + Strings.Append(moduleName, cmd); + IF (~statically) OR ~(Configuration.os = "darwin") THEN + Strings.Append(Configuration.linkflags, cmd); + Strings.Append(OPM.InstallDir, cmd); + Strings.Append('/lib"', cmd); + Strings.Append(Configuration.libspec, cmd); + Strings.Append('-O', cmd); + Strings.Append(OPM.Model, cmd); + Strings.Append(Configuration.libext, cmd) END; - Strings.Append(Configuration.objflag, cmd); - Strings.Append(moduleName, cmd); - Strings.Append(Configuration.linkflags, cmd); - Strings.Append(OPM.InstallDir, cmd); - Strings.Append('/lib"', cmd); - Strings.Append(Configuration.libspec, cmd); - Strings.Append('-O', cmd); - Strings.Append(OPM.Model, cmd); - Strings.Append(Configuration.libext, cmd); execute("C compile and link: ", cmd); + + IF (Configuration.os = "darwin") & ~statically THEN + (* Darwin requires an extra command to set the library directory into the binary *) + cmd := "install_name_tool -change lib"; + Strings.Append(Configuration.name, cmd); + Strings.Append('-O', cmd); + Strings.Append(OPM.Model, cmd); + Strings.Append('.dylib "', cmd); + Strings.Append(OPM.InstallDir, cmd); + Strings.Append('/lib/lib', cmd); + Strings.Append(Configuration.name, cmd); + Strings.Append('-O', cmd); + Strings.Append(OPM.Model, cmd); + Strings.Append('.dylib" ', cmd); + Strings.Append(moduleName, cmd); + execute("Set library directory: ", cmd) + END END LinkMain; diff --git a/src/library/ooc/oocCILP32.Mod b/src/library/ooc/oocCILP32.Mod index e868b9f6..66a3cde1 100644 --- a/src/library/ooc/oocCILP32.Mod +++ b/src/library/ooc/oocCILP32.Mod @@ -31,13 +31,13 @@ Unix they should be fairly safe. TYPE char* = CHAR; (* 8 bits *) - signedchar* = SHORTINT; (* 8 bits *) - shortint* = RECORD a,b: SYSTEM.BYTE END; (* 16 bits *) - int* = LONGINT; (* 32 bits *) - set* = LONGINT; (* 32 bits *) - longint* = LONGINT; (* 32 bits on ILP32 (64 bits is 'long long') *) + signedchar* = SYSTEM.INT8; (* 8 bits *) + shortint* = SYSTEM.INT16; (* 16 bits *) + int* = SYSTEM.INT32; (* 32 bits *) + set* = SYSTEM.INT32; (* 32 bits *) + longint* = SYSTEM.INT32; (* 32 bits on ILP32 (64 bits is 'long long') *) (*longset* = SET; n/a *) (* 64 bit SET *) - address* = LONGINT; (* 32 bits *) + address* = SYSTEM.ADDRESS; (* 32 bits *) float* = REAL; (* 32 bits *) double* = LONGREAL; (* 64 bits *) diff --git a/src/library/ooc/oocCLLP64.Mod b/src/library/ooc/oocCLLP64.Mod index a7eadc0b..4b6add95 100644 --- a/src/library/ooc/oocCLLP64.Mod +++ b/src/library/ooc/oocCLLP64.Mod @@ -31,13 +31,13 @@ Unix they should be fairly safe. TYPE char* = CHAR; (* 8 bits *) - signedchar* = SHORTINT; (* 8 bits *) - shortint* = RECORD a,b: SYSTEM.BYTE END; (* 16 bits *) - int* = INTEGER; (* 32 bits *) - set* = INTEGER; (* 32 bits *) - longint* = INTEGER; (* 32 bits *) - longset* = SET; (* 64 bits *) - address* = LONGINT; (* 64 bits *) + signedchar* = SYSTEM.INT8; (* 8 bits *) + shortint* = SYSTEM.INT16; (* 16 bits *) + int* = SYSTEM.INT32; (* 32 bits *) + set* = SYSTEM.SET32; (* 32 bits *) + longint* = SYSTEM.INT32; (* 32 bits *) + longset* = SYSTEM.SET64; (* 64 bits *) + address* = SYSTEM.INT64; (* 64 bits *) float* = REAL; (* 32 bits *) double* = LONGREAL; (* 64 bits *) diff --git a/src/library/ooc/oocCLP64.Mod b/src/library/ooc/oocCLP64.Mod index dcc76584..0e97c566 100644 --- a/src/library/ooc/oocCLP64.Mod +++ b/src/library/ooc/oocCLP64.Mod @@ -31,13 +31,13 @@ Unix they should be fairly safe. TYPE char* = CHAR; (* 8 bits *) - signedchar* = SHORTINT; (* 8 bits *) - shortint* = RECORD a,b: SYSTEM.BYTE END; (* 16 bits *) - int* = INTEGER; (* 32 bits *) - set* = INTEGER; (* 32 bits *) - longint* = LONGINT; (* 64 bits *) - longset* = SET; (* 64 bits *) - address* = LONGINT; (* 64 bits *) + signedchar* = SYSTEM.INT8; (* 8 bits *) + shortint* = SYSTEM.INT16; (* 16 bits *) + int* = SYSTEM.INT32; (* 32 bits *) + set* = SYSTEM.INT32; (* 32 bits *) + longint* = SYSTEM.INT64; (* 64 bits *) + longset* = SYSTEM.SET64; (* 64 bits *) + address* = SYSTEM.ADDRESS; (* 64 bits *) float* = REAL; (* 32 bits *) double* = LONGREAL; (* 64 bits *) diff --git a/src/library/ooc/oocIntStr.Mod b/src/library/ooc/oocIntStr.Mod index ec98f128..2b8213ca 100644 --- a/src/library/ooc/oocIntStr.Mod +++ b/src/library/ooc/oocIntStr.Mod @@ -1,49 +1,49 @@ -(* $Id: IntStr.Mod,v 1.4 1999/09/02 13:07:47 acken Exp $ *) +(* $Id: IntStr.Mod,v 1.4 1999/09/02 13:07:47 acken Exp $ *) MODULE oocIntStr; -(* IntStr - Integer-number/string conversions. +(* IntStr - Integer-number/string conversions. Copyright (C) 1995 Michael Griebling - + This module is free software; you can redistribute it and/or modify - it under the terms of the GNU Lesser General Public License as + it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. - + This module is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. - + You should have received a copy of the GNU Lesser General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) - + IMPORT Conv := oocConvTypes, IntConv := oocIntConv; - + TYPE - ConvResults*= Conv.ConvResults; - (* possible values: strAllRight, strOutOfRange, strWrongFormat, strEmpty *) + (** possible values: strAllRight, strOutOfRange, strWrongFormat, strEmpty *) + ConvResults*= Conv.ConvResults; CONST + (** the string format is correct for the corresponding conversion *) strAllRight*=Conv.strAllRight; - (* the string format is correct for the corresponding conversion *) + (** the string is well-formed but the value cannot be represented *) strOutOfRange*=Conv.strOutOfRange; - (* the string is well-formed but the value cannot be represented *) + (** the string is in the wrong format for the conversion *) strWrongFormat*=Conv.strWrongFormat; - (* the string is in the wrong format for the conversion *) + (** the given string is empty *) strEmpty*=Conv.strEmpty; - (* the given string is empty *) - - -(* the string form of a signed whole number is + + +(** the string form of a signed whole number is ["+" | "-"] decimal_digit {decimal_digit} *) - -PROCEDURE StrToInt*(str: ARRAY OF CHAR; VAR int: LONGINT; VAR res: ConvResults); -(* Ignores any leading spaces in `str'. If the subsequent characters in `str' +(** Ignores any leading spaces in `str'. If the subsequent characters in `str' are in the format of a signed whole number, assigns a corresponding value to `int'. Assigns a value indicating the format of `str' to `res'. *) + +PROCEDURE StrToInt*(str: ARRAY OF CHAR; VAR int: LONGINT; VAR res: ConvResults); BEGIN res:=IntConv.FormatInt(str); IF (res = strAllRight) THEN @@ -63,10 +63,10 @@ BEGIN END END Reverse; +(** Converts the value of `int' to string form and copies the possibly truncated + result to `str'. *) PROCEDURE IntToStr*(int: LONGINT; VAR str: ARRAY OF CHAR); -(* Converts the value of `int' to string form and copies the possibly truncated - result to `str'. *) CONST maxLength = 11; (* maximum number of digits representing a LONGINT value *) VAR @@ -92,9 +92,9 @@ BEGIN b[e] := 0X; Reverse(b, s, e-1) END; - + COPY(b, str) (* truncate output if necessary *) END IntToStr; - + END oocIntStr. diff --git a/src/library/ooc/oocStrings.Mod b/src/library/ooc/oocStrings.Mod index add23621..73315fa3 100644 --- a/src/library/ooc/oocStrings.Mod +++ b/src/library/ooc/oocStrings.Mod @@ -63,7 +63,11 @@ PROCEDURE Length* (stringVal: ARRAY OF CHAR): INTEGER; i: INTEGER; BEGIN i := 0; - WHILE (stringVal[i] # 0X) DO + (* note from noch: + original ooc code below, commented out, leads to + index out of range runtime error + WHILE (stringVal[i] # 0X) DO *) + WHILE ((i < LEN(stringVal)) & (stringVal[i] # 0X)) DO INC (i) END; RETURN i diff --git a/src/library/ooc2/ooc2Strings.Mod b/src/library/ooc2/ooc2Strings.Mod index a0ad4362..278f2663 100644 --- a/src/library/ooc2/ooc2Strings.Mod +++ b/src/library/ooc2/ooc2Strings.Mod @@ -59,7 +59,12 @@ PROCEDURE Length* (stringVal: ARRAY OF CHAR): INTEGER; i: INTEGER; BEGIN i := 0; - WHILE (stringVal[i] # 0X) DO + (* note from noch: + this original ooc code crashes with index out of range + because it doesn't expect a string which has no 0X character + so i had to change it + WHILE (stringVal[i] # 0X) DO *) + WHILE ((i < LEN(stringVal)) & (stringVal[i] # 0X)) DO INC (i) END; RETURN i diff --git a/src/library/s3/ethBase64.Mod b/src/library/s3/ethBase64.Mod new file mode 100644 index 00000000..66bcde05 --- /dev/null +++ b/src/library/s3/ethBase64.Mod @@ -0,0 +1,233 @@ +MODULE ethBase64; (* Adapted for VOC from Oberon System 3 *) +IMPORT Files, Texts, Oberon, Out; + +VAR + encTable: ARRAY 64 OF CHAR; + decTable: ARRAY 128 OF INTEGER; + W: Texts.Writer; + +PROCEDURE DecodeText*(T: Texts.Text; beg: LONGINT; F: Files.File): BOOLEAN; +VAR + R: Texts.Reader; + codes: ARRAY 4 OF INTEGER; + Ri: Files.Rider; + i: INTEGER; + ch: CHAR; + ok, end: BOOLEAN; +BEGIN + Files.Set(Ri, F, 0); + ok := TRUE; end := FALSE; + Texts.OpenReader(R, T, beg); + Texts.Read(R, ch); + REPEAT + i := 0; + WHILE ~R.eot & ok & (i < 4) DO + WHILE ~R.eot & (ch <= " ") DO + Texts.Read(R, ch) + END; + IF (ch >= 0X) & (ch < 80X) THEN + codes[i] := decTable[ORD(ch)]; + ok := codes[i] >= 0; INC(i); + IF ok THEN + Texts.Read(R, ch) + END + ELSE + ok := FALSE + END + END; + IF i > 0 THEN + IF ok & (i = 4) THEN + Files.Write(Ri, CHR(ASH(codes[0], 2)+ASH(codes[1], -4))); + Files.Write(Ri, CHR(ASH(codes[1], 4)+ASH(codes[2], -2))); + Files.Write(Ri, CHR(ASH(codes[2], 6)+codes[3])) + ELSIF ch = "=" THEN + ok := TRUE; end := TRUE; DEC(i); + IF i = 2 THEN + Files.Write(Ri, CHR(ASH(codes[0], 2)+ASH(codes[1], -4))) + ELSIF i = 3 THEN + Files.Write(Ri, CHR(ASH(codes[0], 2)+ASH(codes[1], -4))); + Files.Write(Ri, CHR(ASH(codes[1], 4)+ASH(codes[2], -2))) + ELSIF i # 0 THEN + ok := FALSE + END + ELSE + end := TRUE + END + ELSE + end := TRUE + END + UNTIL R.eot OR end; + RETURN ok +END DecodeText; + +PROCEDURE Decode*; +VAR + S: Texts.Scanner; + F: Files.File; + T: Texts.Text; + beg, end, time: LONGINT; + res: INTEGER; +BEGIN + Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); + Texts.Scan(S); + IF S.class IN {Texts.Name, Texts.String} THEN + Texts.WriteString(W, S.s); + F := Files.New(S.s); + Texts.Scan(S); + IF (S.class = Texts.Char) & ((S.c = "@") OR (S.c = "^")) THEN + T := NIL; + time := -1; + Oberon.GetSelection(T, beg, end, time); + IF T = NIL THEN + Texts.WriteString(W, " - no selection"); + Texts.WriteLn(W); + Texts.Append(Oberon.Log, W.buf); + RETURN + END + ELSIF S.class IN {Texts.Name, Texts.String} THEN + NEW(T); + Texts.Open(T, S.s); + beg := 0 + ELSE + beg := Texts.Pos(S); + T := Oberon.Par.text + END; + IF DecodeText(T, beg, F) THEN + Files.Register(F); + Texts.WriteString(W, " done") + ELSE + Texts.WriteString(W, " failed") + END; + Texts.WriteLn(W); + Texts.Append(Oberon.Log, W.buf) + END +END Decode; + +PROCEDURE EncodeFile*(F: Files.File; T: Texts.Text); +VAR + R: Files.Rider; + i, j, c, c0, c1, c2, l: LONGINT; + chars: ARRAY 3 OF CHAR; + + PROCEDURE OutCode(); + BEGIN + IF l > 76 THEN (* Standard line length for Base64 *) + Texts.WriteLn(W); + Texts.Append(T, W.buf); + l := 0 + END; + c0 := ORD(chars[0]); + c := ASH(c0, -2); + Texts.Write(W, encTable[c]); + c0 := c0 - ASH(c, 2); + + c1 := ORD(chars[1]); + c := ASH(c0, 4) + ASH(c1, -4); + Texts.Write(W, encTable[c]); + c1 := c1 MOD 16; + + c2 := ORD(chars[2]); + c := ASH(c1, 2) + ASH(c2, -6); + Texts.Write(W, encTable[c]); + c2 := c2 MOD 64; + + Texts.Write(W, encTable[c2]); + INC(l, 4) + END OutCode; + +BEGIN + l := 0; + Files.Set(R, F, 0); + Files.Read(R, chars[0]); + i := 1; + WHILE ~R.eof DO + IF i >= 3 THEN + OutCode(); + i := 0 + END; + Files.Read(R, chars[i]); + INC(i) + END; + DEC(i); + IF i > 0 THEN + j := i; + WHILE i < 3 DO + chars[i] := 0X; + INC(i) + END; + OutCode(); + (* Handle padding *) + IF j < 3 THEN + Texts.Append(T, W.buf); + (* Remove extra characters and add padding *) + j := 3 - j; + Texts.Delete(T, T.len - j, T.len); + FOR i := 1 TO j DO + Texts.Write(W, "=") + END + END + END; + Texts.WriteLn(W); + Texts.Append(T, W.buf) +END EncodeFile; + +PROCEDURE Encode*; +VAR + S: Texts.Scanner; + F: Files.File; + T: Texts.Text; + name: ARRAY 256 OF CHAR; +BEGIN + NEW(T); + Texts.Open(T, ""); + Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); + Texts.Scan(S); + IF S.class IN {Texts.Name, Texts.String} THEN + COPY(S.s, name); + F := Files.Old(name); + IF F # NIL THEN + EncodeFile(F, T); + (* In VOC, we'll output to console instead of opening a viewer *) + Out.String("=== Base64 Encoded: "); Out.String(name); + Out.String(" ==="); Out.Ln; + (* Output the encoded text - would need a helper to print Text to console *) + Out.String("[Base64 encoded content would be here]"); Out.Ln; + Out.String("=== End ==="); Out.Ln; + ELSE + Out.String("File not found: "); Out.String(name); Out.Ln; + END + END +END Encode; + +PROCEDURE InitTables(); +VAR i, max: INTEGER; +BEGIN + (* Build encoding table *) + max := ORD("Z") - ORD("A"); + FOR i := 0 TO max DO + encTable[i] := CHR(i + ORD("A")) + END; + INC(max); + FOR i := max TO max + ORD("z") - ORD("a") DO + encTable[i] := CHR(i - max + ORD("a")) + END; + max := max + ORD("z") - ORD("a") + 1; + FOR i := max TO max + ORD("9") - ORD("0") DO + encTable[i] := CHR(i - max + ORD("0")) + END; + encTable[62] := "+"; + encTable[63] := "/"; + + (* Build decoding table *) + FOR i := 0 TO 127 DO + decTable[i] := -1 + END; + FOR i := 0 TO 63 DO + decTable[ORD(encTable[i])] := i + END +END InitTables; + +BEGIN + InitTables(); + Texts.OpenWriter(W) +END ethBase64. diff --git a/src/library/s3/ethStrings.Mod b/src/library/s3/ethStrings.Mod index 49f8a974..b2cf4901 100644 --- a/src/library/s3/ethStrings.Mod +++ b/src/library/s3/ethStrings.Mod @@ -7,16 +7,21 @@ MODULE ethStrings; (** portable *) (* ejz, *) Note: All strings MUST be 0X terminated. *) IMPORT Texts, Dates := ethDates, Reals := ethReals; - - CONST - CR* = 0DX; (** the Oberon end of line character *) - Tab* = 09X; (** the horizontal tab character *) - LF* = 0AX; (** the UNIX end of line character *) + CONST + (** the Oberon end of line character *) + CR* = 0DX; + (** the horizontal tab character *) + Tab* = 09X; + (** the UNIX end of line character *) + LF* = 0AX; VAR - isAlpha*: ARRAY 256 OF BOOLEAN; (** all letters in the oberon charset *) - ISOToOberon*, OberonToISO*: ARRAY 256 OF CHAR; (** Translation tables for iso-8859-1 to oberon ascii code. *) - CRLF*: ARRAY 4 OF CHAR; (** end of line "string" used by MS-DOS and most TCP protocols *) + (** all letters in the oberon charset *) + isAlpha*: ARRAY 256 OF BOOLEAN; + (** Translation tables for iso-8859-1 to oberon ascii code. *) + ISOToOberon*, OberonToISO*: ARRAY 256 OF CHAR; + (** end of line "string" used by MS-DOS and most TCP protocols *) + CRLF*: ARRAY 4 OF CHAR; sDayName: ARRAY 7, 4 OF CHAR; lDayName: ARRAY 7, 12 OF CHAR; sMonthName: ARRAY 12, 4 OF CHAR; @@ -24,7 +29,7 @@ MODULE ethStrings; (** portable *) (* ejz, *) dateform, timeform: ARRAY 32 OF CHAR; (** Length of str. *) - PROCEDURE Length*(VAR str(** in *): ARRAY OF CHAR): LONGINT; + PROCEDURE Length*(VAR str(* in *): ARRAY OF CHAR): LONGINT; VAR i, l: LONGINT; BEGIN l := LEN(str); i := 0; @@ -35,7 +40,7 @@ MODULE ethStrings; (** portable *) (* ejz, *) END Length; (** Append this to to. *) - PROCEDURE Append*(VAR to(** in/out *): ARRAY OF CHAR; this: ARRAY OF CHAR); + PROCEDURE Append*(VAR to(* in/out *): ARRAY OF CHAR; this: ARRAY OF CHAR); VAR i, j, l: LONGINT; BEGIN i := 0; @@ -50,7 +55,7 @@ MODULE ethStrings; (** portable *) (* ejz, *) END Append; (** Append this to to. *) - PROCEDURE AppendCh*(VAR to(** in/out *): ARRAY OF CHAR; this: CHAR); + PROCEDURE AppendCh*(VAR to(* in/out *): ARRAY OF CHAR; this: CHAR); VAR i: LONGINT; BEGIN i := 0; @@ -124,7 +129,7 @@ MODULE ethStrings; (** portable *) (* ejz, *) END UpperCh; (** Convert str to all lower-case letters. *) - PROCEDURE Lower*(VAR str(** in *), lstr(** out *): ARRAY OF CHAR); + PROCEDURE Lower*(VAR str(* in *), lstr(* out *): ARRAY OF CHAR); VAR i: LONGINT; BEGIN i := 0; @@ -135,7 +140,7 @@ MODULE ethStrings; (** portable *) (* ejz, *) END Lower; (** Convert str to all upper-case letters. *) - PROCEDURE Upper*(VAR str(** in *), ustr(** out *): ARRAY OF CHAR); + PROCEDURE Upper*(VAR str(* in *), ustr(* out *): ARRAY OF CHAR); VAR i: LONGINT; BEGIN i := 0; @@ -146,7 +151,7 @@ MODULE ethStrings; (** portable *) (* ejz, *) END Upper; (** Is str prefixed by pre? *) - PROCEDURE Prefix*(pre: ARRAY OF CHAR; VAR str(** in *): ARRAY OF CHAR): BOOLEAN; + PROCEDURE Prefix*(pre: ARRAY OF CHAR; VAR str(* in *): ARRAY OF CHAR): BOOLEAN; VAR i: LONGINT; BEGIN i := 0; @@ -157,7 +162,7 @@ MODULE ethStrings; (** portable *) (* ejz, *) END Prefix; (** Checks if str is prefixed by pre. The case is ignored. *) - PROCEDURE CAPPrefix*(pre: ARRAY OF CHAR; VAR str(** in *): ARRAY OF CHAR): BOOLEAN; + PROCEDURE CAPPrefix*(pre: ARRAY OF CHAR; VAR str(* in *): ARRAY OF CHAR): BOOLEAN; VAR i: LONGINT; BEGIN i := 0; @@ -168,7 +173,7 @@ MODULE ethStrings; (** portable *) (* ejz, *) END CAPPrefix; (** Compare str1 to str2. The case is ignored. *) - PROCEDURE CAPCompare*(VAR str1(** in *), str2(** in *): ARRAY OF CHAR): BOOLEAN; + PROCEDURE CAPCompare*(VAR str1(* in *), str2(* in *): ARRAY OF CHAR): BOOLEAN; VAR i: LONGINT; BEGIN i := 0; @@ -179,7 +184,7 @@ MODULE ethStrings; (** portable *) (* ejz, *) END CAPCompare; (** Get the parameter-value on line. The parameter value is started behind the first colon character. *) - PROCEDURE GetPar*(VAR line(** in *), par(** out *): ARRAY OF CHAR); + PROCEDURE GetPar*(VAR line(* in *), par(* out *): ARRAY OF CHAR); VAR i, j, l: LONGINT; BEGIN i := 0; @@ -200,7 +205,7 @@ MODULE ethStrings; (** portable *) (* ejz, *) END GetPar; (** Get the suffix of str. The suffix is started by the last dot in str. *) - PROCEDURE GetSuffix*(VAR str(** in *), suf(** out *): ARRAY OF CHAR); + PROCEDURE GetSuffix*(VAR str(* in *), suf(* out *): ARRAY OF CHAR); VAR i, j, l, dot: LONGINT; BEGIN dot := -1; i := 0; @@ -223,7 +228,7 @@ MODULE ethStrings; (** portable *) (* ejz, *) END GetSuffix; (** Change the suffix of str to suf. *) - PROCEDURE ChangeSuffix*(VAR str(** in/out *): ARRAY OF CHAR; suf: ARRAY OF CHAR); + PROCEDURE ChangeSuffix*(VAR str(* in/out *): ARRAY OF CHAR; suf: ARRAY OF CHAR); VAR i, j, l, dot: LONGINT; BEGIN dot := -1; i := 0; @@ -245,7 +250,7 @@ MODULE ethStrings; (** portable *) (* ejz, *) END ChangeSuffix; (** Search in src starting at pos for the next occurrence of pat. Returns pos=-1 if not found. *) - PROCEDURE Search*(pat: ARRAY OF CHAR; VAR src(** in *): ARRAY OF CHAR; VAR pos(** in/out *): LONGINT); + PROCEDURE Search*(pat: ARRAY OF CHAR; VAR src(* in *): ARRAY OF CHAR; VAR pos(** in/out *): LONGINT); CONST MaxPat = 128; VAR buf: ARRAY MaxPat OF CHAR; @@ -306,7 +311,7 @@ MODULE ethStrings; (** portable *) (* ejz, *) END Search; (** Search in src starting at pos for the next occurrence of pat. *) - PROCEDURE CAPSearch*(pat: ARRAY OF CHAR; VAR src(** in *): ARRAY OF CHAR; VAR pos(** in/out *): LONGINT); + PROCEDURE CAPSearch*(pat: ARRAY OF CHAR; VAR src(* in *): ARRAY OF CHAR; VAR pos(* in/out *): LONGINT); CONST MaxPat = 128; VAR buf: ARRAY MaxPat OF CHAR; @@ -445,13 +450,13 @@ MODULE ethStrings; (** portable *) (* ejz, *) (** Converts a real to a string. *) PROCEDURE RealToStr*(x: LONGREAL; VAR s: ARRAY OF CHAR); VAR e, h, l, n, len: LONGINT; i, j, pos: INTEGER; z: LONGREAL; d: ARRAY 16 OF CHAR; - + PROCEDURE Wr(ch: CHAR); BEGIN IF ch = 0X THEN HALT(42) END; IF pos < len THEN s[pos] := ch; INC(pos) END; END Wr; - + BEGIN len := LEN(s)-1; pos := 0; e:= Reals.ExpoL(x); @@ -573,14 +578,14 @@ BEGIN WHILE (s[p] = " ") OR (s[p] = "0") DO INC(p) END; IF s[p] = "-" THEN neg := TRUE; INC(p) ELSE neg := FALSE END; WHILE (s[p] = " ") OR (s[p] = "0") DO INC(p) END; - + y := 0; WHILE ("0" <= s[p]) & (s[p] <= "9") DO y := y * 10 + (ORD(s[p]) - 30H); INC(p); END; IF s[p] = "." THEN - INC(p); g := 1; + INC(p); g := 1; WHILE ("0" <= s[p]) & (s[p] <= "9") DO g := g / 10; y := y + g * (ORD(s[p]) - 30H); INC(p); @@ -706,7 +711,7 @@ END StrToReal; IF CAP(form[j]) = "M" THEN INC(j); IF CAP(form[j]) = "M" THEN INC(j); COPY(lMonthName[x-1], name) - ELSE COPY(sMonthName[x-1], name) + ELSE COPY(sMonthName[x-1], name) END; k := 0; WHILE name[k] # 0X DO str[i] := name[k]; INC(i); INC(k) END ELSE @@ -735,14 +740,14 @@ END StrToReal; str[i] := 0X END DateToStr; -(** Returns a month's name (set short to get the abbreviation) *) +(** Returns a month's name (set short to get the abbreviation) *) PROCEDURE MonthToStr* (month: INTEGER; VAR str: ARRAY OF CHAR; short: BOOLEAN); BEGIN month := (month - 1) MOD 12; IF short THEN COPY(sMonthName[month], str) ELSE COPY(lMonthName[month], str) END END MonthToStr; -(** Returns a day's name (set short to get the abbreviation) *) +(** Returns a day's name (set short to get the abbreviation) *) PROCEDURE DayToStr* (day: INTEGER; VAR str: ARRAY OF CHAR; short: BOOLEAN); BEGIN IF short THEN COPY(sDayName[day MOD 7], str) ELSE COPY(lDayName[day MOD 7], str) END diff --git a/src/library/v4/Args.Mod b/src/library/v4/Args.Mod old mode 100644 new mode 100755 index 578ac7e5..c3621116 --- a/src/library/v4/Args.Mod +++ b/src/library/v4/Args.Mod @@ -10,7 +10,7 @@ MODULE Args; (* jt, 8.12.94 *) ArgVec = POINTER TO ARRAY 1024 OF ArgPtr; VAR - argc-: LONGINT; + argc-: INTEGER; argv-: SYSTEM.ADDRESS; diff --git a/src/runtime/Files.Mod b/src/runtime/Files.Mod index eb369b3c..64236a7d 100644 --- a/src/runtime/Files.Mod +++ b/src/runtime/Files.Mod @@ -2,16 +2,6 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files IMPORT SYSTEM, Platform, Heap, Strings, Out; - (* standard data type I/O - - little endian, - Sint:1, Int:2, Lint:4 - ORD({0}) = 1, - false = 0, true =1 - IEEE real format, - null terminated strings, - compact numbers according to M.Odersky *) - CONST NumBufs = 4; @@ -29,7 +19,7 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files name *) TYPE - FileName = ARRAY 101 OF CHAR; + FileName = ARRAY 256 OF CHAR; File* = POINTER TO FileDesc; Buffer = POINTER TO BufDesc; @@ -64,6 +54,9 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files VAR + MaxPathLength-: INTEGER; + MaxNameLength-: INTEGER; + files: POINTER [1] TO FileDesc; (* List of files backed by an OS file, whether open, registered or temporary. *) tempno: INTEGER; HOME: ARRAY 1024 OF CHAR; @@ -84,34 +77,34 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files Out.Ln; Out.String("-- "); Out.String(s); Out.String(": "); IF f # NIL THEN IF f.registerName # "" THEN Out.String(f.registerName) ELSE Out.String(f.workName) END; - IF f.fd # 0 THEN Out.String("f.fd = "); Out.Int(f.fd,1) END + IF f.fd # 0 THEN Out.String(", f.fd = "); Out.Int(f.fd,1) END END; - IF errcode # 0 THEN Out.String(" errcode = "); Out.Int(errcode, 1) END; + IF errcode # 0 THEN Out.String(", errcode = "); Out.Int(errcode, 1) END; Out.Ln; HALT(99) END Err; PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR); - VAR i, j: INTEGER; - BEGIN i := 0; j := 0; - WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END; - IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END; - WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END; - dest[i] := 0X + VAR i, j, ld, ln: INTEGER; + BEGIN ld := Strings.Length(dir); ln := Strings.Length(name); + WHILE (ld > 0) & (dir[ld-1] = '/') DO DEC(ld) END; + IF ld + ln + 2 > LEN(dest) THEN Err("File name too long", NIL, 0) END; + i := 0; + WHILE i < ld DO dest[i] := dir[i]; INC(i) END; + IF i > 0 THEN dest[i] := '/'; INC(i) END; + j := 0; + WHILE j < ln DO dest[i] := name[j]; INC(i); INC(j) END; + dest[i] := 0X; END MakeFileName; PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR); - VAR n, i, j: LONGINT; + VAR i, n: INTEGER; BEGIN - INC(tempno); n := tempno; i := 0; - IF finalName[0] # "/" THEN (* relative pathname *) - WHILE Platform.CWD[i] # 0X DO name[i] := Platform.CWD[i]; INC(i) END; - IF Platform.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END - END; - j := 0; - WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END; - DEC(i); - WHILE name[i] # "/" DO DEC(i) END; + IF finalName[0]='/' THEN COPY(finalName, name) ELSE MakeFileName(Platform.CWD, finalName, name) END; + i := Strings.Length(name)-1; + WHILE (i > 0) & (name[i] # '/') DO DEC(i) END; + IF i+16 >= LEN(name) THEN Err("File name too long", NIL, 0) END; + INC(tempno); n := tempno; name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6); WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; name[i] := "."; INC(i); n := Platform.PID; @@ -181,7 +174,7 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files error := Platform.New(f.workName, f.fd); done := error = 0; IF done THEN - f.next := files; files := f; (* Link this file into the list of OS bakced files. *) + f.next := files; files := f; (* Link this file into the list of OS backed files. *) INC(Heap.FileCount); Heap.RegisterFinalizer(f, Finalize); f.state := open; @@ -420,6 +413,12 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files END END Read; + (* wrapper for compatibility with Project Oberon sources *) + PROCEDURE ReadByte*(VAR r: Rider; VAR x: SYSTEM.BYTE); + BEGIN + Read(r, x) + END ReadByte; + PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT); VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; BEGIN @@ -679,7 +678,15 @@ Especially Length would become fairly complex. PROCEDURE WriteSet* (VAR R: Rider; x: SET); VAR b: ARRAY 4 OF CHAR; i: LONGINT; - BEGIN i := SYSTEM.VAL(LONGINT, x); + y: SYSTEM.SET64; + BEGIN + IF SIZE(SET) = SIZE(INTEGER) THEN + i := SYSTEM.VAL(INTEGER, x); + ELSE + y := x; + i := SYSTEM.VAL(LONGINT, y); + END; + b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H); WriteBytes(R, b, 4); END WriteSet; @@ -751,4 +758,6 @@ BEGIN tempno := -1; Heap.FileCount := 0; HOME := ""; Platform.GetEnv("HOME", HOME); + MaxPathLength := Platform.MaxPathLength(); + MaxNameLength := Platform.MaxNameLength(); END Files. diff --git a/src/runtime/Heap.Mod b/src/runtime/Heap.Mod index c5a5a977..4c57fa3c 100644 --- a/src/runtime/Heap.Mod +++ b/src/runtime/Heap.Mod @@ -4,12 +4,12 @@ MODULE Heap; before any other modules are initialized. *) CONST - ModNameLen = 20; - CmdNameLen = 24; - SZA = SIZE(S.ADDRESS); (* Size of address *) - Unit = 4*SZA; (* smallest possible heap block *) - nofLists = 9; (* number of freelist entries excluding sentinel *) - heapSize0 = 8000*Unit; (* startup heap size *) + ModNameLen = 20; + CmdNameLen = 24; + SZA = SIZE(S.ADDRESS); (* Size of address *) + Unit = 4*SZA; (* Smallest possible heap block *) + nofLists = 9; (* Number of freelist entries excluding sentinel *) + heapSize0 = 8000*Unit; (* Startup heap size *) (* all blocks look the same: free blocks describe themselves: size = Unit @@ -78,17 +78,20 @@ MODULE Heap; bigBlocks: S.ADDRESS; allocated*: S.ADDRESS; firstTry: BOOLEAN; + ldUnit: INTEGER; (* Unit = 2^ldUnit, for unsigned division expressed as logical shift right *) + (* extensible heap *) - heap-: S.ADDRESS; (* the sorted list of heap chunks *) - heapMin: S.ADDRESS; (* Range of valid pointer values, used for stack collection *) - heapMax: S.ADDRESS; - heapsize*: S.ADDRESS; (* the sum of all heap chunk sizes *) + heap-: S.ADDRESS; (* the sorted list of heap chunks *) + heapMin: S.ADDRESS; (* Range of valid pointer values, used for stack collection *) + heapMax: S.ADDRESS; + heapsize*: S.ADDRESS; (* the sum of all heap chunk sizes *) + heapMinExpand*: S.ADDRESS; (* minimum heap expansion size *) (* finalization candidates *) fin: FinNode; - (* garbage collector locking *) + (* garbage collector busy flag *) lockdepth: INTEGER; interrupted: BOOLEAN; @@ -210,8 +213,9 @@ MODULE Heap; PROCEDURE ExtendHeap(blksz: S.ADDRESS); VAR size, chnk, j, next: S.ADDRESS; BEGIN - IF uLT(10000*Unit, blksz) THEN size := blksz - ELSE size := 10000*Unit (* additional heuristics *) + ASSERT(blksz MOD Unit = 0); + IF uLT(heapMinExpand, blksz) THEN size := blksz + ELSE size := heapMinExpand (* additional heuristics for avoiding many small heap expansions *) END; chnk := NewChunk(size); IF chnk # 0 THEN @@ -226,6 +230,12 @@ MODULE Heap; END; S.PUT(chnk, next); S.PUT(j, chnk) END + ELSIF ~firstTry THEN + (* Heap memory exhausted, i.e. heap is not expanded and NEWREC() will return NIL. + In order to be able to report a trap due to NIL access, there is more + memory needed, which may be available by reducing heapMinExpand. *) + heapMinExpand := Unit + (* ELSE firstTry: ignore failed heap expansion for anti-thrashing heuristics. *) END END ExtendHeap; @@ -239,15 +249,15 @@ MODULE Heap; Lock(); S.GET(tag, blksz); - ASSERT((Unit = 16) OR (Unit = 32)); ASSERT(SIZE(S.PTR) = SIZE(S.ADDRESS)); ASSERT(blksz MOD Unit = 0); - i0 := blksz DIV Unit; i := i0; - IF uLT(i, nofLists) THEN adr := freeList[i]; + i0 := S.LSH(blksz, -ldUnit); (*uDIV Unit*) + i := i0; + IF i < nofLists THEN adr := freeList[i]; WHILE adr = 0 DO INC(i); adr := freeList[i] END END; - IF uLT(i, nofLists) THEN (* Unlink from freelist[i] *) + IF i < nofLists THEN (* Unlink from freelist[i] *) S.GET(adr + nextOff, next); freeList[i] := next; IF i # i0 THEN (* Split *) @@ -266,18 +276,17 @@ MODULE Heap; IF adr = 0 THEN (* Nothing free *) IF firstTry THEN GC(TRUE); INC(blksz, Unit); - IF uLT(heapsize - allocated, blksz) - OR uLT((heapsize - allocated - blksz) * 4, heapsize) THEN - (* heap would still be more than 3/4 full; expand to avoid thrashing *) - ExtendHeap((allocated + blksz) DIV (3*Unit) * (4*Unit) - heapsize) + (* Anti-thrashing heuristics: ensure 1/5 of the heap will not be allocated. *) + t := S.LSH(allocated + blksz, -(2+ldUnit)) (*uDIV 4*Unit*) * (5*Unit) ; (* Minimum preferred heapsize *) + IF uLT(heapsize, t) THEN ExtendHeap(t - heapsize) + (* If there is not enough heap memory then the heap will be expanded below by blksz *) END; - firstTry := FALSE; new := NEWREC(tag); firstTry := TRUE; - IF new = NIL THEN - (* depending on the fragmentation, the heap may not have been extended by - the anti-thrashing heuristics above *) - ExtendHeap((allocated + blksz) DIV (3*Unit) * (4*Unit) - heapsize); - new := NEWREC(tag); (* will find a free block if heap has been expanded properly *) + firstTry := FALSE; new := NEWREC(tag); + IF new = NIL THEN (* Heap is 1/5 free but fragmentation prevented allocation *) + ExtendHeap(blksz); + new := NEWREC(tag) (* Will find a free block if heap has been expanded successfully *) END; + firstTry := TRUE; Unlock(); RETURN new ELSE Unlock(); RETURN NIL @@ -398,7 +407,8 @@ MODULE Heap; S.PUT(start, start+SZA); S.PUT(start+sizeOff, freesize); S.PUT(start+sntlOff, NoPtrSntl); - i := freesize DIV Unit; freesize := 0; + i := S.LSH(freesize, -ldUnit) (*uDIV Unit*); + freesize := 0; IF uLT(i, nofLists) THEN S.PUT(start + nextOff, freeList[i]); freeList[i] := start ELSE S.PUT(start + nextOff, bigBlocks); bigBlocks := start END @@ -419,7 +429,8 @@ MODULE Heap; S.PUT(start, start+SZA); S.PUT(start+sizeOff, freesize); S.PUT(start+sntlOff, NoPtrSntl); - i := freesize DIV Unit; freesize := 0; + i := S.LSH(freesize, -ldUnit) (*uDIV Unit*); + freesize := 0; IF uLT(i, nofLists) THEN S.PUT(start + nextOff, freeList[i]); freeList[i] := start ELSE S.PUT(start + nextOff, bigBlocks); bigBlocks := start END @@ -538,6 +549,8 @@ MODULE Heap; END END MarkStack; + + PROCEDURE GC*(markStack: BOOLEAN); VAR m: Module; @@ -545,34 +558,37 @@ MODULE Heap; i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23: S.ADDRESS; cand: ARRAY 10000 OF S.ADDRESS; BEGIN - IF (lockdepth = 0) OR (lockdepth = 1) & ~markStack THEN - Lock(); - m := S.VAL(Module, modules); - WHILE m # NIL DO - IF m.enumPtrs # NIL THEN m.enumPtrs(MarkP) END; - m := m^.next + Lock(); + m := S.VAL(Module, modules); + WHILE m # NIL DO + IF m.enumPtrs # NIL THEN m.enumPtrs(MarkP) END; + m := m^.next + END; + IF markStack THEN + (* generate register pressure to force callee saved registers to memory; + may be simplified by inlining OS calls or processor specific instructions + *) + 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; + LOOP + INC(i0, 1); INC(i1, 2); INC(i2, 3); INC(i3, 4); INC(i4, 5); INC(i5, 6); INC(i6, 7); INC(i7, 8); + INC(i8, 9); INC(i9, 10); INC(i10, 11); INC(i11, 12); INC(i12, 13); INC(i13, 14); INC(i14, 15); INC(i15, 16); + INC(i16, 17); INC(i17, 18); INC(i18, 19); INC(i19, 20); INC(i20, 21); INC(i21, 22); INC(i22, 23); INC(i23, 24); + IF (i0 = -99) & (i15 = 24) THEN (* True at first iteration *) + MarkStack(32, cand); EXIT + END END; - IF markStack THEN - (* generate register pressure to force callee saved registers to memory; - may be simplified by inlining OS calls or processor specific instructions - *) - 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; - LOOP INC(i0, 1); INC(i1, 2); INC(i2, 3); INC(i3, 4); INC(i4, 5); INC(i5, 6); INC(i6, 7); INC(i7, 8); - INC(i8, 9); INC(i9, 10); INC(i10, 11); INC(i11, 12); INC(i12, 13); INC(i13, 14); INC(i14, 15); INC(i15, 16); - INC(i16, 17); INC(i17, 18); INC(i18, 19); INC(i19, 20); INC(i20, 21); INC(i21, 22); INC(i22, 23); INC(i23, 24); - IF (i0 = -99) & (i15 = 24) THEN MarkStack(32, cand); EXIT END - END; - 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 THEN RETURN (* use all variables *) - END; + IF i0 + i1 + i2 + i3 + i4 + i5 + i6 + i7 (* use all variables *) + + i8 + i9 + i10 + i11 + i12 + i13 + i14 + i15 + + i16 + i17 + i18 + i19 + i20 + i21 + i22 + i23 > 10000 THEN (* Always false *) + RETURN END; - CheckFin; - Scan; - Finalize; - Unlock() - END + END; + CheckFin; + Scan; + Finalize; + Unlock() END GC; PROCEDURE RegisterFinalizer*(obj: S.PTR; finalize: Finalizer); @@ -590,13 +606,17 @@ MODULE Heap; (* InitHeap is called by Platform.init before any module bodies have been initialised, to enable NEW, S.NEW *) BEGIN - heap := 0; - heapsize := 0; - allocated := 0; - lockdepth := 0; - heapMin := -1; (* all bits set *) - heapMax := 0; - bigBlocks := 0; + heap := 0; + heapsize := 0; + allocated := 0; + lockdepth := 0; + heapMin := -1; (* all bits set = max unsigned value *) + heapMax := 0; + bigBlocks := 0; + heapMinExpand := heapSize0; + + ASSERT((Unit = 16) OR (Unit = 32)); + IF Unit = 16 THEN ldUnit := 4 ELSE ldUnit := 5 END; heap := NewChunk(heapSize0); S.PUT(heap + nextChnkOff, AddressZero); diff --git a/src/runtime/In.Mod b/src/runtime/In.Mod index 873a00d9..76ceb1e8 100644 --- a/src/runtime/In.Mod +++ b/src/runtime/In.Mod @@ -1,6 +1,6 @@ MODULE In; -IMPORT Platform, SYSTEM, Out; +IMPORT Platform, SYSTEM, Strings, Out; VAR Done-: BOOLEAN; @@ -99,14 +99,6 @@ VAR h: HUGEINT; BEGIN HugeInt(h); i := SYSTEM.VAL(LONGINT, h) END LongInt; -PROCEDURE Real*(VAR x: REAL); -BEGIN HALT(99) (* Not implemented *) -END Real; - -PROCEDURE LongReal*(VAR y: LONGREAL); -BEGIN HALT(99) (* Not implemented *) -END LongReal; - PROCEDURE Line*(VAR line: ARRAY OF CHAR); VAR i: INTEGER; BEGIN StartRead; i := 0; Done := readstate = ready; @@ -144,6 +136,24 @@ PROCEDURE Name*(VAR name: ARRAY OF CHAR); (* Read filename. Presumably using she BEGIN HALT(99) (* Not implemented *) END Name; +PROCEDURE Real*(VAR x: REAL); +VAR + str: ARRAY 16 OF CHAR; +BEGIN + Line(str); + Strings.StrToReal(str, x); +END Real; + +PROCEDURE LongReal*(VAR y: LONGREAL); +VAR + str: ARRAY 16 OF CHAR; +BEGIN + Line(str); + Strings.StrToLongReal(str, y); +END LongReal; + + + BEGIN nextch := 0X; readstate := pending; diff --git a/src/runtime/Math.Mod b/src/runtime/Math.Mod index b3ca4e6a..0d1d61f5 100644 --- a/src/runtime/Math.Mod +++ b/src/runtime/Math.Mod @@ -741,6 +741,32 @@ BEGIN t := ABS(x); RETURN arcsinh(x/sqrt(ONE - x * x)) END arctanh; +PROCEDURE fcmp* (x, y, epsilon: REAL): INTEGER; +(* fcmp: this procedure determines whether `x` and `y` are approximately equal + to a relative accuracy `epsilon`. + References: + The implementation is based on the GNU Scientific Library (GSL). + https://www.gnu.org/software/gsl/doc/html/math.html#approximate-comparison-of-floating-point-numbers +*) +VAR max, exponent0, delta, difference: REAL; +BEGIN + IF ABS(x) > ABS(y) THEN + max := x; + ELSE + max := y; + END; + exponent0 := exponent(max); + delta := 2.0*epsilon*power(2.0, exponent0); + difference := x - y; + IF difference > delta THEN + RETURN 1; + ELSIF difference < -delta THEN + RETURN -1; + ELSE + RETURN 0; (* approximately equal *) + END; +END fcmp; + PROCEDURE ToREAL(h: HUGEINT): REAL; BEGIN RETURN SYSTEM.VAL(REAL, h) END ToREAL; diff --git a/src/runtime/MathL.Mod b/src/runtime/MathL.Mod index bd17b490..b1448dc0 100644 --- a/src/runtime/MathL.Mod +++ b/src/runtime/MathL.Mod @@ -665,6 +665,32 @@ BEGIN t := ABS(x); RETURN arcsinh(x/sqrt(ONE-x*x)) END arctanh; +PROCEDURE fcmp* (x, y, epsilon: LONGREAL): INTEGER; +(* fcmp: this procedure determines whether `x` and `y` are approximately equal + to a relative accuracy `epsilon`. + References: + The implementation is based on the GNU Scientific Library (GSL). + https://www.gnu.org/software/gsl/doc/html/math.html#approximate-comparison-of-floating-point-numbers +*) +VAR max, exponent0, delta, difference: LONGREAL; +BEGIN + IF ABS(x) > ABS(y) THEN + max := x; + ELSE + max := y; + END; + exponent0 := exponent(max); + delta := 2.0D0*epsilon*power(2.0D0, exponent0); + difference := x - y; + IF difference > delta THEN + RETURN 1; + ELSIF difference < -delta THEN + RETURN -1; + ELSE + RETURN 0; (* approximately equal *) + END; +END fcmp; + PROCEDURE ToLONGREAL(h: HUGEINT): LONGREAL; BEGIN RETURN SYSTEM.VAL(LONGREAL, h) END ToLONGREAL; diff --git a/src/runtime/Out.Mod b/src/runtime/Out.Mod index bdb6b8df..8895037c 100644 --- a/src/runtime/Out.Mod +++ b/src/runtime/Out.Mod @@ -1,4 +1,7 @@ MODULE Out; (* DCW Brown. 2016-09-27 *) + (** Module Out provides a set of basic routines + for formatted output of characters, numbers, and strings. + It assumes a standard output stream to which the symbols are written. *) IMPORT SYSTEM, Platform, Heap; @@ -16,11 +19,11 @@ BEGIN IF in > 0 THEN error := Platform.Write(Platform.StdOut, SYSTEM.ADR(buf), in) END; in := 0; END Flush; - +(** Initializes the output stream. In this library does nothing, safe to never use. *) PROCEDURE Open*; BEGIN END Open; - +(** Writes the character to the end of the output stream. *) PROCEDURE Char*(ch: CHAR); BEGIN IF in >= LEN(buf) THEN Flush END; @@ -32,7 +35,7 @@ PROCEDURE Length(VAR s: ARRAY OF CHAR): LONGINT; VAR l: LONGINT; BEGIN l := 0; WHILE (l < LEN(s)) & (s[l] # 0X) DO INC(l) END; RETURN l END Length; - +(** Writes the null-terminated character sequence str to the end of the output stream (without 0X). *) PROCEDURE String*(str: ARRAY OF CHAR); VAR l: LONGINT; error: Platform.ErrorCode; BEGIN @@ -46,7 +49,10 @@ BEGIN END END String; - +(** Writes the integer number x to the end of the output stream. + If the textual representation of x requires m characters, + x is right adjusted in a field of Max(n, m) characters + padded with blanks at the left end. a plus sign is not written. *) PROCEDURE Int*(x, n: HUGEINT); CONST zero = ORD('0'); VAR s: ARRAY 22 OF CHAR; i: INTEGER; negative: BOOLEAN; @@ -82,7 +88,7 @@ BEGIN ELSE Char(CHR((x MOD 16) - 10 + ORD('A'))) END END END Hex; - +(** Writes an end-of-line symbol to the end of the output stream *) PROCEDURE Ln*; BEGIN String(Platform.NL); Flush; END Ln; @@ -117,14 +123,15 @@ END Ten; PROCEDURE -Entier64(x: LONGREAL): SYSTEM.INT64 "(INT64)(x)"; -PROCEDURE RealP(x: LONGREAL; n: INTEGER; long: BOOLEAN); - -(* RealP(x, n) writes the long real number x to the end of the output stream using an +(** RealP(x, n) writes the long real number x to the end of the output stream using an exponential form. If the textual representation of x requires m characters (including a three-digit signed exponent), x is right adjusted in a field of Max(n, m) characters padded with blanks at the left end. A plus sign of the mantissa is not written. LONGREAL is 1/sign, 11/exponent, 52/significand *) +PROCEDURE RealP(x: LONGREAL; n: INTEGER; long: BOOLEAN); + + VAR e: INTEGER; (* Exponent field *) f: HUGEINT; (* Fraction field *) @@ -212,11 +219,18 @@ BEGIN WHILE i < LEN(s) DO Char(s[i]); INC(i) END END RealP; - +(** Writes the real number x to the end of the output stream using an exponential + form. If the textual representation of x requires m characters (including a + two-digit signed exponent), x is right adjusted in a field of Max(n, m) characters + padded with blanks at the left end. A plus sign of the mantissa is not written.*) PROCEDURE Real*(x: REAL; n: INTEGER); BEGIN RealP(x, n, FALSE); END Real; +(** Writes the long real number x to the end of the output stream using an exponential form. + If the textual representation of x requires m characters (including a three-digit + signed exponent), x is right adjusted in a field of Max(n, m) characters padded + with blanks at the left end. A plus sign of the mantissa is not written. *) PROCEDURE LongReal*(x: LONGREAL; n: INTEGER); BEGIN RealP(x, n, TRUE); END LongReal; @@ -224,4 +238,10 @@ END LongReal; BEGIN IsConsole := Platform.IsConsole(Platform.StdOut); in := 0 + +(** This module originally was designed by Martin Reiser + for the book "Programming in Oberon". + the specification was proposed by H. Moessenbock *) + END Out. + diff --git a/src/runtime/Platformunix.Mod b/src/runtime/Platformunix.Mod index ff03a960..bcf11137 100644 --- a/src/runtime/Platformunix.Mod +++ b/src/runtime/Platformunix.Mod @@ -44,6 +44,7 @@ PROCEDURE -Aincludeerrno '#include '; PROCEDURE -Astdlib '#include '; PROCEDURE -Astdio '#include '; PROCEDURE -Aerrno '#include '; +PROCEDURE -Alimits '#include '; @@ -66,7 +67,6 @@ PROCEDURE -EINTR(): ErrorCode 'EINTR'; - PROCEDURE TooManyFiles*(e: ErrorCode): BOOLEAN; BEGIN RETURN (e = EMFILE()) OR (e = ENFILE()) END TooManyFiles; @@ -95,6 +95,17 @@ BEGIN RETURN e = EINTR() END Interrupted; +(* Expose file and path name length limits *) + +PROCEDURE -NAMEMAX(): INTEGER 'NAME_MAX'; +PROCEDURE -PATHMAX(): INTEGER 'PATH_MAX'; + +PROCEDURE MaxNameLength*(): INTEGER; BEGIN RETURN NAMEMAX() END MaxNameLength; +PROCEDURE MaxPathLength*(): INTEGER; BEGIN RETURN PATHMAX() END MaxPathLength; + + + + (* OS memory allocaton *) PROCEDURE -allocate (size: SYSTEM.ADDRESS): SYSTEM.ADDRESS "(ADDRESS)((void*)malloc((size_t)size))"; diff --git a/src/runtime/Platformwindows.Mod b/src/runtime/Platformwindows.Mod index 4087c75b..63c90a69 100644 --- a/src/runtime/Platformwindows.Mod +++ b/src/runtime/Platformwindows.Mod @@ -91,6 +91,17 @@ BEGIN RETURN e = EINTR() END Interrupted; + +(* Expose file and path name length limits (same on Windows) *) + +PROCEDURE -MAXPATH(): INTEGER 'MAX_PATH'; + +PROCEDURE MaxNameLength*(): INTEGER; BEGIN RETURN MAXPATH() END MaxNameLength; +PROCEDURE MaxPathLength*(): INTEGER; BEGIN RETURN MAXPATH() END MaxPathLength; + + + + (* OS memory allocaton *) PROCEDURE -allocate(size: SYSTEM.ADDRESS): SYSTEM.ADDRESS "(ADDRESS)((void*)HeapAlloc(GetProcessHeap(), 0, (size_t)size))"; diff --git a/src/runtime/SYSTEM.c b/src/runtime/SYSTEM.c index a1b2cb14..2952bb66 100644 --- a/src/runtime/SYSTEM.c +++ b/src/runtime/SYSTEM.c @@ -151,53 +151,61 @@ SYSTEM_PTR SYSTEM_NEWARR(ADDRESS *typ, ADDRESS elemsz, int elemalgn, int nofdim, return x; } - - - typedef void (*SystemSignalHandler)(INT32); // = Platform_SignalHandler #ifndef _WIN32 + // Unix signal handling + SystemSignalHandler handler[10] = {0}; // Adjust the array size to include signal 11 - SystemSignalHandler handler[3] = {0}; - - // Provide signal handling for Unix based systems + void segfaultHandler(int signal) { + __HALT(-10); + } + // Revised signal handler to accommodate additional signals like SIGSEGV void signalHandler(int s) { - if (s >= 2 && s <= 4) handler[s-2](s); - // (Ignore other signals) + if ((s >= 2 && s <= 4) || s == 11) { // Include SIGSEGV (usually signal 11) + if (handler[s-2]) { + handler[s-2](s); + } + } + // Ignore other signals } void SystemSetHandler(int s, ADDRESS h) { - if (s >= 2 && s <= 4) { + if ((s >= 2 && s <= 4) || s == 11) { int needtosetsystemhandler = handler[s-2] == 0; handler[s-2] = (SystemSignalHandler)h; - if (needtosetsystemhandler) {signal(s, signalHandler);} + if (needtosetsystemhandler) { + signal(s, signalHandler); + } } } -#else + void setupAutomaticSegfaultHandler() { + SystemSetHandler(11, (ADDRESS)segfaultHandler); // Register handler for SIGSEGV + } - // Provides Windows callback handlers for signal-like scenarios +#else + // Windows system remains as is since Windows does not use SIGSEGV in the same way #include "WindowsWrapper.h" SystemSignalHandler SystemInterruptHandler = 0; - SystemSignalHandler SystemQuitHandler = 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 + SystemInterruptHandler(2); // SIGINT return TRUE; } - } else { // Close, logoff or shutdown + } else { if (SystemQuitHandler) { - SystemQuitHandler(3); // SIGQUIT + SystemQuitHandler(3); // SIGQUIT return TRUE; } } return FALSE; } - void EnsureConsoleCtrlHandler() { if (!ConsoleCtrlHandlerSet) { SetConsoleCtrlHandler(SystemConsoleCtrlHandler, TRUE); @@ -216,3 +224,4 @@ typedef void (*SystemSignalHandler)(INT32); // = Platform_SignalHandler } #endif + diff --git a/src/runtime/SYSTEM.h b/src/runtime/SYSTEM.h index f6936068..39d594ed 100644 --- a/src/runtime/SYSTEM.h +++ b/src/runtime/SYSTEM.h @@ -19,7 +19,11 @@ typedef unsigned long size_t; #endif #else - typedef unsigned int size_t; + #if defined(__OpenBSD__) + typedef unsigned long size_t; + #else + typedef unsigned int size_t; + #endif #endif #define _SIZE_T_DECLARED // For FreeBSD @@ -112,9 +116,11 @@ extern void Modules_AssertFail(INT32 x); // Index checking -static inline INT64 __XF(UINT64 i, UINT64 ub) {if (i >= ub) {__HALT(-2);} return i;} -#define __X(i, ub) (((i)<(ub))?i:(__HALT(-2),0)) - +static inline INT64 __XF(INT64 i, UINT64 ub) { + if (i < 0 || (UINT64)i >= ub) __HALT(-2); + return i; +} +#define __X(i, ub) (((i) >= 0 && (i) < (ub)) ? (i) : (__HALT(-2),0)) // Range checking, and checked SHORT and CHR functions @@ -261,7 +267,12 @@ extern void Heap_INCREF(); extern void Modules_Init(INT32 argc, ADDRESS argv); extern void Heap_FINALL(); +extern void setupAutomaticSegfaultHandler(); +#ifndef _WIN32 +#define __INIT(argc, argv) static void *m; setupAutomaticSegfaultHandler(); Modules_Init(argc, (ADDRESS)&argv); +#else #define __INIT(argc, argv) static void *m; Modules_Init(argc, (ADDRESS)&argv); +#endif #define __REGMAIN(name, enum) m = Heap_REGMOD((CHAR*)name,enum) #define __FINI Heap_FINALL(); return 0 diff --git a/src/runtime/Strings.Mod b/src/runtime/Strings.Mod index 0dcfa6d2..89dcaa33 100644 --- a/src/runtime/Strings.Mod +++ b/src/runtime/Strings.Mod @@ -28,8 +28,8 @@ Strings.Cap(s) replaces each lower case letter in s by its upper case equivalent. -------------------------------------------------------------*) (* added from trianus v4 *) -MODULE Strings; (*HM 94-06-22 / *) - +MODULE Strings; (*HM 94-06-22 / *) (* noch 2017-06-21 *) +IMPORT Reals; PROCEDURE Length* (s: ARRAY OF CHAR): INTEGER; VAR i: LONGINT; @@ -153,4 +153,74 @@ BEGIN RETURN M(string, pattern, Length(string)-1, Length(pattern)-1) END Match; +PROCEDURE StrToReal*(s: ARRAY OF CHAR; VAR r: REAL); +VAR p, e: INTEGER; y, g: REAL; neg, negE: BOOLEAN; +BEGIN + p := 0; + WHILE (s[p] = " ") OR (s[p] = "0") DO INC(p) END; + IF s[p] = "-" THEN neg := TRUE; INC(p) ELSE neg := FALSE END; + WHILE (s[p] = " ") OR (s[p] = "0") DO INC(p) END; + + y := 0; + WHILE ("0" <= s[p]) & (s[p] <= "9") DO + y := y * 10 + (ORD(s[p]) - 30H); + INC(p); + END; + IF s[p] = "." THEN + INC(p); g := 1; + WHILE ("0" <= s[p]) & (s[p] <= "9") DO + g := g / 10; y := y + g * (ORD(s[p]) - 30H); + INC(p); + END; + END; + IF (s[p] = "D") OR (s[p] = "E") THEN + INC(p); e := 0; + IF s[p] = "-" THEN negE := TRUE; INC(p) ELSE negE := FALSE END; + WHILE (s[p] = "0") DO INC(p) END; + WHILE ("0" <= s[p]) & (s[p] <= "9") DO + e := e * 10 + (ORD(s[p]) - 30H); + INC(p); + END; + IF negE THEN y := y / Reals.Ten(e) + ELSE y := y * Reals.Ten(e) END; + END; + IF neg THEN y := -y END; + r := y; +END StrToReal; + +PROCEDURE StrToLongReal*(s: ARRAY OF CHAR; VAR r: LONGREAL); +VAR p, e: INTEGER; y, g: LONGREAL; neg, negE: BOOLEAN; +BEGIN + p := 0; + WHILE (s[p] = " ") OR (s[p] = "0") DO INC(p) END; + IF s[p] = "-" THEN neg := TRUE; INC(p) ELSE neg := FALSE END; + WHILE (s[p] = " ") OR (s[p] = "0") DO INC(p) END; + + y := 0; + WHILE ("0" <= s[p]) & (s[p] <= "9") DO + y := y * 10 + (ORD(s[p]) - 30H); + INC(p); + END; + IF s[p] = "." THEN + INC(p); g := 1; + WHILE ("0" <= s[p]) & (s[p] <= "9") DO + g := g / 10; y := y + g * (ORD(s[p]) - 30H); + INC(p); + END; + END; + IF (s[p] = "D") OR (s[p] = "E") THEN + INC(p); e := 0; + IF s[p] = "-" THEN negE := TRUE; INC(p) ELSE negE := FALSE END; + WHILE (s[p] = "0") DO INC(p) END; + WHILE ("0" <= s[p]) & (s[p] <= "9") DO + e := e * 10 + (ORD(s[p]) - 30H); + INC(p); + END; + IF negE THEN y := y / Reals.Ten(e) + ELSE y := y * Reals.Ten(e) END; + END; + IF neg THEN y := -y END; + r := y; +END StrToLongReal; + END Strings. diff --git a/src/runtime/Texts.Mod b/src/runtime/Texts.Mod index 5b645fc4..aba83032 100644 --- a/src/runtime/Texts.Mod +++ b/src/runtime/Texts.Mod @@ -1,6 +1,6 @@ MODULE Texts; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91**) (* << RC, MB, JT *) IMPORT - Files, Modules, Reals, SYSTEM, Out; + Files, Modules, Reals, SYSTEM; (*--- insert field e: Elem into Texts.Scanner and change Texts.Scan to set it in case of class=6 *) diff --git a/src/runtime/VT100.Mod b/src/runtime/VT100.Mod index 03cc1d2c..6687ed02 100644 --- a/src/runtime/VT100.Mod +++ b/src/runtime/VT100.Mod @@ -168,8 +168,15 @@ CONST END EscSeq2; - - + PROCEDURE Reset*; + VAR + cmd : ARRAY 6 OF CHAR; + BEGIN + COPY(Escape, cmd); + Strings.Append("c", cmd); + Out.String(cmd); + Out.Ln; + END Reset; (* Cursor up moves cursor n cells in the given direction. if the cursor is already at the edge of the screen, this has no effect *) diff --git a/src/test/confidence/lola/test.sh b/src/test/confidence/lola/test.sh index 315d6d8e..3571e536 100755 --- a/src/test/confidence/lola/test.sh +++ b/src/test/confidence/lola/test.sh @@ -1,5 +1,9 @@ #!/bin/sh . ../testenv.sh -$OBECOMP LSS.Mod LSB.Mod LSC.Mod LSV.Mod lola.Mod -m +$OBECOMP LSS.Mod +$OBECOMP LSB.Mod +$OBECOMP LSC.Mod +$OBECOMP LSV.Mod +$OBECOMP lola.Mod -m ./Lola RISC5.Lola result . ../testresult.sh diff --git a/src/test/confidence/testenv.sh b/src/test/confidence/testenv.sh index de1630fa..e0a157ee 100755 --- a/src/test/confidence/testenv.sh +++ b/src/test/confidence/testenv.sh @@ -2,25 +2,20 @@ ## '.' this file from individual test.sh files. #set -e -echo --- Confidence test $(basename $PWD) --- +echo --- Confidence test $(basename "$PWD") --- if which cygpath >/dev/null 2>/dev/null -then export PATH="$(cygpath "$1")/bin":$PATH -else export PATH="$1/bin":$PATH +then export PATH="$(cygpath "$1")/bin":"$PATH" +else export PATH="$1/bin":"$PATH" fi -# Set ibrary paths for darwin and termux(android) +# Set library paths for darwin and termux(android) export DYLD_LIBRARY_PATH=$1/lib:$DYLD_LIBRARY_PATH export LD_LIBRARY_PATH=$1/lib:$LD_LIBRARY_PATH -rm -f *.o *.obj *.exe *.sym *.c *.h result new.asm $(basename $PWD) +rm -f *.o *.obj *.exe *.sym *.c *.h result new.asm $(basename "$PWD") # Under gcc generate assembly source for source change test. -# NOTE: The following CFLAGS causes the assembler to write source -# to a single file. When there are multiple Mod files, each -# corresponding assembly file will overwrite the previous. I -# cannot see any way to overcome this short of using -S -# on the voc command and calling 'as' explicitly. -# NOTE 2: The cygwin 64 bit build has relocation errors with +# NOTE: The cygwin 64 bit build has relocation errors with # these assembly generation options. if [ "$COMPILER" = "gcc" -a "$FLAVOUR" != "cygwin.LP64.gcc" ] -then export CFLAGS="-gstabs -g1 -Wa,-acdhln=new.asm -Wl,-Map=output.map" +then export CFLAGS="-g1 -Wa,-acdhln=new.asm -Wl,-Map=output.map" fi diff --git a/src/test/md5/hello.txt b/src/test/md5/hello.txt new file mode 100644 index 00000000..980a0d5f --- /dev/null +++ b/src/test/md5/hello.txt @@ -0,0 +1 @@ +Hello World! diff --git a/src/test/md5/md5test.Mod b/src/test/md5/md5test.Mod new file mode 100644 index 00000000..a6e685fb --- /dev/null +++ b/src/test/md5/md5test.Mod @@ -0,0 +1,55 @@ +MODULE md5test; + IMPORT MD5 := ethMD5, Out, Files, Strings; +PROCEDURE dump(VAR arr: ARRAY OF CHAR); +VAR + i: INTEGER; + ch: CHAR; +BEGIN + i := 0; + REPEAT + Out.String("arr["); Out.Int(i, 0); Out.String("]="); Out.Int(ORD(arr[i]), 0);Out.Ln; + INC(i) + UNTIL i = Strings.Length(arr)+2 +END dump; + +PROCEDURE main; + VAR + context: MD5.Context; + digest: MD5.Digest; + hexDigest: ARRAY 33 OF CHAR; + F: Files.File; + R: Files.Rider; + input: POINTER TO ARRAY OF CHAR; + ilen: LONGINT; + ch: CHAR; + i: INTEGER; +BEGIN + F := Files.Old("hello.txt"); + IF F # NIL THEN + Files.Set(R, F, 0); + ilen := Files.Length(F); + Out.String("file length is "); Out.Int(ilen, 0); Out.Ln; + NEW(input, ilen+1); + i := 0; + REPEAT + Files.Read(R, ch); + input^[i] := ch; + INC(i) + UNTIL R.eof; + (*dump(input^);*) + END; + + context := MD5.New(); (* Initialize MD5 context *) + + (*MD5.WriteBytes(context, input^, Strings.Length(input^));*) (* Process input string *) + MD5.WriteBytes(context, input^, LEN(input^)-1); (* Process input string *) + MD5.Close(context, digest); (* Finalize and get digest *) + + MD5.ToString(digest, hexDigest); (* Convert digest to hex string *) + Out.String("MD5 Hash: "); Out.String(hexDigest); Out.Ln; +END main; + +BEGIN + main; +END md5test. + diff --git a/src/test/newt/newttest.Mod b/src/test/newt/newttest.Mod index 46d82a8e..ff673863 100644 --- a/src/test/newt/newttest.Mod +++ b/src/test/newt/newttest.Mod @@ -1,46 +1,50 @@ MODULE newttest; -IMPORT newt, oocIntStr, Unix; -VAR i, j, k : newt.Int32; -str : ARRAY 32 OF CHAR; -ch : CHAR; -fo, co : newt.Component; +IMPORT newt, oocIntStr, Platform; + +CONST delayTime = 1000; + +VAR + i, j, k : newt.Int32; + str : ARRAY 32 OF CHAR; + ch : CHAR; + fo, co : newt.Component; BEGIN -i := newt.Init(); -newt.Cls(); -str := "hello world!"; -newt.DrawRootText(5, 7, str); -newt.GetScreenSize(i, j); -oocIntStr.IntToStr(i, str); -newt.DrawRootText(5, 9, str); -str := "x"; -newt.DrawRootText(7, 9, "x"); -oocIntStr.IntToStr(j, str); -newt.DrawRootText(9, 9, str); + i := newt.Init(); + newt.Cls(); + str := "hello world!"; + newt.DrawRootText(5, 7, str); + newt.GetScreenSize(i, j); + oocIntStr.IntToStr(i, str); + newt.DrawRootText(5, 9, str); + str := "x"; + newt.DrawRootText(7, 9, "x"); + oocIntStr.IntToStr(j, str); + newt.DrawRootText(9, 9, str); -newt.PushHelpLine(""); -newt.Refresh(); -i := Unix.Sleep(1); + newt.PushHelpLine(""); + newt.Refresh(); + Platform.Delay(delayTime); -newt.PushHelpLine("A help line"); -newt.Refresh(); -i := Unix.Sleep(1); + newt.PushHelpLine("A help line"); + newt.Refresh(); + Platform.Delay(delayTime); -newt.PopHelpLine(); -newt.Refresh(); -i := Unix.Sleep(1); + newt.PopHelpLine(); + newt.Refresh(); + Platform.Delay(delayTime); -REPEAT -ch := newt.GetKey(); -str[0] := ch; -str[1] := 0X; -newt.DrawRootText(5, 5, str); -newt.PushHelpLine(str); -newt.Refresh; -UNTIL ch = ' '; + REPEAT + ch := newt.GetKey(); + str[0] := ch; + str[1] := 0X; + newt.DrawRootText(5, 5, str); + newt.PushHelpLine(str); + newt.Refresh; + UNTIL ch = ' '; -(* -newt.WaitForKey(); -newt.Delay(30);*) -i := newt.Finished(); + (* + newt.WaitForKey(); + newt.Delay(30);*) + i := newt.Finished(); END newttest. diff --git a/src/test/newt/newttest2.Mod b/src/test/newt/newttest2.Mod index 9cd02d99..a26248ab 100644 --- a/src/test/newt/newttest2.Mod +++ b/src/test/newt/newttest2.Mod @@ -1,6 +1,6 @@ MODULE newttest2; -IMPORT newt, oocIntStr, Unix; +IMPORT newt, oocIntStr; VAR i, j, k : newt.Int32; str : ARRAY 32 OF CHAR; form, b1, b2, comp: newt.Component; @@ -20,7 +20,7 @@ newt.FormAddComponent(form, b1); newt.FormAddComponent(form, b2); comp := newt.RunForm(form); newt.WaitForKey(); -newt.Delay(30); +newt.Delay(3000); newt.FormDestroy(form); i := newt.Finished(); END newttest2. diff --git a/src/test/server/s.Mod b/src/test/server/s.Mod index be04d59e..38a92496 100644 --- a/src/test/server/s.Mod +++ b/src/test/server/s.Mod @@ -4,7 +4,7 @@ IMPORT sockets, types, Out := Console, SYSTEM, Platform, Strings; PROCEDURE DoSmth(sock: Platform.FileHandle); -VAR +VAR str, aff: ARRAY 256 OF CHAR; n: LONGINT; BEGIN @@ -15,7 +15,7 @@ BEGIN ELSE str[n] := 0X; (* Make sure that received message is zero terminated *) Out.String("received message is "); Out.String(str); Out.Ln; - + IF Platform.Write(sock, SYSTEM.ADR(aff), Strings.Length(aff)) # 0 THEN Out.String("error writing to socket"); Out.Ln END; @@ -29,16 +29,17 @@ PROCEDURE -fork(): LONGINT "(LONGINT)fork()"; PROCEDURE serve; -CONST +CONST Port = 2055; MaxQueue = 5; -VAR +VAR sockfd: LONGINT; newsockfd: LONGINT; ServAddr: sockets.SockAddrIn; pid: LONGINT; res: Platform.ErrorCode; sockaddrlen: LONGINT; + ipAddr: LONGINT; ip: ARRAY 16 OF CHAR; BEGIN sockfd := sockets.Socket(sockets.AfInet, sockets.SockStream, 0); IF sockfd < 0 THEN @@ -47,15 +48,17 @@ BEGIN Out.String("socket created.") END; Out.Ln; + COPY("127.0.0.1", ip); + ipAddr := sockets.inetaddr(ip); - sockets.SetSockAddrIn(sockets.AfInet, Port, 0, ServAddr); + sockets.SetSockAddrIn(sockets.AfInet, Port, ipAddr, ServAddr); IF sockets.Bind(sockfd, SYSTEM.VAL(sockets.SockAddr, ServAddr), SIZE(sockets.SockAddr)) < 0 THEN Out.String("error on binding") ELSE Out.String("binding completed.") END; Out.Ln; - + IF sockets.Listen(sockfd, MaxQueue) # 0 THEN Out.String("listen() failed"); ELSE diff --git a/src/test/server/sockets.Mod b/src/test/server/sockets.Mod index 58ff3c24..ded7a61f 100644 --- a/src/test/server/sockets.Mod +++ b/src/test/server/sockets.Mod @@ -2,60 +2,60 @@ MODULE sockets; IMPORT SYSTEM, oocC; -CONST - SockStream* = 1; - SockDgram* = 2; - SockRaw* = 3; - SockRdm* = 4; - SockSeqpacket* = 5; - SockDccp* = 6; - SockPacket* = 10; - - AfUnscec* = 0; (* Unspecified. *) - AfLocal* = 1; (* Local to host (pipes and file-domain). *) - AfUnix* = 1; (* POSIX name for PF_LOCAL. *) - AfFile* = 1; (* Another non-standard name for PF_LOCAL. *) - AfInet* = 2; (* IP protocol family. *) - AfAx25* = 3; (* Amateur Radio AX.25. *) - AfIpx* = 4; (* Novell Internet Protocol. *) - AfAppletalk* = 5; (* Appletalk DDP. *) - AfNetrom* = 6; (* Amateur radio NetROM. *) - AfBridge* = 7; (* Multiprotocol bridge. *) - AfAtmpvc* = 8; (* ATM PVCs. *) - AfX25* = 9; (* Reserved for X.25 project. *) - AfInet6* = 10; (* IP version 6. *) - AfRose* = 11; (* Amateur Radio X.25 PLP. *) - AfDecnet* = 12; (* Reserved for DECnet project. *) - AfNetbeui* = 13; (* Reserved for 802.2LLC project. *) - AfSecurity* = 14; (* Security callback pseudo AF. *) - AfKey* = 15; (* PF_KEY key management API. *) - AfNetlink* = 16; - AfRoute* = 16; (* Alias to emulate 4.4BSD. *) - AfPacket = 17; (* Packet family. *) - AfAsh = 18; (* Ash. *) - AfEconet* = 19; (* Acorn Econet. *) - AfAtmsvc* = 20; (* ATM SVCs. *) - AfRds* = 21; (* RDS sockets. *) - AfSna = 22; (* Linux SNA Project *) - AfIrda* = 23; (* IRDA sockets. *) - AfPppox = 24; (* PPPoX sockets. *) - AfWanpipe* = 25; (* Wanpipe API sockets. *) - AfLlc* = 26; (* Linux LLC. *) - AfCan* = 29; (* Controller Area Network. *) - AfTipc* = 30; (* TIPC sockets. *) - AfBluetooth* = 31; (* Bluetooth sockets. *) - AfIucv* = 32; (* IUCV sockets. *) - AfRxrpc* = 33; (* RxRPC sockets. *) - AfIsdn* = 34; (* mISDN sockets. *) - AfPhonet* = 35; (* Phonet sockets. *) - AfIeee802154* = 36; (* IEEE 802.15.4 sockets. *) - AfCaif* = 37; (* CAIF sockets. *) - AfAlg* = 38; (* Algorithm sockets. *) - AfNfc* = 39; (* NFC sockets. *) - AfVsock* = 40; (* vSockets. *) - AfMax* = 41; (* For now.. *) - - InAddrAny* = 0; +CONST + SockStream* = 1; + SockDgram* = 2; + SockRaw* = 3; + SockRdm* = 4; + SockSeqpacket* = 5; + SockDccp* = 6; + SockPacket* = 10; + + AfUnscec* = 0; (* Unspecified. *) + AfLocal* = 1; (* Local to host (pipes and file-domain). *) + AfUnix* = 1; (* POSIX name for PF_LOCAL. *) + AfFile* = 1; (* Another non-standard name for PF_LOCAL. *) + AfInet* = 2; (* IP protocol family. *) + AfAx25* = 3; (* Amateur Radio AX.25. *) + AfIpx* = 4; (* Novell Internet Protocol. *) + AfAppletalk* = 5; (* Appletalk DDP. *) + AfNetrom* = 6; (* Amateur radio NetROM. *) + AfBridge* = 7; (* Multiprotocol bridge. *) + AfAtmpvc* = 8; (* ATM PVCs. *) + AfX25* = 9; (* Reserved for X.25 project. *) + AfInet6* = 10; (* IP version 6. *) + AfRose* = 11; (* Amateur Radio X.25 PLP. *) + AfDecnet* = 12; (* Reserved for DECnet project. *) + AfNetbeui* = 13; (* Reserved for 802.2LLC project. *) + AfSecurity* = 14; (* Security callback pseudo AF. *) + AfKey* = 15; (* PF_KEY key management API. *) + AfNetlink* = 16; + AfRoute* = 16; (* Alias to emulate 4.4BSD. *) + AfPacket = 17; (* Packet family. *) + AfAsh = 18; (* Ash. *) + AfEconet* = 19; (* Acorn Econet. *) + AfAtmsvc* = 20; (* ATM SVCs. *) + AfRds* = 21; (* RDS sockets. *) + AfSna = 22; (* Linux SNA Project *) + AfIrda* = 23; (* IRDA sockets. *) + AfPppox = 24; (* PPPoX sockets. *) + AfWanpipe* = 25; (* Wanpipe API sockets. *) + AfLlc* = 26; (* Linux LLC. *) + AfCan* = 29; (* Controller Area Network. *) + AfTipc* = 30; (* TIPC sockets. *) + AfBluetooth* = 31; (* Bluetooth sockets. *) + AfIucv* = 32; (* IUCV sockets. *) + AfRxrpc* = 33; (* RxRPC sockets. *) + AfIsdn* = 34; (* mISDN sockets. *) + AfPhonet* = 35; (* Phonet sockets. *) + AfIeee802154* = 36; (* IEEE 802.15.4 sockets. *) + AfCaif* = 37; (* CAIF sockets. *) + AfAlg* = 38; (* Algorithm sockets. *) + AfNfc* = 39; (* NFC sockets. *) + AfVsock* = 40; (* vSockets. *) + AfMax* = 41; (* For now.. *) + + InAddrAny* = 0; TYPE (* /usr/include/netinet/in.h *) @@ -70,13 +70,16 @@ TYPE SinZero*: ARRAY 8 OF CHAR; END; (* /usr/include/sys/socket.h *) - + SockAddr* = RECORD SaFamily*: oocC.shortint; SaData*: ARRAY 14 OF CHAR END; PROCEDURE -includesocket "#include "; + PROCEDURE -includeInet "#include "; + + PROCEDURE -inetaddr*(s: ARRAY OF CHAR): LONGINT "(LONGINT)inet_addr((char*)s)"; PROCEDURE -SetCShort(i: INTEGER; VAR si: oocC.shortint) "*(short*)si = i"; @@ -84,7 +87,7 @@ TYPE PROCEDURE -SetCShortSwapped(i: INTEGER; VAR si: oocC.shortint) "*(short*)si = ((i >> 8) & 0x00ff) | ((i << 8) & 0xff00)"; - PROCEDURE SetSockAddrIn*(family, port, inaddr: INTEGER; VAR sai: SockAddrIn); + PROCEDURE SetSockAddrIn*(family, port: INTEGER; inaddr: LONGINT; VAR sai: SockAddrIn); VAR i: INTEGER; BEGIN SetCShort(family, sai.SinFamily); diff --git a/src/test/sound/beep.Mod b/src/test/sound/beep.Mod index 6c53ed76..d8b30ae9 100644 --- a/src/test/sound/beep.Mod +++ b/src/test/sound/beep.Mod @@ -1,5 +1,5 @@ MODULE beep; -IMPORT Files, rm:=oocRealMath, Unix; +IMPORT Files, rm:=oocRealMath, Platform; CONST pi2=6.28318; (*pi2 = 6.2831802368164062;*) @@ -52,7 +52,7 @@ FOR i:=1 TO e DO END; Files.Register(outvar); -i:=Unix.System("oggenc -r -C 1 beepfile"); -i:=Unix.System("ogg123 beepfile.ogg"); +i:=Platform.System("oggenc -r -C 1 beepfile"); +i:=Platform.System("ogg123 beepfile.ogg"); END beep. diff --git a/src/test/texts/argTexts.Mod b/src/test/texts/argTexts.Mod new file mode 100644 index 00000000..644813d0 --- /dev/null +++ b/src/test/texts/argTexts.Mod @@ -0,0 +1,24 @@ +MODULE argTexts; (* example how to get arguments by using Texts module *) +IMPORT Texts, Oberon; + +VAR + S: Texts.Scanner; (* we'll read program arguments with it *) + + W : Texts.Writer; (* to write to console *) + T : Texts.Text; + +BEGIN + Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); + Texts.Scan(S); + (*Out.String(S.s); Out.Ln;*) + +Texts.OpenWriter (W); + +Texts.WriteString(W, "aaa"); +Texts.WriteLn(W); +Texts.WriteString(W, S.s); +Texts.WriteLn(W); +Texts.Append(Oberon.Log, W.buf); + + +END argTexts. diff --git a/src/test/x11/0/makefile b/src/test/x11/0/makefile index 67bf3938..c9b9aa5a 100644 --- a/src/test/x11/0/makefile +++ b/src/test/x11/0/makefile @@ -1,12 +1,12 @@ #for old systems like RHEL4 use #CFLAGS=-L/usr/X11R6/lib -lX11 +MODX11="../../../library/oocX11" CFLAGS=-lX11 export CFLAGS -MOD = MODULES="../../../lib/oocX11" VOC = $(MOD) /opt/voc/bin/voc all: - $(VOC) -s oocX11.Mod oocXutil.Mod oocXYplane.Mod test.Mod -m + $(VOC) -s $(MODX11)/oocX11.Mod $(MODX11)/oocXutil.Mod $(MODX11)/oocXYplane.Mod test.Mod -m #$(VOC) -Cm test.Mod #gcc -o test test.o -fPIC -g -I /opt/voc-1.0/src/lib/system/gcc/x86_64 -I /opt/voc-1.0/lib/voc/obj -lVishapOberon -L. -L/opt/voc-1.0/lib -lX11 diff --git a/src/test/x11/IFS/makefile b/src/test/x11/IFS/makefile index eda916b9..0e36987d 100644 --- a/src/test/x11/IFS/makefile +++ b/src/test/x11/IFS/makefile @@ -1,11 +1,10 @@ CFLAGS=-lX11 export CFLAGS - -MOD = MODULES="../../../lib/oocX11" +MODX11="../../../library/oocX11" VOC = $(MOD) /opt/voc/bin/voc all: - $(VOC) -s oocX11.Mod oocXutil.Mod oocXYplane.Mod IFS.Mod IFStest.Mod -m + $(VOC) -s $(MODX11)/oocX11.Mod $(MODX11)/oocXutil.Mod $(MODX11)/oocXYplane.Mod IFS.Mod IFStest.Mod -m #$(VOC) -Cm test.Mod #gcc -o test test.o -fPIC -g -I /opt/voc-1.0/src/lib/system/gcc/x86_64 -I /opt/voc-1.0/lib/voc/obj -lVishapOberon -L. -L/opt/voc-1.0/lib -lX11 diff --git a/src/test/x11/mines/makefile b/src/test/x11/mines/makefile index 02d5c8b4..f31fd926 100644 --- a/src/test/x11/mines/makefile +++ b/src/test/x11/mines/makefile @@ -3,11 +3,12 @@ CFLAGS=-lX11 export CFLAGS -MOD = MODULES="../../../lib/oocX11" +MODX11="../../../library/oocX11" + VOC = $(MOD) /opt/voc/bin/voc all: - $(VOC) -s oocX11.Mod oocXutil.Mod oocXYplane.Mod compatIn.Mod Linie.Mod Minesweeper.Mod -m + $(VOC) -s $(MODX11)/oocX11.Mod $(MODX11)/oocXutil.Mod $(MODX11)/oocXYplane.Mod compatIn.Mod Linie.Mod Minesweeper.Mod -m #$(VOC) -Cm test.Mod #gcc -o test test.o -fPIC -g -I /opt/voc-1.0/src/lib/system/gcc/x86_64 -I /opt/voc-1.0/lib/voc/obj -lVishapOberon -L. -L/opt/voc-1.0/lib -lX11 diff --git a/src/test/x11/pacman/makefile b/src/test/x11/pacman/makefile index 018f29c7..a90df273 100644 --- a/src/test/x11/pacman/makefile +++ b/src/test/x11/pacman/makefile @@ -3,11 +3,12 @@ CFLAGS=-lX11 export CFLAGS -MOD = MODULES="../../../lib/oocX11" +MODX11="../../../library/oocX11" + VOC = $(MOD) /opt/voc/bin/voc all: - $(VOC) -s oocX11.Mod oocXutil.Mod oocXYplane.Mod Grafik.Mod PacMan.Mod -m + $(VOC) -s $(MODX11)/oocX11.Mod $(MODX11)/oocXutil.Mod $(MODX11)/oocXYplane.Mod Grafik.Mod PacMan.Mod -m #$(VOC) -Cm test.Mod #gcc -o test test.o -fPIC -g -I /opt/voc-1.0/src/lib/system/gcc/x86_64 -I /opt/voc-1.0/lib/voc/obj -lVishapOberon -L. -L/opt/voc-1.0/lib -lX11 diff --git a/src/test/x11/tetris/Tetris.Mod b/src/test/x11/tetris/Tetris.Mod index a3468bd9..977d9ff4 100644 --- a/src/test/x11/tetris/Tetris.Mod +++ b/src/test/x11/tetris/Tetris.Mod @@ -5,7 +5,7 @@ MODULE Tetris; (* Neuerungen: Spielparameter sind ueber Konstantendeklariert, Zweispielermodus bricht bei Limit-Linien ab, Pause-Funktion wurde eingefuehrt *) -IMPORT X:=oocXYplane, L:=Linie, In := compatIn, Out := Console, RN:=ethRandomNumbers, Ziffer, Oberon := Kernel; +IMPORT X:=oocXYplane, L:=Linie, In := compatIn, Out := Console, RN:=ethRandomNumbers, Ziffer, Oberon; CONST diff --git a/src/test/x11/tetris/makefile b/src/test/x11/tetris/makefile index ae2c5119..e7c8a4b7 100644 --- a/src/test/x11/tetris/makefile +++ b/src/test/x11/tetris/makefile @@ -3,11 +3,12 @@ CFLAGS=-lX11 export CFLAGS -MOD = MODULES="../../../lib/oocX11" +MODX11="../../../library/oocX11" + VOC = $(MOD) /opt/voc/bin/voc all: - $(VOC) -s oocX11.Mod oocXutil.Mod oocXYplane.Mod compatIn.Mod Linie.Mod Ziffer.Mod Tetris.Mod -m + $(VOC) -s $(MODX11)/oocX11.Mod $(MODX11)/oocXutil.Mod $(MODX11)/oocXYplane.Mod compatIn.Mod Linie.Mod Ziffer.Mod Tetris.Mod -m #$(VOC) -Cm test.Mod #gcc -o test test.o -fPIC -g -I /opt/voc-1.0/src/lib/system/gcc/x86_64 -I /opt/voc-1.0/lib/voc/obj -lVishapOberon -L. -L/opt/voc-1.0/lib -lX11 diff --git a/src/test/x11/tron/makefile b/src/test/x11/tron/makefile index be94ea28..48464d5e 100644 --- a/src/test/x11/tron/makefile +++ b/src/test/x11/tron/makefile @@ -3,11 +3,11 @@ CFLAGS=-lX11 export CFLAGS -MOD = MODULES="../../../lib/oocX11" +MODX11="../../../library/oocX11" VOC = $(MOD) /opt/voc/bin/voc all: - $(VOC) -s oocX11.Mod oocXutil.Mod oocXYplane.Mod compatIn.Mod Tron.Mod -m + $(VOC) -s $(MODX11)/oocX11.Mod $(MODX11)/oocXutil.Mod $(MODX11)/oocXYplane.Mod compatIn.Mod Tron.Mod -m #$(VOC) -Cm test.Mod #gcc -o test test.o -fPIC -g -I /opt/voc-1.0/src/lib/system/gcc/x86_64 -I /opt/voc-1.0/lib/voc/obj -lVishapOberon -L. -L/opt/voc-1.0/lib -lX11 diff --git a/src/test/x11/vier/makefile b/src/test/x11/vier/makefile index 2c39f530..54d4ac35 100644 --- a/src/test/x11/vier/makefile +++ b/src/test/x11/vier/makefile @@ -3,11 +3,12 @@ CFLAGS=-lX11 export CFLAGS -MOD = MODULES="../../../lib/oocX11" +MODX11="../../../library/oocX11" + VOC = $(MOD) /opt/voc/bin/voc all: - $(VOC) -s oocX11.Mod oocXutil.Mod oocXYplane.Mod compatIn.Mod Ausgabe.Mod Vier.Mod -m + $(VOC) -s $(MODX11)/oocX11.Mod $(MODX11)/oocXutil.Mod $(MODX11)/oocXYplane.Mod compatIn.Mod Ausgabe.Mod Vier.Mod -m #$(VOC) -Cm test.Mod #gcc -o test test.o -fPIC -g -I /opt/voc-1.0/src/lib/system/gcc/x86_64 -I /opt/voc-1.0/lib/voc/obj -lVishapOberon -L. -L/opt/voc-1.0/lib -lX11 diff --git a/src/tools/autobuild/build-oberon.sh b/src/tools/autobuild/build-oberon.sh deleted file mode 100644 index 7dc5096a..00000000 --- a/src/tools/autobuild/build-oberon.sh +++ /dev/null @@ -1,25 +0,0 @@ -# Build Oberon -# -# Args -# -# $1 - whether to use sudo -# $2 - build directory -# $3 - CC -# $4 - branch - -if test "$1" = "sudo"; then sudo=sudo; else sudo=""; fi - -echo "" -echo === build-oberon.sh: \$1="$1", \$2="$2", \$3="$3", \$4="$4", \$sudo="$sudo" === -echo "" - -set -x -cd $2 - -$sudo git reset --hard # Clear the staging area -$sudo git clean -dfx # Remove all untracked files -$sudo git pull # Update the local repository -$sudo git checkout -f $4 # Switch to requested branch - -export CC=$3 -$sudo make full \ No newline at end of file diff --git a/src/tools/autobuild/buildall.pl b/src/tools/autobuild/buildall.pl deleted file mode 100644 index 7e74e3b7..00000000 --- a/src/tools/autobuild/buildall.pl +++ /dev/null @@ -1,66 +0,0 @@ -#!perl -w -use strict; -use warnings; -use POSIX "strftime"; -use Cwd; - -my $branch = "master"; -if (defined($ARGV[0]) && ($ARGV[0] ne "")) {$branch = $ARGV[0]} - -my %machines = ( - "pi" => ['22', 'pi@pie', 'sh build-oberon.sh sudo projects/oberon/vishap/voc gcc ' . $branch], - "darwin" => ['22', 'dave@dcb', 'sh build-oberon.sh sudo projects/oberon/vishap/voc clang ' . $branch], - "cygwin32" => ['5932', 'dave@wax', 'sh build-oberon.sh n oberon/cygwin/voc gcc ' . $branch], - "cygwin64" => ['5932', 'dave@wax', 'sh start64.sh \'sh build-oberon.sh n oberon/cygwin/voc gcc ' . $branch . '\''], - "mingw32" => ['5932', 'dave@wax', 'sh build-oberon.sh n oberon/mingw/voc i686-w64-mingw32-gcc ' . $branch], - "mingw64" => ['5932', 'dave@wax', 'sh start64.sh \'sh build-oberon.sh n oberon/mingw/voc x86_64-w64-mingw32-gcc ' . $branch . '\''], - "android" => ['8022', 'root@and', 'sh build-oberon.sh n vishap/voc gcc ' . $branch], - "lub64" => ['22', 'dave@vim', 'sh build-oberon.sh sudo oberon/voc gcc ' . $branch], - "lub32" => ['22', 'dave@vim-lub32', 'sh build-oberon.sh sudo oberon/voc gcc ' . $branch], - "fed64" => ['22', 'dave@vim-fed64', 'sh build-oberon.sh sudo oberon/voc gcc ' . $branch], - "osu64" => ['22', 'dave@vim-osu64', 'sh build-oberon.sh sudo oberon/voc gcc ' . $branch], - "ob32" => ['22', 'root@nas-ob32', 'sh build-oberon.sh n vishap/voc gcc ' . $branch], - "ce64" => ['5922', 'obe@www', 'sh build-oberon.sh sudo vishap/voc gcc ' . $branch], - "fb64" => ['22', 'root@oberon', 'sh build-oberon.sh n vishap/voc gcc ' . $branch] -); - -sub logged { - my ($cmd, $id) = @_; - my $child = fork; - if (not defined $child) {die "Fork failed.";} - if ($child) { - # parent process - print "Started $id, pid = $child\n"; - } else { - # child process - open(my $log, ">log/$id.log") // die "Could not create log file log/$id.log"; - print $log strftime("%Y/%m/%d %H.%M.%S ", localtime), "$id.log\n"; - print $log strftime("%H.%M.%S", localtime), "> $cmd\n"; - print $id, " ", strftime("%H.%M.%S", localtime), "> $cmd\n"; - open(my $pipe, "$cmd 2>&1 |") // die "Could not open pipe from command $cmd."; - while (<$pipe>) { - my $line = $_; - print $id, " ", strftime("%H.%M.%S", localtime), " ", $line; - print $log strftime("%H.%M.%S", localtime), " ", $line; - } - close($pipe); - print $log strftime("%H.%M.%S", localtime), " --- Make completed ---\n"; - close($log); - exit; - } -} - -unlink glob "log/*"; - -for my $machine (sort keys %machines) { - my ($port, $login, $cmd) = @{$machines{$machine}}; - my $cmd = "scp -P $port build-oberon.sh $login:build-oberon.sh &&" - . "ssh -p $port $login \"$cmd\""; - logged($cmd, $machine); -} - -system("perl report.pl $branch"); -while ((my $pid = wait) > 0) { - print "Child pid $pid completed.\n"; - system("perl report.pl $branch"); -} diff --git a/src/tools/autobuild/makesvg.pl b/src/tools/autobuild/makesvg.pl new file mode 100644 index 00000000..398d09cd --- /dev/null +++ b/src/tools/autobuild/makesvg.pl @@ -0,0 +1,113 @@ +#!perl -w +use strict; +use warnings; + + +my %BuildStatus = (); +my $Rows = 0; +opendir DIR, "logs"; +while (my $fn = readdir(DIR)) { + if ($fn =~ /^((.+)-(.+))\.state$/) { + my ($build, $branch, $id) = ($1, $2, $3); + open STATE, "); # date time os compiler model compiler-build library-build ssource-change binary-change tests + splice(@state, 2, 0, $branch); + $BuildStatus{$build} = \@state; + close STATE; + $Rows++; + } +} +closedir DIR; + +#for my $fn (sort keys %BuildStatus) { +# print "$fn:\n"; +# my @state = @{$BuildStatus{$fn}}; +# my $i = 0; +# for my $val (@state) { +# print " $i: $val\n"; +# $i++; +# } +#} + + +my $FontHeight = 12; +my $LineHeight = 16; + +sub svgtext { + my ($f, $x, $y, $colour, $msg) = @_; + if ($msg ne '') { + $y = ($y+1)*$LineHeight + $FontHeight*0.4; + print $f <<"--END--TEXT--"; +$msg +--END--TEXT-- + } +} + +sub ColourFor { + my ($str) = @_; + if ($str eq "Failed") {return "#e03030";} # red + if ($str eq "Changed") {return "#ff9d4d";} # amber + if ($str eq "Passed") {return "#5adb5a";} # green + if ($str eq "Built") {return "#5adb5a";} # green + return "#c0c0c0"; +} + + +my @ColWidths = (22, 81, 67, 60, 70, 60, 50, 60, 60, 80, 80, 64); +my @Columns = (0); +for my $width (@ColWidths) {push @Columns, $Columns[$#Columns] + $width} + +my $Width = $Columns[$#Columns]; +my $Height = ($Rows+2.2) * $LineHeight; + + + +open(my $svg, ">vishaps-status.svg") // die "Could not create vishaps-status.svg."; + +print $svg <<"--END--SVG--HEADER--"; + + + +--END--SVG--HEADER-- + + +svgtext($svg, $Columns[1], 0, "#e0e0e0", "Date"); +svgtext($svg, $Columns[2], 0, "#e0e0e0", "Time"); +svgtext($svg, $Columns[3], 0, "#e0e0e0", "Branch"); +svgtext($svg, $Columns[4], 0, "#e0e0e0", "OS"); +svgtext($svg, $Columns[5], 0, "#e0e0e0", "Compiler"); +svgtext($svg, $Columns[6], 0, "#e0e0e0", "Model"); +svgtext($svg, $Columns[7], 0, "#e0e0e0", "Oberon"); +svgtext($svg, $Columns[8], 0, "#e0e0e0", "Library"); +svgtext($svg, $Columns[9], 0, "#e0e0e0", "C Source"); +svgtext($svg, $Columns[10], 0, "#e0e0e0", "Assembler"); +svgtext($svg, $Columns[11], 0, "#e0e0e0", "Tests"); + + +my $Row = 1; +for my $build (sort keys %BuildStatus) { + my @state = @{$BuildStatus{$build}}; + + my $y = $Row*$LineHeight + $FontHeight*0.8; + my $h = $LineHeight * 0.9; + print $svg <<"--END--HIGHLIGHT--"; + + +--END--HIGHLIGHT-- + + my $column = 1; + for my $field (@state) { + svgtext($svg, $Columns[$column], $Row, ColourFor($field), $field); + $column++; + } + $Row++; + + print $svg "\n" +} + +print $svg "\n"; +close $svg; diff --git a/src/tools/autobuild/postpush.pl b/src/tools/autobuild/postpush.pl deleted file mode 100644 index 07397517..00000000 --- a/src/tools/autobuild/postpush.pl +++ /dev/null @@ -1,55 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use warnings; -use POSIX "strftime"; - -use CGI qw(:standard escapeHTML); -use JSON; - - -sub writelog { - my ($msg) = @_; - - open(LOG, ">>/tmp/postpush.log") or die "Could not create postpush.log"; - flock(LOG, 2) or die "Could not lock postpush.log"; - print LOG sprintf("%s %s\n", strftime("%Y/%m/%d %H.%M.%S", localtime), $msg); - close(LOG); - system "id >> /tmp/postpush.log"; -} - -my $postdata = from_json(param('POSTDATA')); - -my $url = $postdata->{'repository'}->{'url'}; -my $ref = $postdata->{'ref'}; -my $name = $postdata->{'head_commit'}->{'author'}->{'name'}; -my $branch = $ref; $branch =~ s'^.*\/''; -my $repo = $url; $repo =~ s'^.*\/''; -my $modified = $postdata->{'head_commit'}->{'modified'}; - -my $buildneeded = 0; -for my $file (@{$modified}) { - if ($file !~ m/\.(md|svg)$/i) {$buildneeded = 1;} -} - -if ($buildneeded) { - writelog "Post push github web hook for repository $repo, branch $branch, name $name. Build required."; - - my $child = fork; - if (not defined $child) {die "Fork failed.";} - if ($child) { - writelog "Started buildall, pid = $child."; # parent process - } else { - close(STDIN); close(STDOUT); close(STDERR); # child process - exec 'perl buildall.pl ' . $branch . ' >/tmp/buildall.log'; - exit; - } -} else { - writelog "Post push github web hook for repository $repo, branch $branch, name $name. No build required."; -} - - -print header(), - start_html("Vishap Oberon github post push web hook."), - p("Repository $repo, branch $branch, name $name."), - end_html(); diff --git a/src/tools/autobuild/report.pl b/src/tools/autobuild/report.pl deleted file mode 100644 index 459603e4..00000000 --- a/src/tools/autobuild/report.pl +++ /dev/null @@ -1,176 +0,0 @@ -#!perl -w -use strict; -use warnings; -use POSIX "strftime"; -use Cwd; - -my $branch = "master"; -if (defined($ARGV[0]) && ($ARGV[0] ne "")) {$branch = $ARGV[0]} - -print "--- Running build status report on branch $branch.\n"; - -my %status = (); - -my $fn; -my $date; -my $time; -my $os; -my $compiler; -my $datamodel; -my $compilerok; -my $libraryok; -my $sourcechange; -my $asmchange; -my $tests; -my $key; -my $ver; - -sub clearvars { - $time = ""; $branch = ""; $os = ""; $compiler = ""; - $datamodel = ""; $compilerok = ""; $libraryok = ""; $sourcechange = ""; - $asmchange = ""; $tests = ""; $key = ""; $ver = ""; -} - -sub logstatus { - my ($fn) = @_; - if ($compiler ne "") { - $status{"$os-$compiler-$datamodel"} = - [$fn, $date, $time, $os, $compiler, $datamodel, $branch, $compilerok, $libraryok, $sourcechange, $asmchange, $tests]; - } - clearvars(); -} - -sub parselog { - ($fn) = @_; - clearvars(); - open(my $log, $fn) // die "Couldn't open build log $fn."; - $branch = "Build on $fn started"; - while (<$log>) { - if (/^([0-9\/]+) ([0-9.]+) .+\.log$/) {$date = $1} - if (/^([0-9.]+) /) {$time = $1} - # 19.39.58 Configuration: 1.95 [2016/07/14] for gcc LP64 on centos - if (/^[^ ]+ Configuration: ([0-9a-zA-Z.]+) \[[0-9\/]+\] for (.+) *$/) { - logstatus($fn); - $ver = $1; - printf "--- Config for $fn: $1 for $2.\n"; - } - if (/^[^ ]+ --- Cleaning branch ([^ ]+) ([^ ]+) ([^ ]+) ([^ ]+) ---$/) { - ($branch, $os, $compiler, $datamodel) = ($1, $2, $3, $4, $5); - } - if (/^([0-9.]+) --- Compiler build started ---$/) {$compilerok = "Started";} - if (/^([0-9.]+) --- Compiler build successfull ---$/) {$compilerok = "Built";} - - if (/^([0-9.]+) --- Library build started ---$/) {$libraryok = "Started";} - if (/^([0-9.]+) --- Library build successfull ---$/) {$libraryok = "Built";} - - if (/^([0-9.]+) --- Generated c source files match bootstrap ---$/) {$sourcechange = "Unchanged";} - if (/^([0-9.]+) --- Generated c source files differ from bootstrap ---$/) {$sourcechange = "Changed";} - - if (/^([0-9.]+) --- Generated code unchanged ---$/) {if ($asmchange eq "") {$asmchange = "Unchanged"}} - if (/^([0-9.]+) --- Generated code changed ---$/) {$asmchange = "Changed"} - - if (/^([0-9.]+) --- Confidence tests started ---$/) {$tests = "Started";} - if (/^([0-9.]+) --- Confidence tests passed ---$/) {$tests = "Passed";} - - if (/^([0-9.]+) --- Make completed ---$/) { - # Go back and convert 'Started' status to 'Failed'. - if ($branch =~ m/^Build on/) {$branch = "Build on $fn failed to start.";} - if ($compilerok eq "Started") {$compilerok = "Failed";} - if ($libraryok eq "Started") {$libraryok = "Failed";} - if ($tests eq "Started") {$tests = "Failed";} - } - } - close($log); - logstatus($fn); -} - -opendir DIR, "log" // die "Could not open log directory."; -my @logs = readdir DIR; -closedir DIR; - -for my $logname (sort @logs) { - $logname = "log/" . $logname; - #print "Consider $logname\n"; - if (-f $logname) {parselog($logname);} -} - -my $fontheight = 12; -my $lineheight = 15; - -sub svgtext { - my ($f, $x, $y, $colour, $msg) = @_; - print $f ''; - print $f $msg; - print $f "\n"; -} - -sub colourfor { - my ($str) = @_; - if ($str eq "Failed") {return "#e03030";} - if ($str eq "Changed") {return "#ff9d4d";} - return "#5adb5a"; -} - -my $rows = keys %status; - -my $width = 710; -my $height = ($rows+2.2) * $lineheight; - -open(my $svg, ">build-status.svg") // die "Could not create build-status.svg."; -print $svg '\n"; -print $svg '', "\n"; - -my $col1 = 20; -my $col2 = 97; -my $col3 = 160; -my $col4 = 220; -my $col5 = 280; -my $col6 = 330; -my $col7 = 380; -my $col8 = 440; -my $col9 = 490; -my $col10 = 570; -my $col11 = 650; - -svgtext($svg, $col1, 0, "#e0e0e0", "Date"); -svgtext($svg, $col3, 0, "#e0e0e0", "Branch"); -svgtext($svg, $col4, 0, "#e0e0e0", "Platform"); -svgtext($svg, $col7, 0, "#e0e0e0", "Compiler"); -svgtext($svg, $col8, 0, "#e0e0e0", "Library"); -svgtext($svg, $col9, 0, "#e0e0e0", "C Source"); -svgtext($svg, $col10, 0, "#e0e0e0", "Assembler"); -svgtext($svg, $col11, 0, "#e0e0e0", "Tests"); - -my $i=1; -for my $key (sort keys %status) { - my ($fn, $date, $time, $os, $compiler, $datamodel, $branch, $compilerok, $libraryok, - $sourcechange, $asmchange, $tests) = @{$status{$key}}; - print $svg ''; - svgtext($svg, $col1, $i, "#c0c0c0", $date); - svgtext($svg, $col2, $i, "#c0c0c0", $time); - svgtext($svg, $col3, $i, "#c0c0c0", $branch); - svgtext($svg, $col4, $i, "#c0c0c0", $os); - svgtext($svg, $col5, $i, "#c0c0c0", $compiler); - svgtext($svg, $col6, $i, "#c0c0c0", $datamodel); - svgtext($svg, $col7, $i, colourfor($compilerok), $compilerok); - svgtext($svg, $col8, $i, colourfor($libraryok), $libraryok); - svgtext($svg, $col9, $i, colourfor($sourcechange), $sourcechange); - svgtext($svg, $col10, $i, colourfor($asmchange), $asmchange); - svgtext($svg, $col11, $i, colourfor($tests), $tests); - print $svg ''; - $i++; -} - -print $svg "\n"; - -system 'chmod +r log/*'; -system 'scp build-status.svg dave@hub:/var/www'; -system 'scp log/* dave@hub:/var/www/log'; diff --git a/src/tools/autobuild/response.html b/src/tools/autobuild/response.html new file mode 100644 index 00000000..12acbc38 --- /dev/null +++ b/src/tools/autobuild/response.html @@ -0,0 +1,5 @@ + + +github webhook response +github webhook response + diff --git a/src/tools/autobuild/runbuilds.pl b/src/tools/autobuild/runbuilds.pl new file mode 100644 index 00000000..23a7f1db --- /dev/null +++ b/src/tools/autobuild/runbuilds.pl @@ -0,0 +1,205 @@ +#!perl -w +use strict; +use warnings; +use POSIX "strftime"; + +$SIG{CHLD} = 'IGNORE'; + +my $home = "/home/dave/vishap-build"; + +chdir $home; +mkdir "logs"; +#my $GlobalLog = *STDOUT; +open my $GlobalLog, ">$home/logs/runbuilds.log"; + +my $LogToScreenToo = 1; + + +# Find a build to run + +sub FindTriggeredBuild { + opendir (DIR, "$home") || die "$!"; + my $branch = undef; + while ((!defined $branch) && (my $fn = readdir DIR)) { + if ($fn =~ /^trigger-(\w+)/) {$branch = $1; unlink "$home/$fn"} + } + closedir DIR; + return $branch; +} + + + + +# Status information +# +# Build type: Datestamp Branch Platform Compiler Model +# Status: Compiler-build Library-build C-changed Assembler? Tests +# + +my %BuildStatus = (); + +sub WriteStatus {my ($timestamp, $id) = @_; + open STATE, ">logs/$id.state"; + print STATE "$timestamp "; + print STATE $BuildStatus{$id}->{kind}, ' '; + print STATE $BuildStatus{$id}->{compile}, ' '; + print STATE $BuildStatus{$id}->{library}, ' '; + print STATE $BuildStatus{$id}->{csource}, ' '; + print STATE $BuildStatus{$id}->{binary}, ' '; + print STATE $BuildStatus{$id}->{tests}, "\n"; + close STATE; +} + +sub SetStatus {my ($timestamp, $id, $section, $state) = @_; + if (!exists $BuildStatus{$id}) {$BuildStatus{$id} = { + kind => "- - -", compile => "Pending", library => "Pending", + csource => "Pending", binary => "Pending", tests => "Pending" + }} + $BuildStatus{$id}->{$section} = $state; + WriteStatus($timestamp, $id) +} + + +sub UpdateStatus {my ($timestamp, $id, $msg) = @_; + if ($msg =~ /^Configuration: ([^ ]+) \[[0-9\/]+\] for ([^ ]+) ([^ ]+) on ([^ ]+)/) { + SetStatus($timestamp, $id, 'kind', "$4 $2 $3") + } else { + if ($msg =~ /^--- (.*) ---$/) { + my $status = $1; + if ($status eq 'Build starts') {$id =~ /^.+?-(.+)$/; SetStatus($timestamp, $id, 'kind', "($1 rsync) -")} + elsif ($status eq 'Compiler build started') {SetStatus($timestamp, $id, 'compile', 'Busy')} + elsif ($status eq 'Compiler build successfull') {SetStatus($timestamp, $id, 'compile', 'Built')} + elsif ($status eq 'Library build started') {SetStatus($timestamp, $id, 'library', 'Busy')} + elsif ($status eq 'Library build successfull') {SetStatus($timestamp, $id, 'library', 'Built')} + elsif ($status eq 'Generated c source files match bootstrap') {SetStatus($timestamp, $id, 'csource', 'Unchanged')} + elsif ($status eq 'Generated c source files differ from bootstrap') {SetStatus($timestamp, $id, 'csource', 'Changed')} + elsif ($status eq 'Generated code unchanged') {SetStatus($timestamp, $id, 'binary', 'Unchanged')} + elsif ($status eq 'Generated code changed') {SetStatus($timestamp, $id, 'binary', 'Changed')} + elsif ($status eq 'Confidence tests started') {SetStatus($timestamp, $id, 'tests', 'Busy')} + elsif ($status eq 'Confidence tests passed') {SetStatus($timestamp, $id, 'tests', 'Passed')} + elsif ($status eq 'Build ends') { + my %status = %{$BuildStatus{$id}}; + foreach my $sec (keys %status) { + if ($status{$sec} eq 'Busy') {$BuildStatus{$id}->{$sec} = 'Failed'} + if ($status{$sec} eq 'Pending') {$BuildStatus{$id}->{$sec} = '-'} + } + WriteStatus($timestamp, $id) + } + } + } +} + + +sub Log {my ($log, $id, $msg) = @_; + my $timestamp = strftime("%Y/%m/%d %H.%M.%S", localtime); + $msg =~ s/[\r\n]*$//; # Remove trailing newline characters + UpdateStatus($timestamp, $id, $msg); + substr($timestamp,0,11) = ''; # Remove date part as not needed in logs + if ($LogToScreenToo) {print "($id) $timestamp $msg\n"} + print $GlobalLog "$timestamp ($id) $msg\n"; + if (defined $log) {print $log "$timestamp $msg\n"} +} + + +sub DoLogged {my ($log, $id, $cmd) = @_; + Log $log, $id, "Executing '$cmd'."; + open(my $pipe, "$cmd 2>&1 |") // die "Could not open pipe from command $cmd."; + while (<$pipe>) {Log $log, $id, $_} + close($pipe); +} + + + +sub SendFile {my ($log, $id, $dest, $port, $filename, $content) = @_; + Log $log, $id, "SendFile($dest,$port,$filename)"; + open PIPE, "|ssh -p $port $dest 'cat >$filename'"; + $content =~ s/\n/\r\n/g; # Unix to MS line ends. + print PIPE $content; + close PIPE; +} + + + +## my %machines = ( +## "cygwin32" => ['5932', 'dave@wax', 'sh build-oberon.sh n oberon/cygwin/voc gcc ' . $branch], +## "cygwin64" => ['5932', 'dave@wax', 'sh start64.sh \'sh build-oberon.sh n oberon/cygwin/voc gcc ' . $branch . '\''], +## "mingw32" => ['5932', 'dave@wax', 'sh build-oberon.sh n oberon/mingw/voc i686-w64-mingw32-gcc ' . $branch], +## "mingw64" => ['5932', 'dave@wax', 'sh start64.sh \'sh build-oberon.sh n oberon/mingw/voc x86_64-w64-mingw32-gcc ' . $branch . '\''], +## "ce64" => ['5922', 'obe@www', 'sh build-oberon.sh sudo vishap/voc gcc ' . $branch], +## ); + + + + +my @Builds = ( + ['pi', 'pi@pie', '22', '', 'cd vishaps/$id && make full'], + ['android', 'and', '8022', '', 'cd vishaps/$id && CC=gcc make full'], + ['lub32', 'vim-lub32', '22', '', 'cd vishaps/$id && make full'], + ['lub32cl', 'vim-lub32', '22', '', 'cd vishaps/$id && CC=clang make full'], + ['obs32', 'vim-obs32', '22', '', 'cd vishaps/$id && make full'], + ['cyg32', 'wax', '5932', '', 'cd vishaps/$id && make full'], + ['ming32', 'wax', '5932', '', 'cd vishaps/$id && CC=i686-w64-mingw32-gcc make full'], + ['cyg64', 'wax', '5932', '', 'sh start64.sh \'cd vishaps/$id && make full\''], + ['ming64', 'wax', '5932', '', 'sh start64.sh \'cd vishaps/$id && CC=x86_64-w64-mingw32-gcc make full\''], + ['lub64', 'vim', '22', '', 'cd vishaps/$id && make full'], + ['osu64', 'vim-osu64', '22', '', 'cd vishaps/$id && make full'], + ['fed64', 'vim-fed64', '22', '', 'cd vishaps/$id && make full'], + ['fbs64', 'githubhook', '22', '', 'cd vishaps/$id && make full'], + ['ce64', 'vim-ce64', '22', '', 'cd vishaps/$id && make full'], + ['darwin', 'dcb', '22', '', 'cd vishaps/$id && make full'], + ['win32', 'vim-win64', '22', 'x86', 'cmd /c x86.cmd'], + ['win64', 'vim-win64', '22', 'x64', 'cmd /c x64.cmd'] +); + +sub Prepare {my ($log, $id, $dest, $port, $preparation) = @_; + SendFile($log, $id, $dest, $port, "$preparation.cmd", <<"--END--MS--"); +call \"C:\\Program Files (x86)\\Microsoft Visual C++ Build Tools\\vcbuildtools.bat\" $preparation +cd %HOME%\\vishaps\\$id +make full +--END--MS-- +} + +sub BuildBranch {my ($branch) = @_; + Log undef, $branch, "$branch branch build triggered."; + + # Obtain a clean clone of vishaps + DoLogged undef, $branch, "rm -rf $home/voc"; + DoLogged undef, $branch, "cd $home && git clone -b $branch --single-branch https://github.com/vishaps/voc"; + + # Start each build in turn + + unlink glob "$home/logs/$branch-*"; + for my $build (@Builds) { + my ($id, $dest, $port, $preparation, $command) = @$build; + my $rsynccompress = "-z"; if ($id eq "android") {$rsynccompress = "-zz"} + $id = "$branch-$id"; + my $child = fork; if (not defined $child) {die "Fork failed.";} + if ($child) {print "Opened process $child for build $id at $dest.\n"} + else { + # child process + my $log; + open $log, ">$home/logs/$id.log"; + Log $log, $id, "--- Build starts ---"; + Log $log, $id, strftime("%Y/%m/%d ", localtime) . "Build $id starting at $dest."; + DoLogged $log, $id, "ssh -p $port $dest mkdir -p vishaps/$id"; + DoLogged $log, $id, "rsync -r $rsynccompress --delete -e 'ssh -p $port' $home/voc/ $dest:vishaps/$id/"; + if ($preparation ne '') {Prepare($log, $id, $dest, $port, $preparation)} + $command =~ s/\$id /$id /g; + DoLogged $log, $id, "ssh -p $port $dest \"$command\""; + Log $log, $id, "Build $id for branch $branch at $dest completed."; + Log $log, $id, "--- Build ends ---"; + close $log; + exit; + } + } + + Log undef, $branch, "$branch branch: all builds started."; +} + + + +Log undef, 'runbuilds', strftime("%Y/%m/%d ", localtime) . "runbuilds starting."; +while (my $branch = FindTriggeredBuild()) {BuildBranch($branch)} +Log undef, 'runbuilds', "No more build triggers found, runbuilds complete."; +close $GlobalLog; + diff --git a/src/tools/autobuild/server.pl b/src/tools/autobuild/server.pl new file mode 100755 index 00000000..f076a6c5 --- /dev/null +++ b/src/tools/autobuild/server.pl @@ -0,0 +1,163 @@ +#!/usr/bin/perl +use strict; +use warnings; +use HTTP::Daemon; +use HTTP::Status; +use HTTP::Response; +use HTTP::Date qw(time2str); +use LWP::MediaTypes qw(guess_media_type); +use Digest::SHA qw(hmac_sha1_hex); +use Data::Dumper; +use JSON; +use sigtrap qw(die INT QUIT); + +my $home = "/home/dave/vishap-build"; +my $criggleplop = "splurd crungle splonge."; + +$| = 1; +$SIG{CHLD} = 'IGNORE'; + +my $PORT = 9000; +my $server = HTTP::Daemon->new(Family => AF_INET, LocalPort => $PORT, ReuseAddr => 1); +die "Cannot setup server" unless $server; +print "[$$: Accepting clients at http://localhost:$PORT/]\n"; + +while (my $client = $server->accept) { + (my $pid = fork()) // die("Couldn't fork."); + if ($pid) {$client->close; undef $client} + else {ServeRequests($client); $client->close; undef $client; exit} +} +print "$$: server->accept failed. Exiting.\n"; +exit; + + +sub StartBuilds {my ($branch) = @_; + print " -- start builds for branch $branch.\n"; + open TRIGGER, ">trigger-$branch"; print TRIGGER "trigger.\n"; close TRIGGER; + my $running = 0; + if (open PID, "; close PID} + if (!$running) { + my $child = fork; + if ($child) { + # This is the parent. We get to know the child PID, write it out. + print "Started build, pid $child.\n"; + open PID, ">pid"; print PID "$child.\n"; close PID; + } else { + # This is the child, we actually run all triggered builds. + # print "Debug: About to run perl >$home/runbuilds.log ...\n"; + exec "perl $home/runbuilds.pl >$home/runbuilds.log"; + exit; # Shouldn't get here + } + } +} + + +sub decodehook {my ($hook) = @_; + my %modifiedfiles = (); + my %commitauthors = (); + my $buildrequired = 0; + + my $commits = $hook->{commits}; + for my $commit (@$commits) { + my $committer = $commit->{committer}; + $commitauthors{$committer->{username}}++; + my $modified = $commit->{modified}; + for my $modfile (@$modified) { + $modifiedfiles{$modfile}++; + if ($modfile !~ m/\.(md|svg)$/i) {$buildrequired = 1;} + } + } + my $pusher = $hook->{pusher}; + my $repository = $hook->{repository}; + my $branch = $hook->{ref}; $branch =~ s'^.*\/''; + print "Repository: $repository->{name}, branch: $branch.\n"; + print "Commit authors: " . join(", ", keys %commitauthors) . ".\n"; + print "Pusher: " . $pusher->{name} . "\n"; + print "Files modified: " . join(", ", keys %modifiedfiles) . ".\n"; + print "Build " . ($buildrequired ? '' : 'not') . " required.\n"; + if ($buildrequired) {StartBuilds($branch)} +} + + +sub SendFile {my ($client, $file) = @_; + my $CRLF = "\r\n"; + local(*F); + sysopen(F, $file, 0); + binmode(F); + my($ct,$ce) = guess_media_type($file); + my($size,$mtime) = (stat $file)[7,9]; + $client->send_basic_header; + print $client "Content-Encoding: $ce$CRLF" if $ce; + print $client "Last-Modified: ", time2str($mtime), "$CRLF" if $mtime; + print $client "Accept-Ranges: bytes$CRLF"; + print $client "Content-Length: $size$CRLF" if $size; + print $client "Cache-Control: no-cache, no-store, must-revalidate, max-age=0$CRLF"; + print $client "Pragma: no-cache$CRLF"; + print $client "Expires: Wed, 11 Jan 1984 05:00:00 GMT$CRLF"; + print $client "Content-Type: $ct$CRLF"; + print $client $CRLF; + $client->send_file(\*F) unless $client->head_request; +} + + +sub VishapStatus {my ($client) = @_; + print " -- generate status.\n"; + system "perl makesvg.pl"; # Construct an up-to-date status file + SendFile($client, "vishaps-status.svg"); +} + +sub LogFileResponse {my ($client, $path) = @_; + if (-f "logs/$path.log") { + print " -- send log for build $path.\n"; + SendFile($client, "logs/$path.log") + } else { + print " -- respond forbidden: no log for $path.\n"; + $client->send_error(RC_FORBIDDEN) + } +} + + +sub ServeRequests {my ($client) = @_; + $client->autoflush(1); + while (my $request = $client->get_request) { + if ($request->method eq 'GET') { + + my $host = $request->headers->{host}; + my $uri = $request->uri; + $uri =~ s/^\///; + $uri =~ s/^githubhook\///; + + print "Request: $uri\n"; + + if ($uri eq 'vishaps-status.svg') {VishapStatus($client)} + elsif ($uri eq 'vishaps-trigger') { + $client->send_file_response("response.html"); + StartBuilds("master"); + } + elsif ($uri =~ /^vishaps-trigger\/([-_a-z0-9]+)/i) { + $client->send_file_response("response.html"); + StartBuilds($1); + } + else {LogFileResponse($client, $uri)} + + } elsif ($request->method eq 'POST') { + + $client->send_file_response("response.html"); + my $event = $request->headers->{'x-github-event'}; + my $githubsig = substr($request->headers->{'x-hub-signature'}, 5); + my $mysig = hmac_sha1_hex($request->content, $criggleplop); + print "Github POST: $event, mysig $mysig, githubsig: $githubsig.\n"; + if (($event eq "push") && ($mysig eq $githubsig)) { + my $content = $request->content; + $content =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; # Unescape %xx sequences. + decodehook(JSON::decode_json(substr($content,8))); + } + + } else { + + print "Request method $request->method forbidden.\n"; + $client->send_error(RC_FORBIDDEN) + + } + } +} diff --git a/src/tools/autobuild/update-webserver.sh b/src/tools/autobuild/update-webserver.sh deleted file mode 100644 index 58a5e439..00000000 --- a/src/tools/autobuild/update-webserver.sh +++ /dev/null @@ -1,9 +0,0 @@ -# Push buildall and postpush to postpush server - -set -x -for f in *.pl build-oberon.sh; do - scp -P 5922 $f root@www:/var/lib/nethserver/ibay/githubhook/$f - ssh -p 5922 root@www "chmod +x /var/lib/nethserver/ibay/githubhook/$f" -done; -ssh -p 5922 root@www "ls -lap /var/lib/nethserver/ibay/githubhook" - diff --git a/src/tools/browser/BrowserCmd.Mod b/src/tools/browser/BrowserCmd.Mod index 14df830f..e4ffe88f 100644 --- a/src/tools/browser/BrowserCmd.Mod +++ b/src/tools/browser/BrowserCmd.Mod @@ -63,6 +63,24 @@ MODULE BrowserCmd; (* RC 29.10.93 *) (* object model 4.12.93, command line ver IF obj # NIL THEN Objects(obj^.left, mode); IF obj^.mode IN mode THEN + (* Output comment if present *) + IF obj^.comment # NIL THEN + Indent(1); + Ws("(** "); + (* Handle multi-line comments *) + i := 0; + WHILE obj^.comment^[i] # 0X DO + IF obj^.comment^[i] = 0AX THEN + Ws(" *)"); Wln; + Indent(1); Ws(" "); + ELSE + Wc(obj^.comment^[i]) + END; + INC(i) + END; + Ws(" *)"); + Wln + END; CASE obj^.mode OF |OPT.Con: Indent(2); Ws(obj^.name); Ws(" = "); CASE obj^.typ^.form OF diff --git a/src/tools/make/configure.c b/src/tools/make/configure.c index 458bddec..258a1b4e 100644 --- a/src/tools/make/configure.c +++ b/src/tools/make/configure.c @@ -43,19 +43,17 @@ char installdir[256]; char versionstring[256]; char osrelease[1024]; char cwd[1024]; -char ldconfig[1024]; // Command(s) to update OS shared library config char libspec[1024]; #define macrotostringhelper(s) #s #define macrotostring(s) macrotostringhelper(s) -char *version = macrotostring(O_VER); -char *objext = ".o"; -char *objflag = " -o "; -char *linkflags = " -L\""; -char *libext = ""; -char *oname = NULL; // From O_NAME env var if present, or O_NAME macro otherwise. - - +char *version = macrotostring(O_VER); +char *objext = ".o"; +char *objflag = " -o "; +char *linkflags = " -L\""; +char *libext = ""; +char *oname = NULL; // From O_NAME env var if present, or O_NAME macro otherwise. +char *dynext = ".so"; char *dataModel = NULL; char *compiler = NULL; char *cc = NULL; @@ -115,7 +113,8 @@ void determineOS() { else if (strncasecmp(sys.sysname, "linux", 5) == 0) {determineLinuxVariant();} else if (strncasecmp(sys.sysname, "freebsd", 5) == 0) {os = "freebsd"; bsd = 1;} else if (strncasecmp(sys.sysname, "openbsd", 5) == 0) {os = "openbsd"; bsd = 1;} - else if (strncasecmp(sys.sysname, "darwin", 5) == 0) {os = "darwin"; staticlink = "";} + else if (strncasecmp(sys.sysname, "netbsd", 5) == 0) {os = "netbsd"; bsd = 1;} + else if (strncasecmp(sys.sysname, "darwin", 5) == 0) {os = "darwin"; staticlink = ""; dynext = ".dylib";} else { fprintf(stderr, "\n\n** Unrecognised utsname.sysname '%s' returned by uname().\n", sys.sysname); fprintf(stderr, "** Please add a test for this OS in src/buildtools/configure.c\n"); @@ -126,29 +125,36 @@ void determineOS() { } #define optimize "" // " -O1" +// FIXME ignoring warning floods that possibly are problems +#define ignore_gcc_warning_flood " -Wno-stringop-overflow -std=gnu11" +#define ignore_clang_warning_flood " -Wno-deprecated-non-prototype" void determineCCompiler() { - snprintf(libspec, sizeof(libspec), " -l %s", oname); + snprintf(libspec, sizeof(libspec), " -l%s", oname); #if defined(__MINGW32__) compiler = "mingw"; if (sizeof (void*) == 4) { - cc = "i686-w64-mingw32-gcc -g" optimize; + cc = "i686-w64-mingw32-gcc -g" ignore_gcc_warning_flood optimize; } else { - cc = "x86_64-w64-mingw32-gcc -g" optimize; + cc = "x86_64-w64-mingw32-gcc -g" ignore_gcc_warning_flood optimize; } #elif defined(__clang__) compiler = "clang"; - cc = "clang -fPIC -g" optimize; + cc = "clang -fPIC -g" ignore_clang_warning_flood optimize; + #elif defined(__TINYC__) + compiler = "tcc"; + cc = "tcc -g"; + staticlink = ""; #elif defined(__GNUC__) compiler = "gcc"; if (strncasecmp(os, "cygwin", 6) == 0) { // Avoid cygwin specific warning that -fPIC is ignored. - cc = "gcc -g" optimize; + cc = "gcc -g" ignore_gcc_warning_flood optimize; } else { - cc = "gcc -fPIC -g" optimize; + cc = "gcc -fPIC -g" ignore_gcc_warning_flood optimize; } #elif defined(_MSC_VER) - compiler = "MSC"; + compiler = "msc"; cc = "cl /nologo"; objext = ".obj"; objflag = " -Fe"; @@ -195,21 +201,6 @@ void determineInstallDirectory() { -void determineLdconfig() { // Generate appropriate ldconfig command for this OS - if (bsd) { - snprintf(ldconfig, sizeof(ldconfig), "ldconfig -m \"%s/lib\"", installdir); - } else { - snprintf( - ldconfig, sizeof(ldconfig), - "if echo \"%s/lib\" >/etc/ld.so.conf.d/lib%s.conf; then ldconfig; fi", - installdir, oname - ); - } -} - - - - void determineBuildDate() { time_t t = time(0); strftime(builddate, sizeof(builddate), "%Y/%m/%d", localtime(&t)); @@ -392,9 +383,9 @@ void writeMakeParameters() { fprintf(fd, "INSTALLDIR=%s\n", installdir); fprintf(fd, "PLATFORM=%s\n", platform); fprintf(fd, "BINEXT=%s\n", binext); + fprintf(fd, "DYNEXT=%s\n", dynext); fprintf(fd, "COMPILE=%s\n", cc); fprintf(fd, "STATICLINK=%s\n", staticlink); - fprintf(fd, "LDCONFIG=%s\n", ldconfig); fclose(fd); } @@ -413,6 +404,8 @@ void writeConfigurationMod() { fprintf(fd, " linkflags* = '%s';\n", linkflags); fprintf(fd, " libspec* = '%s';\n", libspec); fprintf(fd, " libext* = '%s';\n", libext); + fprintf(fd, " os* = '%s';\n", os); + fprintf(fd, " compiler* = '%s';\n", compiler); fprintf(fd, " compile* = '%s';\n", cc); fprintf(fd, " installdir* = '%s';\n", installdir); fprintf(fd, " staticLink* = '%s';\n", staticlink); @@ -455,7 +448,6 @@ int main(int argc, char *argv[]) determineCDataModel(); determineBuildDate(); determineInstallDirectory(); - determineLdconfig(); testSystemDotH(); diff --git a/src/tools/make/oberon.mk b/src/tools/make/oberon.mk index 553b02f6..d68cc09b 100644 --- a/src/tools/make/oberon.mk +++ b/src/tools/make/oberon.mk @@ -33,7 +33,7 @@ usage: clean: @printf '\n\n--- Cleaning branch $(BRANCH) $(OS) $(COMPILER) $(DATAMODEL) ---\n\n' - rm -rf $(BUILDDIR) $(ROOTDIR)/install + rm -rf $(BUILDDIR) "$(ROOTDIR)/install" rm -f $(OBECOMP) @@ -60,19 +60,20 @@ assemble: @printf ' DATAMODEL: %s\n' "$(DATAMODEL)" cd $(BUILDDIR) && $(COMPILE) -c SYSTEM.c Configuration.c Platform.c Heap.c - cd $(BUILDDIR) && $(COMPILE) -c Out.c Strings.c Modules.c Files.c - cd $(BUILDDIR) && $(COMPILE) -c Reals.c Texts.c VT100.c + cd $(BUILDDIR) && $(COMPILE) -c Out.c Reals.c Strings.c Modules.c + cd $(BUILDDIR) && $(COMPILE) -c Files.c Texts.c VT100.c cd $(BUILDDIR) && $(COMPILE) -c OPM.c extTools.c OPS.c OPT.c cd $(BUILDDIR) && $(COMPILE) -c OPC.c OPV.c OPB.c OPP.c - cd $(BUILDDIR) && $(COMPILE) $(STATICLINK) Compiler.c -o $(ROOTDIR)/$(OBECOMP) \ - SYSTEM.o Configuration.o Platform.o Heap.o Out.o Strings.o \ - Modules.o Files.o Reals.o Texts.o VT100.o extTools.o \ - OPM.o OPS.o OPT.o OPC.o OPV.o OPB.o OPP.o + cd $(BUILDDIR) && $(COMPILE) $(STATICLINK) Compiler.c -o "$(ROOTDIR)/$(OBECOMP)" \ + SYSTEM.o Configuration.o Platform.o Heap.o Out.o \ + Strings.o Modules.o Files.o Reals.o Texts.o \ + VT100.o extTools.o \ + OPM.o OPS.o OPT.o OPC.o OPV.o OPB.o OPP.o cp src/runtime/*.[ch] $(BUILDDIR) cp src/runtime/*.Txt $(BUILDDIR) - cp src/runtime/*.Txt $(ROOTDIR) + cp src/runtime/*.Txt "$(ROOTDIR)" @printf '$(OBECOMP) created.\n' @@ -103,25 +104,25 @@ translate: @mkdir -p $(BUILDDIR) @rm -f $(BUILDDIR)/*.sym - cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../Configuration.Mod - cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Platform$(PLATFORM).Mod - cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsFapx -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Heap.Mod - cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Strings.Mod - cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Out.Mod - cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Modules.Mod - cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsFx -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Files.Mod - cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Reals.Mod - cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Texts.Mod - cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/VT100.Mod - cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPM.Mod - cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/extTools.Mod - cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsFx -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPS.Mod - cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPT.Mod - cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPC.Mod - cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPV.Mod - cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPB.Mod - cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPP.Mod - cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -Ssm -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/Compiler.Mod + cd $(BUILDDIR); "$(ROOTDIR)/$(OBECOMP)" -SsrF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../Configuration.Mod + cd $(BUILDDIR); "$(ROOTDIR)/$(OBECOMP)" -SsrF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Platform$(PLATFORM).Mod + cd $(BUILDDIR); "$(ROOTDIR)/$(OBECOMP)" -SsrFapx -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Heap.Mod + cd $(BUILDDIR); "$(ROOTDIR)/$(OBECOMP)" -SsrF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Reals.Mod + cd $(BUILDDIR); "$(ROOTDIR)/$(OBECOMP)" -SsrF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Strings.Mod + cd $(BUILDDIR); "$(ROOTDIR)/$(OBECOMP)" -SsrF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Out.Mod + cd $(BUILDDIR); "$(ROOTDIR)/$(OBECOMP)" -SsrF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Modules.Mod + cd $(BUILDDIR); "$(ROOTDIR)/$(OBECOMP)" -SsrF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Files.Mod + cd $(BUILDDIR); "$(ROOTDIR)/$(OBECOMP)" -SsrF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Texts.Mod + cd $(BUILDDIR); "$(ROOTDIR)/$(OBECOMP)" -SsrF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/VT100.Mod + cd $(BUILDDIR); "$(ROOTDIR)/$(OBECOMP)" -SsrF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPM.Mod + cd $(BUILDDIR); "$(ROOTDIR)/$(OBECOMP)" -SsrF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/extTools.Mod + cd $(BUILDDIR); "$(ROOTDIR)/$(OBECOMP)" -SsrF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPS.Mod + cd $(BUILDDIR); "$(ROOTDIR)/$(OBECOMP)" -SsrF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPT.Mod + cd $(BUILDDIR); "$(ROOTDIR)/$(OBECOMP)" -SsrF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPC.Mod + cd $(BUILDDIR); "$(ROOTDIR)/$(OBECOMP)" -SsrF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPV.Mod + cd $(BUILDDIR); "$(ROOTDIR)/$(OBECOMP)" -SsrF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPB.Mod + cd $(BUILDDIR); "$(ROOTDIR)/$(OBECOMP)" -SsrF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPP.Mod + cd $(BUILDDIR); "$(ROOTDIR)/$(OBECOMP)" -Ssrm -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/Compiler.Mod cp src/runtime/*.[ch] $(BUILDDIR) cp src/runtime/*.Txt $(BUILDDIR) @@ -132,8 +133,8 @@ translate: browsercmd: @printf '\nMaking symbol browser\n' - @cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -Ss -O$(MODEL) ../../src/runtime/Oberon.Mod - @cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -Sm -O$(MODEL) ../../src/tools/browser/BrowserCmd.Mod + @cd $(BUILDDIR); "$(ROOTDIR)/$(OBECOMP)" -Ss -O$(MODEL) ../../src/runtime/Oberon.Mod + @cd $(BUILDDIR); "$(ROOTDIR)/$(OBECOMP)" -Sm -O$(MODEL) ../../src/tools/browser/BrowserCmd.Mod @cd $(BUILDDIR); $(COMPILE) BrowserCmd.c Oberon.c -o showdef \ Platform.o Texts.o OPT.o Heap.o Out.o SYSTEM.o OPM.o OPS.o OPV.o \ Files.o Reals.o Modules.o VT100.o Configuration.o Strings.o \ @@ -145,7 +146,7 @@ browsercmd: # makeinstalldir: Use only after a successful full build. Creates an # installation directory image in $(BUILDDOR)/install makeinstalldir: - @printf '\nCreating installation image at $(ROOTDIR)/install\n' + @printf '\nCreating installation image at "$(ROOTDIR)/install\n"' @rm -rf "$(ROOTDIR)/install" @mkdir -p "$(ROOTDIR)/install/bin" @@ -167,9 +168,9 @@ makeinstalldir: # instructions: Advice on completion of local build instructions: FORCE - @printf '\nOberon build and test complete, result is in $(ROOTDIR)/install\n' - @printf '\nYou can use the new compiler by running $(ROOTDIR)/install/bin/$(ONAME),\n' - @printf 'Or add it to your path as follows:\n' + @printf '\nOberon build and test complete, result is in "$(ROOTDIR)/install".\n' + @printf '\nYou can use the new compiler by running "$(ROOTDIR)/install/bin/$(ONAME)",\n' + @printf 'or add it to your path as follows:\n' @printf 'export PATH=\"$(ROOTDIR)/install/bin:$$PATH\"\n' @printf '\n' @@ -188,8 +189,8 @@ installable: uninstall: installable @printf '\nUninstalling from \"$(INSTALLDIR)\"\n' + @[ -d "$(INSTALLDIR)/lib" ] && sh src/tools/make/addlibrary.sh uninstall "$(INSTALLDIR)/lib" $(ONAME) || echo nolibdir, skipping rm -rf "$(INSTALLDIR)" - @sh src/tools/make/addlibrary.sh uninstall \""$(INSTALLDIR)/lib"\" $(oname) # install: Use only after a successful full build. Installs the compiler @@ -199,7 +200,7 @@ install: uninstall @printf '\nInstalling into \"$(INSTALLDIR)\"\n' @rm -rf "$(INSTALLDIR)" @cp -rf "$(ROOTDIR)/install/" "$(INSTALLDIR)" - @sh src/tools/make/addlibrary.sh install \""$(INSTALLDIR)/lib"\" $(ONAME) + @sh src/tools/make/addlibrary.sh install "$(INSTALLDIR)/lib" $(ONAME) @printf '\nOberon compiler installed to $(INSTALLDIR)\n' @printf '\nNow add $(INSTALLDIR)/bin to your path, for example with the command:\n' @printf 'export PATH=\"$(INSTALLDIR)/bin:$$PATH\"\n' @@ -208,166 +209,167 @@ install: uninstall runtime: FORCE @printf '\nMaking run time library for -O$(MODEL)\n' - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Platform$(PLATFORM).Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Heap.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Out.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Modules.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Strings.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/In.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/VT100.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Files.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Math.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/MathL.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Reals.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Texts.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Oberon.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/runtime/Platform$(PLATFORM).Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/runtime/Heap.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/runtime/Out.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/runtime/Modules.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/runtime/Reals.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/runtime/Strings.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/runtime/In.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/runtime/VT100.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/runtime/Files.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/runtime/Math.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/runtime/MathL.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/runtime/Texts.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/runtime/Oberon.Mod v4: @printf '\nMaking v4 library for -O$(MODEL)\n' - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/v4/Args.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/v4/Console.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/v4/Printer.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/v4/Sets.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/v4/Args.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/v4/Console.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/v4/Printer.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/v4/Sets.Mod ooc2: @printf '\nMaking ooc2 library for -O$(MODEL)\n' - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc2/ooc2Strings.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc2/ooc2Ascii.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc2/ooc2CharClass.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc2/ooc2ConvTypes.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc2/ooc2IntConv.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc2/ooc2IntStr.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc2/ooc2Real0.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc2/ooc2Strings.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc2/ooc2Ascii.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc2/ooc2CharClass.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc2/ooc2ConvTypes.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc2/ooc2IntConv.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc2/ooc2IntStr.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc2/ooc2Real0.Mod ooc: @printf '\nMaking ooc library for -O$(MODEL)\n' - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocLowReal.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocLowLReal.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocRealMath.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocOakMath.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocLRealMath.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocLongInts.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocComplexMath.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocLComplexMath.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocAscii.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocCharClass.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocStrings.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocConvTypes.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocLRealConv.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocLRealStr.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocRealConv.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocRealStr.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocIntConv.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocIntStr.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocMsg.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocSysClock.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocTime.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocChannel.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocStrings2.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocRts.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocFilenames.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocTextRider.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocBinaryRider.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocJulianDay.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocFilenames.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocwrapperlibc.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ooc/oocC$(DATAMODEL).Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocLowReal.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocLowLReal.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocRealMath.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocOakMath.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocLRealMath.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocLongInts.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocComplexMath.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocLComplexMath.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocAscii.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocCharClass.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocStrings.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocConvTypes.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocLRealConv.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocLRealStr.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocRealConv.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocRealStr.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocIntConv.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocIntStr.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocMsg.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocSysClock.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocTime.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocChannel.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocStrings2.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocRts.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocFilenames.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocTextRider.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocBinaryRider.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocJulianDay.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocFilenames.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocwrapperlibc.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ooc/oocC$(DATAMODEL).Mod oocX11: @printf '\nMaking oocX11 library for -O$(MODEL)\n' - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/oocX11/oocX11.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/oocX11/oocXutil.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/oocX11/oocXYplane.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/oocX11/oocX11.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/oocX11/oocXutil.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/oocX11/oocXYplane.Mod ulm: @printf '\nMaking ulm library for -O$(MODEL)\n' - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmTypes.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmObjects.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmPriorities.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmDisciplines.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmServices.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmSys.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmSYSTEM.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmEvents.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmProcess.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmResources.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmForwarders.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmRelatedEvents.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmStreams.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmStrings.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmSysTypes.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmTexts.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmSysConversions.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmErrors.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmSysErrors.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmSysStat.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmASCII.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmSets.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmIO.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmAssertions.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmIndirectDisciplines.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmStreamDisciplines.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmIEEE.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmMC68881.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmReals.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmPrint.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmWrite.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmConstStrings.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmPlotters.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmSysIO.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmLoader.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmNetIO.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmPersistentObjects.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmPersistentDisciplines.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmOperations.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmScales.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmTimes.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmClocks.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmTimers.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmConditions.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmStreamConditions.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmTimeConditions.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmCiphers.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmCipherOps.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmBlockCiphers.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmAsymmetricCiphers.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmConclusions.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmRandomGenerators.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmTCrypt.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/ulm/ulmIntOperations.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmTypes.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmObjects.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmPriorities.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmDisciplines.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmServices.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmSys.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmSYSTEM.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmEvents.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmProcess.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmResources.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmForwarders.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmRelatedEvents.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmStreams.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmStrings.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmSysTypes.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmTexts.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmSysConversions.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmErrors.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmSysErrors.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmSysStat.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmASCII.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmSets.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmIO.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmAssertions.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmIndirectDisciplines.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmStreamDisciplines.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmIEEE.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmMC68881.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmReals.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmPrint.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmWrite.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmConstStrings.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmPlotters.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmSysIO.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmLoader.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmNetIO.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmPersistentObjects.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmPersistentDisciplines.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmOperations.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmScales.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmTimes.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmClocks.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmTimers.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmConditions.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmStreamConditions.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmTimeConditions.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmCiphers.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmCipherOps.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmBlockCiphers.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmAsymmetricCiphers.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmConclusions.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmRandomGenerators.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmTCrypt.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/ulm/ulmIntOperations.Mod pow32: @printf '\nMaking pow library for -O$(MODEL)\n' - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/pow/powStrings.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/pow/powStrings.Mod misc: @printf '\nMaking misc library for -O$(MODEL)\n' - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/misc/crt.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/misc/Listen.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/misc/MersenneTwister.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/misc/MultiArrays.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/misc/MultiArrayRiders.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/misc/crt.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/misc/Listen.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/misc/MersenneTwister.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/misc/MultiArrays.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/misc/MultiArrayRiders.Mod s3: @printf '\nMaking s3 library for -O$(MODEL)\n' - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethBTrees.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethMD5.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethSets.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethZlib.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethZlibBuffers.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethZlibInflate.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethZlibDeflate.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethZlibReaders.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethZlibWriters.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethZip.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethRandomNumbers.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethGZReaders.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethGZWriters.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethUnicode.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethDates.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethReals.Mod - cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/s3/ethStrings.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/s3/ethBTrees.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/s3/ethMD5.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/s3/ethSets.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/s3/ethZlib.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/s3/ethZlibBuffers.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/s3/ethZlibInflate.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/s3/ethZlibDeflate.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/s3/ethZlibReaders.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/s3/ethZlibWriters.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/s3/ethZip.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/s3/ethRandomNumbers.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/s3/ethGZReaders.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/s3/ethGZWriters.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/s3/ethUnicode.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/s3/ethDates.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/s3/ethReals.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/s3/ethStrings.Mod + cd $(BUILDDIR)/$(MODEL); "$(ROOTDIR)/$(OBECOMP)" -Fs -O$(MODEL) ../../../src/library/s3/ethBase64.Mod @@ -386,13 +388,12 @@ library: @make -f src/tools/make/oberon.mk -s O$(MODEL)library MODEL=$(MODEL) @printf '\nMaking lib$(ONAME)-O$(MODEL) .a and .so\n' ar rcs "$(BUILDDIR)/$(MODEL)/lib$(ONAME)-O$(MODEL).a" $(BUILDDIR)/$(MODEL)/*.o - @cd $(BUILDDIR)/$(MODEL) && $(COMPILE) -shared -o lib$(ONAME)-O$(MODEL).so *.o + @cd $(BUILDDIR)/$(MODEL) && $(COMPILE) -shared -o lib$(ONAME)-O$(MODEL)$(DYNEXT) *.o sourcechanges: - @cd $(BUILDDIR) && sh $(ROOTDIR)/src/tools/make/sourcechanges.sh $(ROOTDIR)/bootstrap/$(PLATFORM)-$(ADRSIZE)$(ALIGNMENT) - + @cd $(BUILDDIR) && sh "$(ROOTDIR)/src/tools/make/sourcechanges.sh" "$(ROOTDIR)/bootstrap/$(PLATFORM)-$(ADRSIZE)$(ALIGNMENT)" diff --git a/src/tools/make/sourcechanges.sh b/src/tools/make/sourcechanges.sh index 1439ce4e..86aa9542 100644 --- a/src/tools/make/sourcechanges.sh +++ b/src/tools/make/sourcechanges.sh @@ -12,10 +12,10 @@ # The current directory is the build directory changes="0" -for f in $1/*; do - fn=$(basename $f) - egrep -v -f ../../src/tools/make/ignore $f >$fn.old - egrep -v -f ../../src/tools/make/ignore $fn >$fn.new +find "$1" -type f -print0 | while IFS= read -r -d '' f; do + fn=$(basename "$f") + grep -E -v -f ../../src/tools/make/ignore "$f" >$fn.old + grep -E -v -f ../../src/tools/make/ignore $fn >$fn.new if ! diff -U 2 -b $fn.old $fn.new >$fn.diff; then echo "" echo ""