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 1c2d92dd..19fc1ede 100644
--- a/.gitignore
+++ b/.gitignore
@@ -2,6 +2,7 @@
/Configuration.Mod
/Configuration.Make
/build/*
+/install/*
/*.exe
/*.obj
/*.[cho]
@@ -10,6 +11,7 @@
/*.sym
/*.asm
/*.mod
+/Errors.Txt
/Errors.txt
/olang
/src/test/**/*.exe
@@ -19,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
@@ -34,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 b5dbdb74..95d7f840 100644
--- a/ReadMe.md
+++ b/ReadMe.md
@@ -1,12 +1,12 @@
-[](http://brownsmeet.com/log/)
+
# Ѵ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.
@@ -14,8 +14,8 @@ default libraries complying with the Oakwood Guidelines for Oberon-2 compilers.
### Contents
[**Installation**](#installation)
- [**A 'Hello' application**](#a-hello-application)
- [**Licensing**](#licensing)
+ [**Compiling a 'Hello' application**](#a-hello-application)
+ [**License**](#license)
[**Platform support and porting**](#platform-support-and-porting)
[**Language support and libraries**](#language-support-and-libraries)
[**History**](#history)
@@ -27,8 +27,18 @@ default libraries complying with the Oakwood Guidelines for Oberon-2 compilers.
## Installation
-While pre-built packages are not provided, it is easy to install the Oberon compiler and libraries
-with the following simple steps.
+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: `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:
+
#### 1. Install prerequisites
@@ -43,28 +53,57 @@ with the following simple steps.
More details, including for MingW and MS C, in [**Installation**](/doc/Installation.md).
-#### 2. Build and install the compiler and libraries
+
+#### 2. Clone and build the compiler and libraries
1. `git clone https://github.com/vishaps/voc`
2. `cd voc`
-3. `[sudo] make full`
+3. `make full`
-Since 'make full' will install the compiler and libraries, it needs root (unix) or administrator (windows) privileges.
+`make full` will create an installation directory under your local repository at voc/install.
-#### 3. Set your PATH environment variable
+`mmake full` runs `ldconfig` to configure the linker to find libraries in voc/install, but you
+need to update your program search PATH yourself (see step 4 below).
-Set your path to the installed compiler binary location as reported
-by make full, e.g.
-| System | Set path |
-| --------- | -------------------------------------- |
-| Linux | `export PATH="/opt/voc/bin:$PATH"` |
-| BSD | `export PATH="/usr/local/share/voc/bin:$PATH"` |
-| Windows | See [Installation](/doc/Installation.md) |
-| Termux | `export PATH="/data/data/com.termux/files/opt/voc/bin:$PATH"` |
+
+#### 3. Optionally install to a system directory
+
+Run `make install` as root to copy the voc/install directory to the appropriate directory
+for your OS as follows:
+
+| System | Where `make install` puts the installation |
+| ------- | -------------------------------------- |
+| Linux | `/opt/voc` |
+| BSD | `/usr/local/share/voc` |
+| Windows | See [**Windows installation**](/doc/Winstallation.md) |
+| Termux | `/data/data/com.termux/files/opt/voc` |
+
+`make install` updates `ldconfg` with the new library locations.
+
+
+#### 4. Set your PATH environment variable
+
+Since there are so many ways that different systems and users manage their PATHs, we leave
+it to you to update your path to include the compiler binary.
+
+Both `make full` and `make install` display instructions on setting the path specific to your
+system.
+
+For reference this will be:
+
+| Installation choice | Set path |
+| --------- | -------------------------------------- |
+| 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 Termux | `export PATH="/data/data/com.termux/files/opt/voc/bin:$PATH"` |
Also see [**Installation**](/doc/Installation.md).
+The compiler finds the rest of the installation based on the location from which it is loaded.
+
## A 'Hello' application
@@ -88,7 +127,7 @@ Alternatively the Oakwood module Out can be used to write directly to stdout:
MODULE hello;
IMPORT Out;
BEGIN
- Out.String("Hello."); Out.Ln;
+ Out.String("Hello."); Out.Ln
END hello.
```
@@ -99,12 +138,35 @@ Compile as follows:
The -m parameter tells voc that this is a main module, and to generate an
executable binary.
-Execute as usual on Linux ('./hello') or Windows ('hello').
+Execute as usual on Linux (`./hello`) or Windows (`hello`).
+
+For more details on compilation, see [**Compiling**](/doc/Compiling.md).
+
+### Viewing the interfaces of included modules.
+
+In order to see the definition of a module's interface, use the "showdef" program.
+
+```
+$ showdef Out
+DEFINITION Out;
+
+ VAR
+ IsConsole-: BOOLEAN;
+
+ PROCEDURE Char(ch: CHAR);
+ PROCEDURE Flush;
+ PROCEDURE Int(x: INT64; n: INT64);
+ PROCEDURE Ln;
+ PROCEDURE LongReal(x: LONGREAL; n: INT16);
+ PROCEDURE Open;
+ PROCEDURE Real(x: REAL; n: INT16);
+ PROCEDURE String(str: ARRAY OF CHAR);
+
+END Out.
+```
-Also see [**Compiling**](/doc/Compiling.md).
-
-## Licensing
+## License
Vishap Oberon's frontend and C backend engine is a fork of Josef Templ’s Ofront, which has been released
under the FreeBSD License. Unlike Ofront, Vishap Oberon does not include the Oberon v4 GUI environment.
@@ -119,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).
@@ -185,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
@@ -206,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.
@@ -218,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
@@ -234,7 +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).
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 43baa836..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
@@ -237,7 +243,7 @@ static inline double SYSTEM_ABSD(double i) {return i >= 0.0 ? i : -i;}
#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r))))
#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p)))
#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p)
-#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p)
+#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*((typ*)p)
@@ -258,10 +264,15 @@ extern void Heap_INCREF();
// Main module initialisation, registration and finalisation
-extern void Platform_Init(INT32 argc, ADDRESS argv);
+extern void Modules_Init(INT32 argc, ADDRESS argv);
extern void Heap_FINALL();
-#define __INIT(argc, argv) static void *m; Platform_Init(argc, (ADDRESS)&argv);
+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 dc4bb660..4460479d 100644
--- a/bootstrap/unix-44/Compiler.c
+++ b/bootstrap/unix-44/Compiler.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -20,9 +20,9 @@
#include "extTools.h"
-static CHAR Compiler_mname[256];
+static void Compiler_FindLocalObjectFiles (CHAR *objectnames, ADDRESS objectnames__len);
export void Compiler_Module (BOOLEAN *done);
static void Compiler_PropagateElementaryTypeSizes (void);
export void Compiler_Translate (void);
@@ -41,11 +41,12 @@ void Compiler_Module (BOOLEAN *done)
OPT_Export(&ext, &new);
if (OPM_noerr) {
OPM_OpenFiles((void*)OPT_SelfName, 256);
+ OPM_DeleteObj((void*)OPT_SelfName, 256);
OPC_Init();
OPV_Module(p);
if (OPM_noerr) {
if ((__IN(10, OPM_Options, 32) && __STRCMP(OPM_modName, "SYSTEM") != 0)) {
- OPM_DeleteNewSym();
+ OPM_DeleteSym((void*)OPT_SelfName, 256);
OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogWStr((CHAR*)" Main program.", 16);
OPM_LogVT100((CHAR*)"0m", 3);
@@ -61,7 +62,7 @@ void Compiler_Module (BOOLEAN *done)
}
}
} else {
- OPM_DeleteNewSym();
+ OPM_DeleteSym((void*)OPT_SelfName, 256);
}
}
}
@@ -88,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;
@@ -104,14 +105,44 @@ static void Compiler_PropagateElementaryTypeSizes (void)
}
}
+static void Compiler_FindLocalObjectFiles (CHAR *objectnames, ADDRESS objectnames__len)
+{
+ OPT_Link l = NIL;
+ CHAR fn[64];
+ Platform_FileIdentity id;
+ objectnames[0] = 0x00;
+ l = OPT_Links;
+ while (l != NIL) {
+ __COPY(l->name, fn, 64);
+ Strings_Append((CHAR*)".sym", 5, (void*)fn, 64);
+ if (Platform_IdentifyByName(fn, 64, &id, Platform_FileIdentity__typ) == 0) {
+ __COPY(l->name, fn, 64);
+ Strings_Append((CHAR*)".o", 3, (void*)fn, 64);
+ if (Platform_IdentifyByName(fn, 64, &id, Platform_FileIdentity__typ) == 0) {
+ Strings_Append((CHAR*)" ", 2, (void*)objectnames, objectnames__len);
+ Strings_Append(fn, 64, (void*)objectnames, objectnames__len);
+ } else {
+ OPM_LogVT100((CHAR*)"91m", 4);
+ OPM_LogWStr((CHAR*)"Link warning: a local symbol file is present for module ", 57);
+ OPM_LogWStr(l->name, 256);
+ OPM_LogWStr((CHAR*)", but local object file '", 26);
+ OPM_LogWStr(fn, 64);
+ OPM_LogWStr((CHAR*)"' is missing.", 14);
+ OPM_LogVT100((CHAR*)"0m", 3);
+ OPM_LogWLn();
+ }
+ }
+ l = l->next;
+ }
+}
+
void Compiler_Translate (void)
{
BOOLEAN done;
- CHAR modulesobj[2048];
- modulesobj[0] = 0x00;
+ CHAR linkfiles[2048];
if (OPM_OpenPar()) {
for (;;) {
- OPM_Init(&done, (void*)Compiler_mname, 256);
+ OPM_Init(&done);
if (!done) {
return;
}
@@ -131,11 +162,9 @@ void Compiler_Translate (void)
} else {
if (!__IN(10, OPM_Options, 32)) {
extTools_Assemble(OPM_modName, 32);
- Strings_Append((CHAR*)" ", 2, (void*)modulesobj, 2048);
- Strings_Append(OPM_modName, 32, (void*)modulesobj, 2048);
- Strings_Append((CHAR*)".o", 3, (void*)modulesobj, 2048);
} else {
- extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), modulesobj, 2048);
+ Compiler_FindLocalObjectFiles((void*)linkfiles, 2048);
+ extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), linkfiles, 2048);
}
}
}
diff --git a/bootstrap/unix-44/Configuration.c b/bootstrap/unix-44/Configuration.c
index 2d0061df..fa87c9de 100644
--- a/bootstrap/unix-44/Configuration.c
+++ b/bootstrap/unix-44/Configuration.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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("1.95 [2016/11/24]. 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 b28e0caa..c3c54eed 100644
--- a/bootstrap/unix-44/Configuration.h
+++ b/bootstrap/unix-44/Configuration.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 548774b0..54341368 100644
--- a/bootstrap/unix-44/Files.c
+++ b/bootstrap/unix-44/Files.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 {
@@ -36,7 +36,7 @@ typedef
INT32 fd, len, pos;
Files_Buffer bufs[4];
INT16 swapper, state;
- Files_File next;
+ struct Files_FileDesc *next;
} Files_FileDesc;
typedef
@@ -48,11 +48,12 @@ typedef
} Files_Rider;
-static Files_File Files_files;
+export INT16 Files_MaxPathLength, Files_MaxNameLength;
+static Files_FileDesc *Files_files;
static INT16 Files_tempno;
static CHAR Files_HOME[1024];
static struct {
- LONGINT len[1];
+ ADDRESS len[1];
CHAR data[1];
} *Files_SearchPath;
@@ -60,58 +61,68 @@ export ADDRESS *Files_FileDesc__typ;
export ADDRESS *Files_BufDesc__typ;
export ADDRESS *Files_Rider__typ;
+static void Files_Assert (BOOLEAN truth);
export Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
static Files_File Files_CacheEntry (Platform_FileIdentity identity);
-export void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
+export void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res);
export void Files_Close (Files_File f);
static void Files_CloseOSFile (Files_File f);
static void Files_Create (Files_File f);
-export void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res);
-static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode);
+export void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res);
+static void Files_Deregister (CHAR *name, ADDRESS name__len);
+static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode);
static void Files_Finalize (SYSTEM_PTR o);
-static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len);
+static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len);
static void Files_Flush (Files_Buffer buf);
export void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
-export void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
-static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len);
-static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len);
+export void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len);
+static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len);
+static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len);
export INT32 Files_Length (Files_File f);
-static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len);
-export Files_File Files_New (CHAR *name, LONGINT name__len);
-export Files_File Files_Old (CHAR *name, LONGINT name__len);
+static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len);
+export Files_File Files_New (CHAR *name, ADDRESS name__len);
+export Files_File Files_Old (CHAR *name, ADDRESS name__len);
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_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+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);
export void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
-export void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
-export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
+export void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
+export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
export void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
export void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
-export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
export void Files_Register (Files_File f);
-export void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res);
-static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len);
+export void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res);
+static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len);
export void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos);
-export void Files_SetSearchPath (CHAR *path, LONGINT path__len);
+export void Files_SetSearchPath (CHAR *path, ADDRESS path__len);
export void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
export void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
-export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
export void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
export void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
export void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
export void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
export void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
export void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
-export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
#define Files_IdxTrap() __HALT(-1)
-#define Files_ToAdr(x) (ADDRESS)x
-static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
+static void Files_Assert (BOOLEAN truth)
+{
+ if (!truth) {
+ Out_Ln();
+ __ASSERT(truth, 0);
+ }
+}
+
+static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
{
__DUP(s, s__len, CHAR);
Out_Ln();
@@ -120,17 +131,17 @@ static void Files_Err (CHAR *s, LONGINT 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();
@@ -138,98 +149,125 @@ static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
__DEL(s);
}
-static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len)
+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, LONGINT finalName__len, CHAR *name, LONGINT name__len)
+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);
}
+static void Files_Deregister (CHAR *name, ADDRESS name__len)
+{
+ Platform_FileIdentity identity;
+ Files_File osfile = NIL;
+ INT16 error;
+ __DUP(name, name__len, CHAR);
+ if (Platform_IdentifyByName(name, name__len, &identity, Platform_FileIdentity__typ) == 0) {
+ osfile = (Files_File)Files_files;
+ while ((osfile != NIL && !Platform_SameFile(osfile->identity, identity))) {
+ osfile = (Files_File)osfile->next;
+ }
+ if (osfile != NIL) {
+ __ASSERT(!osfile->tempFile, 0);
+ __ASSERT(osfile->fd >= 0, 0);
+ __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, 256, (void*)osfile->workName, 256);
+ if (error != 0) {
+ Files_Err((CHAR*)"Couldn't rename previous version of file being registered", 58, osfile, error);
+ }
+ }
+ }
+ __DEL(name);
+}
+
static void Files_Create (Files_File f)
{
- Platform_FileIdentity identity;
BOOLEAN done;
INT16 error;
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 if (f->state == 2) {
- __COPY(f->registerName, f->workName, 101);
+ } else {
+ __ASSERT(f->state == 2, 0);
+ 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;
@@ -275,27 +313,6 @@ static void Files_Flush (Files_Buffer buf)
}
}
-static void Files_CloseOSFile (Files_File f)
-{
- Files_File prev = NIL;
- INT16 error;
- if (Files_files == f) {
- Files_files = f->next;
- } else {
- prev = Files_files;
- while ((prev != NIL && prev->next != f)) {
- prev = prev->next;
- }
- if (prev->next != NIL) {
- prev->next = f->next;
- }
- }
- error = Platform_Close(f->fd);
- f->fd = -1;
- f->state = 1;
- Heap_FileCount -= 1;
-}
-
void Files_Close (Files_File f)
{
INT32 i;
@@ -303,11 +320,10 @@ 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;
}
- Files_CloseOSFile(f);
}
}
@@ -316,13 +332,13 @@ INT32 Files_Length (Files_File f)
return f->len;
}
-Files_File Files_New (CHAR *name, LONGINT name__len)
+Files_File Files_New (CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
__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;
@@ -332,7 +348,7 @@ Files_File Files_New (CHAR *name, LONGINT name__len)
return f;
}
-static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len)
+static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len)
{
INT16 i;
CHAR ch;
@@ -344,38 +360,38 @@ static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT 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, LONGINT name__len)
+static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@@ -383,7 +399,7 @@ static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
ch = name[0];
while ((ch != 0x00 && ch != '/')) {
i += 1;
- ch = name[i];
+ ch = name[__X(i, name__len)];
}
return ch == '/';
}
@@ -392,15 +408,15 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
{
Files_File f = NIL;
INT16 i, error;
- f = Files_files;
+ f = (Files_File)Files_files;
while (f != NIL) {
if (Platform_SameFile(identity, f->identity)) {
if (!Platform_SameFileTime(identity, f->identity)) {
i = 0;
while (i < 4) {
- if (f->bufs[i] != NIL) {
- f->bufs[i]->org = -1;
- f->bufs[i] = NIL;
+ if (f->bufs[__X(i, 4)] != NIL) {
+ f->bufs[__X(i, 4)]->org = -1;
+ f->bufs[__X(i, 4)] = NIL;
}
i += 1;
}
@@ -410,12 +426,12 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
}
return f;
}
- f = f->next;
+ f = (Files_File)f->next;
}
return NIL;
}
-Files_File Files_Old (CHAR *name, LONGINT name__len)
+Files_File Files_Old (CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
INT32 fd;
@@ -456,6 +472,7 @@ Files_File Files_Old (CHAR *name, LONGINT name__len)
error = Platform_Identify(fd, &identity, Platform_FileIdentity__typ);
f = Files_CacheEntry(identity);
if (f != NIL) {
+ error = Platform_Close(fd);
__DEL(name);
return f;
} else {
@@ -466,7 +483,7 @@ Files_File Files_Old (CHAR *name, LONGINT 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;
@@ -498,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;
}
@@ -526,7 +543,7 @@ void Files_GetDate (Files_File f, INT32 *t, INT32 *d)
INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ)
{
- __ASSERT((*r).offset <= 4096, 0);
+ Files_Assert((*r).offset <= 4096);
return (*r).org + (*r).offset;
}
@@ -544,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) {
@@ -585,7 +602,7 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
org = 0;
offset = 0;
}
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
(*r).buf = buf;
(*r).org = org;
(*r).offset = offset;
@@ -604,9 +621,9 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
buf = (*r).buf;
offset = (*r).offset;
}
- __ASSERT(offset <= buf->size, 0);
+ 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);
@@ -618,7 +635,12 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
}
}
-void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
+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;
Files_Buffer buf = NIL;
@@ -644,12 +666,12 @@ void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x
} else {
min = n;
}
- __MOVE((ADDRESS)buf->data + Files_ToAdr(offset), (ADDRESS)x + Files_ToAdr(xpos), min);
+ __MOVE((ADDRESS)&buf->data[__X(offset, 4096)], (ADDRESS)&x[__X(xpos, x__len)], min);
offset += min;
(*r).offset = offset;
xpos += min;
n -= min;
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
}
(*r).res = 0;
(*r).eof = 0;
@@ -666,14 +688,14 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
INT32 offset;
buf = (*r).buf;
offset = (*r).offset;
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
- __ASSERT(offset < 4096, 0);
- buf->data[offset] = x;
+ Files_Assert(offset < 4096);
+ buf->data[__X(offset, 4096)] = x;
buf->chg = 1;
if (offset == buf->size) {
buf->size += 1;
@@ -683,7 +705,7 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
(*r).res = 0;
}
-void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
+void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n)
{
INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
@@ -694,23 +716,23 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT
buf = (*r).buf;
offset = (*r).offset;
while (n > 0) {
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
restInBuf = 4096 - offset;
if (n > restInBuf) {
min = restInBuf;
} else {
min = n;
}
- __MOVE((ADDRESS)x + Files_ToAdr(xpos), (ADDRESS)buf->data + Files_ToAdr(offset), min);
+ __MOVE((ADDRESS)&x[__X(xpos, x__len)], (ADDRESS)&buf->data[__X(offset, 4096)], min);
offset += min;
(*r).offset = offset;
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
if (offset > buf->size) {
buf->f->len += offset - buf->size;
buf->size = offset;
@@ -722,14 +744,15 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT
(*r).res = 0;
}
-void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res)
+void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res)
{
__DUP(name, name__len, CHAR);
+ Files_Deregister(name, name__len);
*res = Platform_Unlink((void*)name, name__len);
__DEL(name);
}
-void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res)
+void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res)
{
INT32 fdold, fdnew, n;
INT16 error, ignore;
@@ -795,31 +818,30 @@ void Files_Register (Files_File f)
{
INT16 idx, errcode;
Files_File f1 = NIL;
- CHAR file[104];
if ((f->state == 1 && f->registerName[0] != 0x00)) {
f->state = 2;
}
Files_Close(f);
if (f->registerName[0] != 0x00) {
- Files_Rename(f->workName, 101, f->registerName, 101, &errcode);
+ Files_Deregister(f->registerName, 256);
+ Files_Rename(f->workName, 256, f->registerName, 256, &errcode);
if (errcode != 0) {
- __COPY(f->registerName, file, 104);
- __HALT(99);
+ Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode);
}
- __COPY(f->registerName, f->workName, 101);
+ __MOVE(f->registerName, f->workName, 256);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
}
-void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res)
+void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res)
{
__DUP(path, path__len, CHAR);
*res = Platform_Chdir((void*)path, path__len);
__DEL(path);
}
-static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len)
+static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len)
{
INT32 i, j;
if (!Platform_LittleEndian) {
@@ -827,7 +849,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT 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 {
@@ -877,36 +899,36 @@ void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x)
Files_FlipBytes((void*)b, 8, (void*)&*x, 8);
}
-void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
+void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
{
INT16 i;
CHAR ch;
i = 0;
do {
Files_Read(&*R, R__typ, (void*)&ch);
- x[i] = ch;
+ x[__X(i, x__len)] = ch;
i += 1;
} while (!(ch == 0x00));
}
-void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
+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, LONGINT x__len)
+void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len)
{
INT8 s, b;
INT64 q;
@@ -919,7 +941,7 @@ void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__
Files_Read(&*R, R__typ, (void*)&b);
}
q += (INT64)__ASH((__MASK(b, -64) - __ASHL(__ASHR(b, 6), 6)), s);
- __ASSERT(x__len <= 8, 0);
+ Files_Assert(x__len <= 8);
__MOVE((ADDRESS)&q, (ADDRESS)x, x__len);
}
@@ -931,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);
}
@@ -950,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);
}
@@ -972,11 +996,11 @@ void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x)
Files_WriteBytes(&*R, R__typ, (void*)b, 8, 8);
}
-void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
+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);
@@ -985,17 +1009,38 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT 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, LONGINT name__len)
+void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len)
{
__COPY(f->workName, name, name__len);
}
+static void Files_CloseOSFile (Files_File f)
+{
+ Files_File prev = NIL;
+ INT16 error;
+ if (Files_files == (void *) f) {
+ Files_files = f->next;
+ } else {
+ prev = (Files_File)Files_files;
+ while ((prev != NIL && prev->next != (void *) f)) {
+ prev = (Files_File)prev->next;
+ }
+ if (prev->next != NIL) {
+ prev->next = f->next;
+ }
+ }
+ error = Platform_Close(f->fd);
+ f->fd = -1;
+ f->state = 1;
+ Heap_FileCount -= 1;
+}
+
static void Files_Finalize (SYSTEM_PTR o)
{
Files_File f = NIL;
@@ -1004,12 +1049,12 @@ 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);
}
}
}
-void Files_SetSearchPath (CHAR *path, LONGINT path__len)
+void Files_SetSearchPath (CHAR *path, ADDRESS path__len)
{
__DUP(path, path__len, CHAR);
if (Strings_Length(path, path__len) != 0) {
@@ -1023,11 +1068,10 @@ void Files_SetSearchPath (CHAR *path, LONGINT path__len)
static void EnumPtrs(void (*P)(void*))
{
- P(Files_files);
P(Files_SearchPath);
}
-__TDESC(Files_FileDesc, 1, 5) = {__TDFLDS("FileDesc", 252), {228, 232, 236, 240, 248, -24}};
+__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}};
@@ -1047,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 79164af5..ccdabcc2 100644
--- a/bootstrap/unix-44/Files.h
+++ b/bootstrap/unix-44/Files.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -10,9 +10,8 @@ typedef
typedef
struct Files_FileDesc {
- char _prvt0[216];
- INT32 fd;
- char _prvt1[32];
+ INT32 _prvt0;
+ char _prvt1[560];
} Files_FileDesc;
typedef
@@ -23,46 +22,48 @@ typedef
} Files_Rider;
+import INT16 Files_MaxPathLength, Files_MaxNameLength;
import ADDRESS *Files_FileDesc__typ;
import ADDRESS *Files_Rider__typ;
import Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
-import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
+import void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res);
import void Files_Close (Files_File f);
-import void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res);
+import void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res);
import void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
-import void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
+import void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len);
import INT32 Files_Length (Files_File f);
-import Files_File Files_New (CHAR *name, LONGINT name__len);
-import Files_File Files_Old (CHAR *name, LONGINT name__len);
+import Files_File Files_New (CHAR *name, ADDRESS name__len);
+import Files_File Files_Old (CHAR *name, ADDRESS name__len);
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_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+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);
import void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
-import void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
-import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
+import void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
+import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
import void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
import void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
-import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
import void Files_Register (Files_File f);
-import void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res);
+import void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res);
import void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos);
-import void Files_SetSearchPath (CHAR *path, LONGINT path__len);
+import void Files_SetSearchPath (CHAR *path, ADDRESS path__len);
import void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
import void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
-import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
import void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
import void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
import void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
import void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
import void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
import void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
-import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
import void *Files__init(void);
diff --git a/bootstrap/unix-44/Heap.c b/bootstrap/unix-44/Heap.c
index 72677604..42552415 100644
--- a/bootstrap/unix-44/Heap.c
+++ b/bootstrap/unix-44/Heap.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,8 +68,10 @@ static INT32 Heap_freeList[10];
static INT32 Heap_bigBlocks;
export INT32 Heap_allocated;
static BOOLEAN Heap_firstTry;
-static INT32 Heap_heap, Heap_heapend;
-export INT32 Heap_heapsize;
+static INT16 Heap_ldUnit;
+export INT32 Heap_heap;
+static INT32 Heap_heapMin, Heap_heapMax;
+export INT32 Heap_heapsize, Heap_heapMinExpand;
static Heap_FinNode Heap_fin;
static INT16 Heap_lockdepth;
static BOOLEAN Heap_interrupted;
@@ -84,15 +86,16 @@ static void Heap_CheckFin (void);
static void Heap_ExtendHeap (INT32 blksz);
export void Heap_FINALL (void);
static void Heap_Finalize (void);
+export INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len);
export void Heap_GC (BOOLEAN markStack);
-static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len);
+static void Heap_HeapSort (INT32 n, INT32 *a, ADDRESS a__len);
export void Heap_INCREF (Heap_Module m);
export void Heap_InitHeap (void);
export void Heap_Lock (void);
static void Heap_Mark (INT32 q);
-static void Heap_MarkCandidates (INT32 n, INT32 *cand, LONGINT cand__len);
+static void Heap_MarkCandidates (INT32 n, INT32 *cand, ADDRESS cand__len);
static void Heap_MarkP (SYSTEM_PTR p);
-static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len);
+static void Heap_MarkStack (INT32 n, INT32 *cand, ADDRESS cand__len);
export SYSTEM_PTR Heap_NEWBLK (INT32 size);
export SYSTEM_PTR Heap_NEWREC (INT32 tag);
static INT32 Heap_NewChunk (INT32 blksz);
@@ -101,16 +104,18 @@ export SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs);
export void Heap_REGTYP (Heap_Module m, INT32 typ);
export void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize);
static void Heap_Scan (void);
-static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len);
+static void Heap_Sift (INT32 l, INT32 r, INT32 *a, ADDRESS a__len);
export void Heap_Unlock (void);
extern void *Heap__init();
-extern ADDRESS Platform_MainStackFrame;
+extern ADDRESS Modules_MainStackFrame;
extern ADDRESS Platform_OSAllocate(ADDRESS size);
#define Heap_HeapModuleInit() Heap__init()
#define Heap_ModulesHalt(code) Modules_Halt(code)
+#define Heap_ModulesMainStackFrame() Modules_MainStackFrame
#define Heap_OSAllocate(size) Platform_OSAllocate(size)
-#define Heap_PlatformMainStackFrame() Platform_MainStackFrame
+#define Heap_uLE(x, y) ((size_t)x <= (size_t)y)
+#define Heap_uLT(x, y) ((size_t)x < (size_t)y)
void Heap_Lock (void)
{
@@ -143,6 +148,35 @@ SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
return (void*)m;
}
+INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len)
+{
+ Heap_Module m, p;
+ __DUP(name, name__len, CHAR);
+ m = (Heap_Module)(ADDRESS)Heap_modules;
+ while ((m != NIL && __STRCMP(m->name, name) != 0)) {
+ p = m;
+ m = m->next;
+ }
+ if ((m != NIL && m->refcnt == 0)) {
+ if (m == (Heap_Module)(ADDRESS)Heap_modules) {
+ Heap_modules = (SYSTEM_PTR)m->next;
+ } else {
+ p->next = m->next;
+ }
+ __DEL(name);
+ return 0;
+ } else {
+ if (m == NIL) {
+ __DEL(name);
+ return -1;
+ } else {
+ __DEL(name);
+ return m->refcnt;
+ }
+ }
+ __RETCHK;
+}
+
void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd)
{
Heap_Cmd c;
@@ -170,16 +204,24 @@ void Heap_INCREF (Heap_Module m)
static INT32 Heap_NewChunk (INT32 blksz)
{
- INT32 chnk;
+ INT32 chnk, blk, end;
chnk = Heap_OSAllocate(blksz + 12);
if (chnk != 0) {
- __PUT(chnk + 4, chnk + (12 + blksz), INT32);
- __PUT(chnk + 12, chnk + 16, INT32);
- __PUT(chnk + 16, blksz, INT32);
- __PUT(chnk + 20, -4, INT32);
- __PUT(chnk + 24, Heap_bigBlocks, INT32);
- Heap_bigBlocks = chnk + 12;
+ blk = chnk + 12;
+ end = blk + blksz;
+ __PUT(chnk + 4, end, INT32);
+ __PUT(blk, blk + 4, INT32);
+ __PUT(blk + 4, blksz, INT32);
+ __PUT(blk + 8, -4, INT32);
+ __PUT(blk + 12, Heap_bigBlocks, INT32);
+ Heap_bigBlocks = blk;
Heap_heapsize += blksz;
+ if (Heap_uLT(blk + 4, Heap_heapMin)) {
+ Heap_heapMin = blk + 4;
+ }
+ if (Heap_uLT(Heap_heapMax, end)) {
+ Heap_heapMax = end;
+ }
}
return chnk;
}
@@ -187,29 +229,28 @@ static INT32 Heap_NewChunk (INT32 blksz)
static void Heap_ExtendHeap (INT32 blksz)
{
INT32 size, chnk, j, next;
- if (blksz > 160000) {
+ if (Heap_uLT(Heap_heapMinExpand, blksz)) {
size = blksz;
} else {
- size = 160000;
+ size = Heap_heapMinExpand;
}
chnk = Heap_NewChunk(size);
if (chnk != 0) {
- if (chnk < Heap_heap) {
+ if (Heap_uLT(chnk, Heap_heap)) {
__PUT(chnk, Heap_heap, INT32);
Heap_heap = chnk;
} else {
j = Heap_heap;
__GET(j, next, INT32);
- while ((next != 0 && chnk > next)) {
+ while ((next != 0 && Heap_uLT(next, chnk))) {
j = next;
__GET(j, next, INT32);
}
__PUT(chnk, next, INT32);
__PUT(j, chnk, INT32);
}
- if (next == 0) {
- __GET(chnk + 4, Heap_heapend, INT32);
- }
+ } else if (!Heap_firstTry) {
+ Heap_heapMinExpand = 16;
}
}
@@ -219,7 +260,7 @@ 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 (i < 9) {
adr = Heap_freeList[i];
@@ -251,16 +292,17 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
if (Heap_firstTry) {
Heap_GC(1);
blksz += 16;
- if (__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2) < Heap_heapsize) {
- Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize);
+ 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 {
@@ -269,7 +311,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
}
}
__GET(adr + 4, t, INT32);
- if (t >= blksz) {
+ if (Heap_uLE(blksz, t)) {
break;
}
prev = adr;
@@ -280,7 +322,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
__PUT(end + 4, blksz, INT32);
__PUT(end + 8, -4, INT32);
__PUT(end, end + 4, INT32);
- if (restsize > 144) {
+ if (Heap_uLT(144, restsize)) {
__PUT(adr + 4, restsize, INT32);
} else {
__GET(adr + 12, next, INT32);
@@ -289,7 +331,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
} else {
__PUT(prev + 12, next, INT32);
}
- if (restsize > 0) {
+ if (restsize != 0) {
di = __ASHR(restsize, 4);
__PUT(adr + 4, restsize, INT32);
__PUT(adr + 12, Heap_freeList[di], INT32);
@@ -300,7 +342,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
}
i = adr + 16;
end = adr + blksz;
- while (i < end) {
+ while (Heap_uLT(i, end)) {
__PUT(i, 0, INT32);
__PUT(i + 4, 0, INT32);
__PUT(i + 8, 0, INT32);
@@ -397,17 +439,17 @@ static void Heap_Scan (void)
while (chnk != 0) {
adr = chnk + 12;
__GET(chnk + 4, end, INT32);
- while (adr < end) {
+ while (Heap_uLT(adr, end)) {
__GET(adr, tag, INT32);
if (__ODD(tag)) {
- if (freesize > 0) {
+ if (freesize != 0) {
start = adr - freesize;
__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 (i < 9) {
+ if (Heap_uLT(i, 9)) {
__PUT(start + 12, Heap_freeList[i], INT32);
Heap_freeList[i] = start;
} else {
@@ -426,14 +468,14 @@ static void Heap_Scan (void)
adr += size;
}
}
- if (freesize > 0) {
+ if (freesize != 0) {
start = adr - freesize;
__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 (i < 9) {
+ if (Heap_uLT(i, 9)) {
__PUT(start + 12, Heap_freeList[i], INT32);
Heap_freeList[i] = start;
} else {
@@ -445,18 +487,19 @@ static void Heap_Scan (void)
}
}
-static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len)
+static void Heap_Sift (INT32 l, INT32 r, INT32 *a, ADDRESS a__len)
{
- INT32 i, j, x;
+ INT32 i, j;
+ INT32 x;
j = l;
x = a[j];
for (;;) {
i = j;
j = __ASHL(j, 1) + 1;
- if ((j < r && a[j] < a[j + 1])) {
+ if ((j < r && Heap_uLT(a[j], a[j + 1]))) {
j += 1;
}
- if (j > r || a[j] <= x) {
+ if (j > r || Heap_uLE(a[j], x)) {
break;
}
a[i] = a[j];
@@ -464,9 +507,10 @@ static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len)
a[i] = x;
}
-static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len)
+static void Heap_HeapSort (INT32 n, INT32 *a, ADDRESS a__len)
{
- INT32 l, r, x;
+ INT32 l, r;
+ INT32 x;
l = __ASHR(n, 1);
r = n - 1;
while (l > 0) {
@@ -482,37 +526,42 @@ static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len)
}
}
-static void Heap_MarkCandidates (INT32 n, INT32 *cand, LONGINT cand__len)
+static void Heap_MarkCandidates (INT32 n, INT32 *cand, ADDRESS cand__len)
{
- INT32 chnk, adr, tag, next, lim, lim1, i, ptr, size;
- chnk = Heap_heap;
+ INT32 chnk, end, adr, tag, next, i, ptr, size;
+ chnk = Heap_heap;
i = 0;
- lim = cand[n - 1];
- while ((chnk != 0 && chnk < lim)) {
+ while (chnk != 0) {
+ __GET(chnk + 4, end, INT32);
adr = chnk + 12;
- __GET(chnk + 4, lim1, INT32);
- if (lim < lim1) {
- lim1 = lim;
- }
- while (adr < lim1) {
+ while (Heap_uLT(adr, end)) {
__GET(adr, tag, INT32);
if (__ODD(tag)) {
__GET(tag - 1, size, INT32);
adr += size;
+ ptr = adr + 4;
+ while (Heap_uLT(cand[i], ptr)) {
+ i += 1;
+ if (i == n) {
+ return;
+ }
+ }
} else {
__GET(tag, size, INT32);
ptr = adr + 4;
- while (cand[i] < ptr) {
+ adr += size;
+ while (Heap_uLT(cand[i], ptr)) {
i += 1;
+ if (i == n) {
+ return;
+ }
}
- if (i == n) {
- return;
- }
- next = adr + size;
- if (cand[i] < next) {
+ if (Heap_uLT(cand[i], adr)) {
Heap_Mark(ptr);
}
- adr = next;
+ }
+ if (Heap_uLE(end, cand[i])) {
+ adr = end;
}
}
__GET(chnk, chnk, INT32);
@@ -571,10 +620,11 @@ void Heap_FINALL (void)
}
}
-static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len)
+static void Heap_MarkStack (INT32 n, INT32 *cand, ADDRESS cand__len)
{
SYSTEM_PTR frame;
- INT32 inc, nofcand, sp, p, stack0;
+ INT32 nofcand;
+ INT32 inc, sp, p, stack0;
struct Heap__1 align;
if (n > 0) {
Heap_MarkStack(n - 1, cand, cand__len);
@@ -585,14 +635,14 @@ static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len)
if (n == 0) {
nofcand = 0;
sp = (ADDRESS)&frame;
- stack0 = Heap_PlatformMainStackFrame();
+ stack0 = Heap_ModulesMainStackFrame();
inc = (ADDRESS)&align.p - (ADDRESS)&align;
- if (sp > stack0) {
+ if (Heap_uLT(stack0, sp)) {
inc = -inc;
}
while (sp != stack0) {
__GET(sp, p, INT32);
- if ((p > Heap_heap && p < Heap_heapend)) {
+ if ((Heap_uLE(Heap_heapMin, p) && Heap_uLT(p, Heap_heapMax))) {
if (nofcand == cand__len) {
Heap_HeapSort(nofcand, (void*)cand, cand__len);
Heap_MarkCandidates(nofcand, (void*)cand, cand__len);
@@ -615,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)
@@ -703,17 +751,21 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
void Heap_InitHeap (void)
{
- Heap_heap = Heap_NewChunk(128000);
- __GET(Heap_heap + 4, Heap_heapend, INT32);
- __PUT(Heap_heap, 0, INT32);
+ Heap_heap = 0;
+ Heap_heapsize = 0;
Heap_allocated = 0;
+ Heap_lockdepth = 0;
+ 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;
Heap_freeList[9] = 1;
- Heap_lockdepth = 0;
Heap_FileCount = 0;
Heap_modules = NIL;
- Heap_heapsize = 0;
- Heap_bigBlocks = 0;
Heap_fin = NIL;
Heap_interrupted = 0;
Heap_HeapModuleInit();
diff --git a/bootstrap/unix-44/Heap.h b/bootstrap/unix-44/Heap.h
index 0aa0a18b..3cde1c3b 100644
--- a/bootstrap/unix-44/Heap.h
+++ b/bootstrap/unix-44/Heap.h
@@ -1,16 +1,26 @@
-/* voc 1.95 [2016/11/24]. 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
#include "SYSTEM.h"
+typedef
+ struct Heap_CmdDesc *Heap_Cmd;
+
typedef
CHAR Heap_CmdName[24];
typedef
void (*Heap_Command)(void);
+typedef
+ struct Heap_CmdDesc {
+ Heap_Cmd next;
+ Heap_CmdName name;
+ Heap_Command cmd;
+ } Heap_CmdDesc;
+
typedef
void (*Heap_EnumProc)(void(*)(SYSTEM_PTR));
@@ -21,22 +31,31 @@ typedef
struct Heap_ModuleDesc *Heap_Module;
typedef
- struct Heap_ModuleDesc {
- INT32 _prvt0;
- char _prvt1[44];
- } Heap_ModuleDesc;
+ CHAR Heap_ModuleName[20];
typedef
- CHAR Heap_ModuleName[20];
+ struct Heap_ModuleDesc {
+ Heap_Module next;
+ Heap_ModuleName name;
+ INT32 refcnt;
+ Heap_Cmd cmds;
+ INT32 types;
+ Heap_EnumProc enumPtrs;
+ char _prvt0[8];
+ } Heap_ModuleDesc;
import SYSTEM_PTR Heap_modules;
-import INT32 Heap_allocated, Heap_heapsize;
+import INT32 Heap_allocated;
+import INT32 Heap_heap;
+import INT32 Heap_heapsize, Heap_heapMinExpand;
import INT16 Heap_FileCount;
import ADDRESS *Heap_ModuleDesc__typ;
+import ADDRESS *Heap_CmdDesc__typ;
import void Heap_FINALL (void);
+import INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len);
import void Heap_GC (BOOLEAN markStack);
import void Heap_INCREF (Heap_Module m);
import void Heap_InitHeap (void);
diff --git a/bootstrap/unix-44/Modules.c b/bootstrap/unix-44/Modules.c
index a5e72ba3..535721e8 100644
--- a/bootstrap/unix-44/Modules.c
+++ b/bootstrap/unix-44/Modules.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -9,81 +9,303 @@
#include "Heap.h"
#include "Platform.h"
-typedef
- struct Modules_CmdDesc *Modules_Cmd;
-
-typedef
- void (*Modules_Command)(void);
-
-typedef
- struct Modules_CmdDesc {
- Modules_Cmd next;
- CHAR name[24];
- Modules_Command cmd;
- } Modules_CmdDesc;
-
-typedef
- struct Modules_ModuleDesc *Modules_Module;
-
-typedef
- CHAR Modules_ModuleName[20];
-
-typedef
- struct Modules_ModuleDesc {
- Modules_Module next;
- Modules_ModuleName name;
- INT32 refcnt;
- Modules_Cmd cmds;
- INT32 types;
- void (*enumPtrs)(void(*)(INT32));
- INT32 reserved1, reserved2;
- } Modules_ModuleDesc;
-
export INT16 Modules_res;
export CHAR Modules_resMsg[256];
-export Modules_ModuleName Modules_imported, Modules_importing;
+export Heap_ModuleName Modules_imported, Modules_importing;
+export INT32 Modules_MainStackFrame;
+export INT16 Modules_ArgCount;
+export INT32 Modules_ArgVector;
+export CHAR Modules_BinaryDir[1024];
-export ADDRESS *Modules_ModuleDesc__typ;
-export ADDRESS *Modules_CmdDesc__typ;
-static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len);
+static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
+static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
+export INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len);
export void Modules_AssertFail (INT32 code);
+static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
+static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len);
static void Modules_DisplayHaltCode (INT32 code);
-export void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
+static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len);
+static void Modules_FindBinaryDir (CHAR *binarydir, ADDRESS binarydir__len);
+export void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all);
+export void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len);
+export void Modules_GetIntArg (INT16 n, INT32 *val);
export void Modules_Halt (INT32 code);
-export Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
-export Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
+export void Modules_Init (INT32 argc, INT32 argvadr);
+static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len);
+static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len);
+static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len);
+export Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len);
+export Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len);
+static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
static void Modules_errch (CHAR c);
static void Modules_errint (INT32 l);
-static void Modules_errstring (CHAR *s, LONGINT s__len);
+static void Modules_errstring (CHAR *s, ADDRESS s__len);
-#define Modules_modules() (Modules_Module)Heap_modules
-#define Modules_setmodules(m) Heap_modules = m
+extern void Heap_InitHeap();
+extern void *Modules__init(void);
+#define Modules_InitHeap() Heap_InitHeap()
+#define Modules_ModulesInit() Modules__init()
+#define Modules_modules() (Heap_Module)Heap_modules
-static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len)
+void Modules_Init (INT32 argc, INT32 argvadr)
{
- INT16 i, j;
- __DUP(b, b__len, CHAR);
+ Modules_MainStackFrame = argvadr;
+ Modules_ArgCount = __VAL(INT16, argc);
+ __GET(argvadr, Modules_ArgVector, INT32);
+ Modules_InitHeap();
+ Modules_ModulesInit();
+}
+
+typedef
+ CHAR (*argptr__15)[1024];
+
+void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len)
+{
+ argptr__15 arg = NIL;
+ if (n < Modules_ArgCount) {
+ __GET(Modules_ArgVector + __ASHL(n, 2), arg, argptr__15);
+ __COPY(*arg, val, val__len);
+ }
+}
+
+void Modules_GetIntArg (INT16 n, INT32 *val)
+{
+ CHAR s[64];
+ INT32 k, d, i;
+ s[0] = 0x00;
+ Modules_GetArg(n, (void*)s, 64);
i = 0;
- while (a[__X(i, a__len)] != 0x00) {
+ if (s[0] == '-') {
+ i = 1;
+ }
+ k = 0;
+ d = (INT16)s[__X(i, 64)] - 48;
+ while ((d >= 0 && d <= 9)) {
+ k = k * 10 + d;
+ i += 1;
+ d = (INT16)s[__X(i, 64)] - 48;
+ }
+ if (s[0] == '-') {
+ k = -k;
+ i -= 1;
+ }
+ if (i > 0) {
+ *val = k;
+ }
+}
+
+INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len)
+{
+ INT16 i;
+ CHAR arg[256];
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ Modules_GetArg(i, (void*)arg, 256);
+ while ((i < Modules_ArgCount && __STRCMP(s, arg) != 0)) {
+ i += 1;
+ Modules_GetArg(i, (void*)arg, 256);
+ }
+ __DEL(s);
+ return i;
+}
+
+static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len)
+{
+ INT16 i;
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
i += 1;
}
- j = 0;
- while (b[__X(j, b__len)] != 0x00) {
- a[__X(i, a__len)] = b[__X(j, b__len)];
+ __DEL(s);
+ return i;
+}
+
+static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
+{
+ INT16 i, j;
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ j = Modules_CharCount(d, d__len);
+ while (s[__X(i, s__len)] != 0x00) {
+ d[__X(j, d__len)] = s[__X(i, s__len)];
i += 1;
j += 1;
}
- a[__X(i, a__len)] = 0x00;
- __DEL(b);
+ d[__X(j, d__len)] = 0x00;
+ __DEL(s);
}
-Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
+static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{
- Modules_Module m = NIL;
+ INT16 i, j;
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ j = Modules_CharCount(d, d__len);
+ if ((j > 0 && d[__X(j - 1, d__len)] != c)) {
+ d[__X(j, d__len)] = c;
+ j += 1;
+ }
+ while (s[__X(i, s__len)] != 0x00) {
+ d[__X(j, d__len)] = s[__X(i, s__len)];
+ i += 1;
+ j += 1;
+ }
+ d[__X(j, d__len)] = 0x00;
+ __DEL(s);
+}
+
+static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len)
+{
+ INT16 i;
+ __DUP(s, s__len, CHAR);
+ if (c == 0x00) {
+ __DEL(s);
+ return 0;
+ }
+ i = 0;
+ while ((s[__X(i, s__len)] != c && s[__X(i, s__len)] != 0x00)) {
+ i += 1;
+ }
+ __DEL(s);
+ return s[__X(i, s__len)] == c;
+}
+
+static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len)
+{
+ __DUP(d, d__len, CHAR);
+ if (d[0] == 0x00) {
+ __DEL(d);
+ return 0;
+ }
+ if (Modules_IsOneOf(d[0], (CHAR*)"/\\", 3)) {
+ __DEL(d);
+ return 1;
+ }
+ if (d[__X(1, d__len)] == ':') {
+ __DEL(d);
+ return 1;
+ }
+ __DEL(d);
+ return 0;
+}
+
+static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
+{
+ __DUP(s, s__len, CHAR);
+ if (Modules_IsAbsolute(s, s__len)) {
+ __COPY(s, d, d__len);
+ } else {
+ __COPY(Platform_CWD, d, d__len);
+ Modules_AppendPart('/', s, s__len, (void*)d, d__len);
+ }
+ __DEL(s);
+}
+
+static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len)
+{
+ Platform_FileIdentity identity;
+ __DUP(s, s__len, CHAR);
+ __DEL(s);
+ return Platform_IdentifyByName(s, s__len, &identity, Platform_FileIdentity__typ) == 0;
+}
+
+static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len)
+{
+ INT16 j;
+ __DUP(s, s__len, CHAR);
+ __DUP(p, p__len, CHAR);
+ j = 0;
+ while ((s[__X(*i, s__len)] != 0x00 && !Modules_IsOneOf(s[__X(*i, s__len)], p, p__len))) {
+ d[__X(j, d__len)] = s[__X(*i, s__len)];
+ *i += 1;
+ j += 1;
+ }
+ d[__X(j, d__len)] = 0x00;
+ while (Modules_IsOneOf(s[__X(*i, s__len)], p, p__len)) {
+ *i += 1;
+ }
+ __DEL(s);
+ __DEL(p);
+}
+
+static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
+{
+ INT16 i, j;
+ CHAR part[1024];
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ j = 0;
+ while ((i < 2 && Modules_IsOneOf(s[__X(i, s__len)], (CHAR*)"/\\", 3))) {
+ i += 1;
+ d[__X(j, d__len)] = '/';
+ j += 1;
+ }
+ d[__X(j, d__len)] = 0x00;
+ while (s[__X(i, s__len)] != 0x00) {
+ Modules_ExtractPart(s, s__len, &i, (CHAR*)"/\\", 3, (void*)part, 1024);
+ if ((part[0] != 0x00 && __STRCMP(part, ".") != 0)) {
+ Modules_AppendPart('/', part, 1024, (void*)d, d__len);
+ }
+ }
+ __DEL(s);
+}
+
+typedef
+ CHAR pathstring__12[4096];
+
+static void Modules_FindBinaryDir (CHAR *binarydir, ADDRESS binarydir__len)
+{
+ pathstring__12 arg0, pathlist, pathdir, tempstr;
+ INT16 i, j, k;
+ BOOLEAN present;
+ if (Modules_ArgCount < 1) {
+ binarydir[0] = 0x00;
+ return;
+ }
+ Modules_GetArg(0, (void*)arg0, 4096);
+ i = 0;
+ while ((((arg0[__X(i, 4096)] != 0x00 && arg0[__X(i, 4096)] != '/')) && arg0[__X(i, 4096)] != '\\')) {
+ i += 1;
+ }
+ if (arg0[__X(i, 4096)] == '/' || arg0[__X(i, 4096)] == '\\') {
+ Modules_Trim(arg0, 4096, (void*)tempstr, 4096);
+ Modules_Canonify(tempstr, 4096, (void*)binarydir, binarydir__len);
+ present = Modules_IsFilePresent(binarydir, binarydir__len);
+ } else {
+ Platform_GetEnv((CHAR*)"PATH", 5, (void*)pathlist, 4096);
+ i = 0;
+ present = 0;
+ while ((!present && pathlist[__X(i, 4096)] != 0x00)) {
+ Modules_ExtractPart(pathlist, 4096, &i, (CHAR*)":;", 3, (void*)pathdir, 4096);
+ Modules_AppendPart('/', arg0, 4096, (void*)pathdir, 4096);
+ Modules_Trim(pathdir, 4096, (void*)tempstr, 4096);
+ Modules_Canonify(tempstr, 4096, (void*)binarydir, binarydir__len);
+ present = Modules_IsFilePresent(binarydir, binarydir__len);
+ }
+ }
+ if (present) {
+ k = Modules_CharCount(binarydir, binarydir__len);
+ while ((k > 0 && !Modules_IsOneOf(binarydir[__X(k - 1, binarydir__len)], (CHAR*)"/\\", 3))) {
+ k -= 1;
+ }
+ if (k == 0) {
+ binarydir[__X(k, binarydir__len)] = 0x00;
+ } else {
+ binarydir[__X(k - 1, binarydir__len)] = 0x00;
+ }
+ } else {
+ binarydir[0] = 0x00;
+ }
+}
+
+Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len)
+{
+ Heap_Module m = NIL;
CHAR bodyname[64];
- Modules_Command body;
+ Heap_Command body;
__DUP(name, name__len, CHAR);
m = Modules_modules();
while ((m != NIL && __STRCMP(m->name, name) != 0)) {
@@ -96,16 +318,16 @@ Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
Modules_res = 1;
__COPY(name, Modules_importing, 20);
__MOVE(" module \"", Modules_resMsg, 10);
- Modules_Append((void*)Modules_resMsg, 256, name, name__len);
- Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
+ Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
+ Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
}
__DEL(name);
return m;
}
-Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len)
+Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len)
{
- Modules_Cmd c = NIL;
+ Heap_Cmd c = NIL;
__DUP(name, name__len, CHAR);
c = mod->cmds;
while ((c != NIL && __STRCMP(c->name, name) != 0)) {
@@ -120,43 +342,36 @@ Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT nam
Modules_res = 2;
__MOVE(" command \"", Modules_resMsg, 11);
__COPY(name, Modules_importing, 20);
- Modules_Append((void*)Modules_resMsg, 256, mod->name, 20);
- Modules_Append((void*)Modules_resMsg, 256, (CHAR*)".", 2);
- Modules_Append((void*)Modules_resMsg, 256, name, name__len);
- Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
+ Modules_Append(mod->name, 20, (void*)Modules_resMsg, 256);
+ Modules_Append((CHAR*)".", 2, (void*)Modules_resMsg, 256);
+ Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
+ Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
__DEL(name);
return NIL;
}
__RETCHK;
}
-void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all)
+void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all)
{
- Modules_Module m = NIL, p = NIL;
+ Heap_Module m = NIL, p = NIL;
+ INT32 refcount;
__DUP(name, name__len, CHAR);
m = Modules_modules();
if (all) {
Modules_res = 1;
__MOVE("unloading \"all\" not yet supported", Modules_resMsg, 34);
} else {
- while ((m != NIL && __STRCMP(m->name, name) != 0)) {
- p = m;
- m = m->next;
- }
- if ((m != NIL && m->refcnt == 0)) {
- if (m == Modules_modules()) {
- Modules_setmodules(m->next);
- } else {
- p->next = m->next;
- }
+ refcount = Heap_FreeModule(name, name__len);
+ if (refcount == 0) {
Modules_res = 0;
} else {
- Modules_res = 1;
- if (m == NIL) {
+ if (refcount < 0) {
__MOVE("module not found", Modules_resMsg, 17);
} else {
__MOVE("clients of this module exist", Modules_resMsg, 29);
}
+ Modules_res = 1;
}
}
__DEL(name);
@@ -168,7 +383,7 @@ static void Modules_errch (CHAR c)
e = Platform_Write(1, (ADDRESS)&c, 1);
}
-static void Modules_errstring (CHAR *s, LONGINT s__len)
+static void Modules_errstring (CHAR *s, ADDRESS s__len)
{
INT32 i;
__DUP(s, s__len, CHAR);
@@ -189,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)
@@ -250,6 +465,7 @@ static void Modules_DisplayHaltCode (INT32 code)
void Modules_Halt (INT32 code)
{
+ Heap_FINALL();
Modules_errstring((CHAR*)"Terminated by Halt(", 20);
Modules_errint(code);
Modules_errstring((CHAR*)"). ", 4);
@@ -262,6 +478,7 @@ void Modules_Halt (INT32 code)
void Modules_AssertFail (INT32 code)
{
+ Heap_FINALL();
Modules_errstring((CHAR*)"Assertion failure.", 19);
if (code != 0) {
Modules_errstring((CHAR*)" ASSERT code ", 14);
@@ -269,11 +486,13 @@ void Modules_AssertFail (INT32 code)
Modules_errstring((CHAR*)".", 2);
}
Modules_errstring(Platform_NL, 3);
- Platform_Exit(code);
+ if (code > 0) {
+ Platform_Exit(code);
+ } else {
+ Platform_Exit(-1);
+ }
}
-__TDESC(Modules_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 48), {0, 28, -12}};
-__TDESC(Modules_CmdDesc, 1, 1) = {__TDFLDS("CmdDesc", 32), {0, -8}};
export void *Modules__init(void)
{
@@ -281,8 +500,7 @@ export void *Modules__init(void)
__MODULE_IMPORT(Heap);
__MODULE_IMPORT(Platform);
__REGMOD("Modules", 0);
- __INITYP(Modules_ModuleDesc, Modules_ModuleDesc, 0);
- __INITYP(Modules_CmdDesc, Modules_CmdDesc, 0);
/* BEGIN */
+ Modules_FindBinaryDir((void*)Modules_BinaryDir, 1024);
__ENDMOD;
}
diff --git a/bootstrap/unix-44/Modules.h b/bootstrap/unix-44/Modules.h
index 8bb89fe5..26d86b38 100644
--- a/bootstrap/unix-44/Modules.h
+++ b/bootstrap/unix-44/Modules.h
@@ -1,53 +1,30 @@
-/* voc 1.95 [2016/11/24]. 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
#include "SYSTEM.h"
-
-typedef
- struct Modules_CmdDesc *Modules_Cmd;
-
-typedef
- void (*Modules_Command)(void);
-
-typedef
- struct Modules_CmdDesc {
- Modules_Cmd next;
- CHAR name[24];
- Modules_Command cmd;
- } Modules_CmdDesc;
-
-typedef
- struct Modules_ModuleDesc *Modules_Module;
-
-typedef
- CHAR Modules_ModuleName[20];
-
-typedef
- struct Modules_ModuleDesc {
- Modules_Module next;
- Modules_ModuleName name;
- INT32 refcnt;
- Modules_Cmd cmds;
- INT32 types;
- void (*enumPtrs)(void(*)(INT32));
- char _prvt0[8];
- } Modules_ModuleDesc;
+#include "Heap.h"
import INT16 Modules_res;
import CHAR Modules_resMsg[256];
-import Modules_ModuleName Modules_imported, Modules_importing;
+import Heap_ModuleName Modules_imported, Modules_importing;
+import INT32 Modules_MainStackFrame;
+import INT16 Modules_ArgCount;
+import INT32 Modules_ArgVector;
+import CHAR Modules_BinaryDir[1024];
-import ADDRESS *Modules_ModuleDesc__typ;
-import ADDRESS *Modules_CmdDesc__typ;
+import INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len);
import void Modules_AssertFail (INT32 code);
-import void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
+import void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all);
+import void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len);
+import void Modules_GetIntArg (INT16 n, INT32 *val);
import void Modules_Halt (INT32 code);
-import Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
-import Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
+import void Modules_Init (INT32 argc, INT32 argvadr);
+import Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len);
+import Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len);
import void *Modules__init(void);
diff --git a/bootstrap/unix-44/OPB.c b/bootstrap/unix-44/OPB.c
index 3ef8e2f9..913fbf2d 100644
--- a/bootstrap/unix-44/OPB.c
+++ b/bootstrap/unix-44/OPB.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -253,7 +253,7 @@ OPT_Node OPB_NewString (OPS_String str, INT64 len)
x->conval->intval = -1;
x->conval->intval2 = OPM_Longint(len);
x->conval->ext = OPT_NewExt();
- __COPY(str, *x->conval->ext, 256);
+ __MOVE(str, *x->conval->ext, 256);
return x;
}
@@ -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;
@@ -550,7 +550,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
if (__IN(f, 0xf0, 32)) {
if (z->class == 7) {
if (f == 4) {
- if (z->conval->intval == (-9223372036854775807-1)) {
+ if (z->conval->intval == (-9223372036854775807LL-1)) {
OPB_err(203);
} else {
z->conval->intval = -z->conval->intval;
@@ -577,7 +577,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
if (__IN(f, 0x70, 32)) {
if (z->class == 7) {
if (f == 4) {
- if (z->conval->intval == (-9223372036854775807-1)) {
+ if (z->conval->intval == (-9223372036854775807LL-1)) {
OPB_err(203);
} else {
z->conval->intval = __ABS(z->conval->intval);
@@ -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);
@@ -920,7 +920,7 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
if (f == 4) {
xv = xval->intval;
yv = yval->intval;
- if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807-1))) && yv != (-9223372036854775807-1))) && -xv <= __DIV(9223372036854775807, -yv))) {
+ if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807LL, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807LL-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807LL-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807LL-1))) && yv != (-9223372036854775807LL-1))) && -xv <= __DIV(9223372036854775807LL, -yv))) {
xval->intval = xv * yv;
OPB_SetIntType(x);
} else {
@@ -999,8 +999,8 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
break;
case 6:
if (f == 4) {
- temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807 - yval->intval);
- if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807-1) - yval->intval)) {
+ temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807LL - yval->intval);
+ if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807LL-1) - yval->intval)) {
xval->intval += yval->intval;
OPB_SetIntType(x);
} else {
@@ -1023,7 +1023,7 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
break;
case 7:
if (f == 4) {
- if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807 + yval->intval)) {
+ if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807LL-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807LL + yval->intval)) {
xval->intval -= yval->intval;
OPB_SetIntType(x);
} else {
@@ -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);
}
}
@@ -1624,23 +1624,20 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
g = 8;
}
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) {
OPB_err(114);
}
- } else if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
} else {
OPB_err(113);
}
} else {
OPB_err(113);
}
- } else if ((x->comp == 3 && x->BaseTyp == OPT_chartyp)) {
- if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
- } else {
- OPB_err(113);
- }
} else if (x->comp == 4) {
if (x == y) {
} else if (y->comp == 4) {
@@ -2091,7 +2088,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
OPB_err(208);
p->conval->intval = 1;
} else if (x->conval->intval >= 0) {
- if (__ABS(p->conval->intval) <= __DIV(9223372036854775807, (INT64)__ASH(1, x->conval->intval))) {
+ if (__ABS(p->conval->intval) <= __DIV(9223372036854775807LL, (INT64)__ASH(1, x->conval->intval))) {
p->conval->intval = p->conval->intval * (INT64)__ASH(1, x->conval->intval);
} else {
OPB_err(208);
@@ -2536,7 +2533,6 @@ void OPB_Return (OPT_Node *x, OPT_Object proc)
void OPB_Assign (OPT_Node *x, OPT_Node y)
{
OPT_Node z = NIL;
- INT8 subcl;
if ((*x)->class >= 7) {
OPB_err(56);
}
@@ -2562,13 +2558,8 @@ void OPB_Assign (OPT_Node *x, OPT_Node y)
y->conval->intval = 0;
OPB_Index(&*x, OPB_NewIntConst(0));
}
- if ((((((__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp == OPT_chartyp)) && __IN(y->typ->comp, 0x0c, 32))) && y->typ->BaseTyp == OPT_chartyp)) {
- subcl = 18;
- } else {
- subcl = 0;
- }
OPB_BindNodes(19, OPT_notyp, &*x, y);
- (*x)->subcl = subcl;
+ (*x)->subcl = 0;
}
void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ)
@@ -2595,7 +2586,7 @@ export void *OPB__init(void)
__MODULE_IMPORT(OPT);
__REGMOD("OPB", 0);
/* BEGIN */
- OPB_maxExp = OPB_log(4611686018427387904);
+ OPB_maxExp = OPB_log(4611686018427387904LL);
OPB_maxExp = OPB_exp;
__ENDMOD;
}
diff --git a/bootstrap/unix-44/OPB.h b/bootstrap/unix-44/OPB.h
index 0be714e8..f66fcd66 100644
--- a/bootstrap/unix-44/OPB.h
+++ b/bootstrap/unix-44/OPB.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 ef4b429f..7b92ccc1 100644
--- a/bootstrap/unix-44/OPC.c
+++ b/bootstrap/unix-44/OPC.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -56,7 +56,7 @@ static void OPC_GenHeaderMsg (void);
export void OPC_Halt (INT32 n);
export void OPC_Ident (OPT_Object obj);
static void OPC_IdentList (OPT_Object obj, INT16 vis);
-static void OPC_Include (CHAR *name, LONGINT name__len);
+static void OPC_Include (CHAR *name, ADDRESS name__len);
static void OPC_IncludeImports (OPT_Object obj, INT16 vis);
export void OPC_Increment (BOOLEAN decrement);
export void OPC_Indent (INT16 count);
@@ -68,11 +68,11 @@ static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj);
export void OPC_IntLiteral (INT64 n, INT32 size);
export void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim);
static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName);
-static INT16 OPC_Length (CHAR *s, LONGINT s__len);
+static INT16 OPC_Length (CHAR *s, ADDRESS s__len);
export BOOLEAN OPC_NeedsRetval (OPT_Object proc);
export INT32 OPC_NofPtrs (OPT_Struct typ);
-static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len);
-static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len);
+static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len);
+static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len);
static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define);
static void OPC_ProcPredefs (OPT_Object obj, INT8 vis);
static void OPC_PutBase (OPT_Struct typ);
@@ -80,8 +80,8 @@ static void OPC_PutPtrOffsets (OPT_Struct typ, INT32 adr, INT32 *cnt);
static void OPC_RegCmds (OPT_Object obj);
export void OPC_SetInclude (BOOLEAN exclude);
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
-static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x);
-static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l);
+static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x);
+static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l);
export void OPC_TDescDecl (OPT_Struct typ);
export void OPC_TypeDefs (OPT_Object obj, INT16 vis);
export void OPC_TypeOf (OPT_Object ap);
@@ -137,7 +137,7 @@ void OPC_EndBlk0 (void)
OPM_Write('}');
}
-static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
+static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x)
{
CHAR ch;
INT16 i;
@@ -156,7 +156,7 @@ static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
__DEL(s);
}
-static INT16 OPC_Length (CHAR *s, LONGINT s__len)
+static INT16 OPC_Length (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@@ -166,7 +166,7 @@ static INT16 OPC_Length (CHAR *s, LONGINT s__len)
return i;
}
-static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len)
+static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len)
{
INT16 i, h;
i = 0;
@@ -364,7 +364,7 @@ static void OPC_DeclareBase (OPT_Object dcl)
OPM_WriteString((CHAR*)"struct ", 8);
OPC_BegBlk();
OPC_BegStat();
- OPC_Str1((CHAR*)"LONGINT len[#]", 15, nofdims);
+ OPC_Str1((CHAR*)"ADDRESS len[#]", 15, nofdims);
OPC_EndStat();
OPC_BegStat();
__NEW(obj, OPT_ObjDesc);
@@ -511,7 +511,7 @@ static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamNa
typ = par->typ->BaseTyp;
while (typ->comp == 3) {
if (ansiDefine) {
- OPM_WriteString((CHAR*)", LONGINT ", 11);
+ OPM_WriteString((CHAR*)", ADDRESS ", 11);
} else {
OPM_WriteString((CHAR*)", ", 3);
}
@@ -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,12 +721,19 @@ 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();
+ }
}
}
}
}
-static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len)
+static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len)
{
INT16 i;
__DUP(y, y__len, CHAR);
@@ -968,8 +981,8 @@ static void OPC_IdentList (OPT_Object obj, INT16 vis)
if (obj->typ->comp == 3) {
OPC_EndStat();
OPC_BegStat();
- base = OPT_linttyp;
- OPM_WriteString((CHAR*)"LONGINT ", 9);
+ base = OPT_adrtyp;
+ OPM_WriteString((CHAR*)"ADDRESS ", 9);
OPC_LenList(obj, 0, 1);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPC_EndStat();
@@ -1008,7 +1021,7 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
__COPY(name, obj->name, 256);
}
if (obj->typ->comp == 3) {
- OPM_WriteString((CHAR*)", LONGINT ", 11);
+ OPM_WriteString((CHAR*)", ADDRESS ", 11);
OPC_LenList(obj, 1, showParamNames);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPM_WriteString((CHAR*)", ADDRESS *", 12);
@@ -1062,7 +1075,7 @@ static void OPC_ProcPredefs (OPT_Object obj, INT8 vis)
}
}
-static void OPC_Include (CHAR *name, LONGINT name__len)
+static void OPC_Include (CHAR *name, ADDRESS name__len)
{
__DUP(name, name__len, CHAR);
OPM_WriteString((CHAR*)"#include ", 10);
@@ -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) {
@@ -1659,9 +1672,9 @@ void OPC_CompleteIdent (OPT_Object obj)
OPC_Ident(obj);
OPM_WriteString((CHAR*)"__", 3);
} else {
- OPM_WriteString((CHAR*)"((", 3);
+ OPM_WriteString((CHAR*)"(*(", 4);
OPC_Ident(obj->typ->strobj);
- OPM_Write(')');
+ OPM_WriteString((CHAR*)"*)&", 4);
OPC_Ident(obj);
OPM_Write(')');
}
@@ -1739,12 +1752,12 @@ 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('\'');
}
}
-static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l)
+static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
{
INT32 i;
INT16 c;
@@ -1755,16 +1768,16 @@ static void OPC_StringLiteral (CHAR *s, LONGINT 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);
}
}
@@ -1912,9 +1927,9 @@ static struct InitKeywords__46 {
struct InitKeywords__46 *lnk;
} *InitKeywords__46_s;
-static void Enter__47 (CHAR *s, LONGINT s__len);
+static void Enter__47 (CHAR *s, ADDRESS s__len);
-static void Enter__47 (CHAR *s, LONGINT s__len)
+static void Enter__47 (CHAR *s, ADDRESS s__len)
{
INT16 h;
__DUP(s, s__len, CHAR);
diff --git a/bootstrap/unix-44/OPC.h b/bootstrap/unix-44/OPC.h
index 842e7dec..3bfd88b8 100644
--- a/bootstrap/unix-44/OPC.h
+++ b/bootstrap/unix-44/OPC.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 e76d763e..bcb39247 100644
--- a/bootstrap/unix-44/OPM.c
+++ b/bootstrap/unix-44/OPM.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,6 +8,7 @@
#include "SYSTEM.h"
#include "Configuration.h"
#include "Files.h"
+#include "Modules.h"
#include "Out.h"
#include "Platform.h"
#include "Strings.h"
@@ -18,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];
@@ -26,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;
@@ -41,41 +44,48 @@ static Files_Rider OPM_oldSF, OPM_newSF;
static Files_Rider OPM_R[3];
static Files_File OPM_oldSFile, OPM_newSFile, OPM_HFile, OPM_BFile, OPM_HIFile;
static INT16 OPM_S;
+export CHAR OPM_InstallDir[1024];
export CHAR OPM_ResourceDir[1024];
static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F);
export void OPM_CloseFiles (void);
export void OPM_CloseOldSym (void);
-export void OPM_DeleteNewSym (void);
+export void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
+export void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
export void OPM_FPrint (INT32 *fp, INT64 val);
export void OPM_FPrintLReal (INT32 *fp, LONGREAL val);
export void OPM_FPrintReal (INT32 *fp, REAL val);
export void OPM_FPrintSet (INT32 *fp, UINT64 val);
+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, LONGINT bytes__len);
+static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len);
export void OPM_Get (CHAR *ch);
-export void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
+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);
+static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len);
+export void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len);
static void OPM_LogErrMsg (INT16 n);
-export void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
+export void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len);
export void OPM_LogW (CHAR ch);
export void OPM_LogWLn (void);
export void OPM_LogWNum (INT64 i, INT64 len);
-export void OPM_LogWStr (CHAR *s, LONGINT s__len);
+export void OPM_LogWStr (CHAR *s, ADDRESS s__len);
export INT32 OPM_Longint (INT64 n);
-static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len);
+static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len);
export void OPM_Mark (INT16 n, INT32 pos);
-export void OPM_NewSym (CHAR *modName, LONGINT modName__len);
-export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
-export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
+export void OPM_NewSym (CHAR *modName, ADDRESS modName__len);
+export void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done);
+export void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len);
export BOOLEAN OPM_OpenPar (void);
export void OPM_RegisterNewSym (void);
-static void OPM_ScanOptions (CHAR *s, LONGINT s__len);
+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);
@@ -87,14 +97,13 @@ export void OPM_SymWInt (INT64 i);
export void OPM_SymWLReal (LONGREAL lr);
export void OPM_SymWReal (REAL r);
export void OPM_SymWSet (UINT64 s);
-static void OPM_VerboseListSizes (void);
export void OPM_Write (CHAR ch);
export void OPM_WriteHex (INT64 i);
export void OPM_WriteInt (INT64 i);
export void OPM_WriteLn (void);
export void OPM_WriteReal (LONGREAL r, CHAR suffx);
-export void OPM_WriteString (CHAR *s, LONGINT s__len);
-export void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
+export void OPM_WriteString (CHAR *s, ADDRESS s__len);
+export void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
export BOOLEAN OPM_eofSF (void);
export void OPM_err (INT16 n);
@@ -105,7 +114,7 @@ void OPM_LogW (CHAR ch)
Out_Char(ch);
}
-void OPM_LogWStr (CHAR *s, LONGINT s__len)
+void OPM_LogWStr (CHAR *s, ADDRESS s__len)
{
__DUP(s, s__len, CHAR);
Out_String(s, s__len);
@@ -122,7 +131,7 @@ void OPM_LogWLn (void)
Out_Ln();
}
-void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
+void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len)
{
__DUP(vt100code, vt100code__len, CHAR);
if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) {
@@ -131,6 +140,57 @@ void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
__DEL(vt100code);
}
+void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len)
+{
+ __DUP(modname, modname__len, CHAR);
+ OPM_LogWStr((CHAR*)"Compiling ", 11);
+ OPM_LogWStr(modname, modname__len);
+ if (__IN(18, OPM_Options, 32)) {
+ OPM_LogWStr((CHAR*)", s:", 5);
+ OPM_LogWNum(__ASHL(OPM_ShortintSize, 3), 1);
+ OPM_LogWStr((CHAR*)" i:", 4);
+ OPM_LogWNum(__ASHL(OPM_IntegerSize, 3), 1);
+ OPM_LogWStr((CHAR*)" l:", 4);
+ OPM_LogWNum(__ASHL(OPM_LongintSize, 3), 1);
+ OPM_LogWStr((CHAR*)" adr:", 6);
+ OPM_LogWNum(__ASHL(OPM_AddressSize, 3), 1);
+ OPM_LogWStr((CHAR*)" algn:", 7);
+ OPM_LogWNum(__ASHL(OPM_Alignment, 3), 1);
+ }
+ OPM_LogW('.');
+ __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;
@@ -154,7 +214,7 @@ INT16 OPM_Integer (INT64 n)
return __VAL(INT16, n);
}
-static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
+static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
@@ -227,29 +287,6 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
i += 2;
}
break;
- case 'B':
- if (s[__X(i + 1, s__len)] != 0x00) {
- i += 1;
- OPM_IntegerSize = (INT16)s[__X(i, s__len)] - 48;
- }
- if (s[__X(i + 1, s__len)] != 0x00) {
- i += 1;
- OPM_AddressSize = (INT16)s[__X(i, s__len)] - 48;
- }
- if (s[__X(i + 1, s__len)] != 0x00) {
- i += 1;
- OPM_Alignment = (INT16)s[__X(i, s__len)] - 48;
- }
- __ASSERT(OPM_IntegerSize == 2 || OPM_IntegerSize == 4, 0);
- __ASSERT(OPM_AddressSize == 4 || OPM_AddressSize == 8, 0);
- __ASSERT(OPM_Alignment == 4 || OPM_Alignment == 8, 0);
- if (OPM_IntegerSize == 2) {
- OPM_LongintSize = 4;
- } else {
- OPM_LongintSize = 8;
- }
- Files_SetSearchPath((CHAR*)"", 1);
- break;
default:
OPM_LogWStr((CHAR*)" warning: option ", 19);
OPM_LogW('-');
@@ -266,16 +303,19 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
BOOLEAN OPM_OpenPar (void)
{
CHAR s[256];
- if (Platform_ArgCount == 1) {
+ 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);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Further development by Norayr Chilingarian, David Brown and others.", 68);
OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Loaded from ", 13);
+ OPM_LogWStr(Modules_BinaryDir, 1024);
+ OPM_LogWLn();
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Usage:", 7);
OPM_LogWLn();
@@ -332,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();
@@ -362,64 +402,38 @@ BOOLEAN OPM_OpenPar (void)
OPM_Options = 0xa9;
OPM_S = 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
}
OPM_GlobalAddressSize = OPM_AddressSize;
OPM_GlobalAlignment = OPM_Alignment;
- __COPY(OPM_Model, OPM_GlobalModel, 10);
+ __MOVE(OPM_Model, OPM_GlobalModel, 10);
OPM_GlobalOptions = OPM_Options;
return 1;
}
__RETCHK;
}
-static void OPM_VerboseListSizes (void)
-{
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Type Size", 15);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"SHORTINT ", 12);
- OPM_LogWNum(OPM_ShortintSize, 4);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"INTEGER ", 12);
- OPM_LogWNum(OPM_IntegerSize, 4);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"LONGINT ", 12);
- OPM_LogWNum(OPM_LongintSize, 4);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"SET ", 12);
- OPM_LogWNum(OPM_LongintSize, 4);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"ADDRESS ", 12);
- OPM_LogWNum(OPM_AddressSize, 4);
- OPM_LogWLn();
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Alignment: ", 12);
- OPM_LogWNum(OPM_Alignment, 4);
- OPM_LogWLn();
-}
-
void OPM_InitOptions (void)
{
CHAR s[256];
CHAR searchpath[1024], modules[1024];
CHAR MODULES[1024];
OPM_Options = OPM_GlobalOptions;
- __COPY(OPM_GlobalModel, OPM_Model, 10);
+ __MOVE(OPM_GlobalModel, OPM_Model, 10);
OPM_Alignment = OPM_GlobalAlignment;
OPM_AddressSize = OPM_GlobalAddressSize;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
}
if (__IN(15, OPM_Options, 32)) {
OPM_Options |= __SETOF(10,32);
@@ -430,29 +444,32 @@ 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;
}
- if (__IN(18, OPM_Options, 32)) {
- OPM_VerboseListSizes();
+ __MOVE(OPM_InstallDir, OPM_ResourceDir, 1024);
+ if (OPM_ResourceDir[0] != 0x00) {
+ Strings_Append((CHAR*)"/", 2, (void*)OPM_ResourceDir, 1024);
+ Strings_Append(OPM_Model, 10, (void*)OPM_ResourceDir, 1024);
}
- OPM_ResourceDir[0] = 0x00;
- Strings_Append((CHAR*)"/", 2, (void*)OPM_ResourceDir, 1024);
- Strings_Append(OPM_Model, 10, (void*)OPM_ResourceDir, 1024);
modules[0] = 0x00;
Platform_GetEnv((CHAR*)"MODULES", 8, (void*)modules, 1024);
__MOVE(".", searchpath, 2);
@@ -465,23 +482,22 @@ void OPM_InitOptions (void)
Files_SetSearchPath(searchpath, 1024);
}
-void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
+void OPM_Init (BOOLEAN *done)
{
Texts_Text T = NIL;
INT32 beg, end, time;
CHAR s[256];
*done = 0;
OPM_curpos = 0;
- if (OPM_S >= Platform_ArgCount) {
+ if (OPM_S >= Modules_ArgCount) {
return;
}
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
__NEW(T, Texts_TextDesc);
Texts_Open(T, s, 256);
OPM_LogWStr(s, 256);
OPM_LogWStr((CHAR*)" ", 3);
- __COPY(s, mname, mname__len);
__COPY(s, OPM_SourceFileName, 256);
if (T->len == 0) {
OPM_LogWStr(s, 256);
@@ -503,18 +519,14 @@ void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
void OPM_Get (CHAR *ch)
{
+ OPM_curpos = Texts_Pos(&OPM_inR, Texts_Reader__typ);
Texts_Read(&OPM_inR, Texts_Reader__typ, &*ch);
- if (*ch == 0x0d) {
- OPM_curpos = Texts_Pos(&OPM_inR, Texts_Reader__typ);
- } else {
- OPM_curpos += 1;
- }
if ((*ch < 0x09 && !OPM_inR.eot)) {
*ch = ' ';
}
}
-static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len)
+static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len)
{
INT16 i, j;
CHAR ch;
@@ -632,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;
@@ -640,7 +652,6 @@ static void OPM_ShowLine (INT64 pos)
OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogW('^');
OPM_LogVT100((CHAR*)"0m", 3);
- Files_Close(f);
}
void OPM_Mark (INT16 n, INT32 pos)
@@ -700,7 +711,7 @@ void OPM_err (INT16 n)
OPM_Mark(n, OPM_errpos);
}
-static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len)
+static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len)
{
INT16 i;
INT32 l;
@@ -772,10 +783,13 @@ void OPM_CloseOldSym (void)
Files_Close(Files_Base(&OPM_oldSF, Files_Rider__typ));
}
-void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done)
+void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done)
{
CHAR tag, ver;
OPM_FileName fileName;
+ INT16 res;
+ OPM_oldSFile = NIL;
+ *done = 0;
OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
OPM_oldSFile = Files_Old(fileName, 32);
*done = OPM_oldSFile != NIL;
@@ -783,8 +797,10 @@ void OPM_OldSym (CHAR *modName, LONGINT 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 != 0x82) {
- OPM_err(-306);
+ if (tag != 0xf7 || ver != 0x84) {
+ if (!__IN(4, OPM_Options, 32)) {
+ OPM_err(-306);
+ }
OPM_CloseOldSym();
*done = 0;
}
@@ -828,11 +844,23 @@ void OPM_RegisterNewSym (void)
}
}
-void OPM_DeleteNewSym (void)
+void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len)
{
+ OPM_FileName fn;
+ INT16 res;
+ OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".sym", 5);
+ Files_Delete(fn, 32, &res);
}
-void OPM_NewSym (CHAR *modName, LONGINT modName__len)
+void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len)
+{
+ OPM_FileName fn;
+ INT16 res;
+ OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".o", 3);
+ Files_Delete(fn, 32, &res);
+}
+
+void OPM_NewSym (CHAR *modName, ADDRESS modName__len)
{
OPM_FileName fileName;
OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
@@ -840,7 +868,7 @@ void OPM_NewSym (CHAR *modName, LONGINT 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, 0x82);
+ Files_Write(&OPM_newSF, Files_Rider__typ, 0x84);
} else {
OPM_err(153);
}
@@ -851,7 +879,7 @@ void OPM_Write (CHAR ch)
Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, ch);
}
-void OPM_WriteString (CHAR *s, LONGINT s__len)
+void OPM_WriteString (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@@ -861,7 +889,7 @@ void OPM_WriteString (CHAR *s, LONGINT s__len)
Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}
-void OPM_WriteStringVar (CHAR *s, LONGINT s__len)
+void OPM_WriteStringVar (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@@ -875,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);
@@ -893,7 +921,7 @@ void OPM_WriteHex (INT64 i)
void OPM_WriteInt (INT64 i)
{
- CHAR s[24];
+ CHAR s[26];
INT64 i1, k;
if ((i == OPM_SignedMinimum(2) || i == OPM_SignedMinimum(4)) || i == OPM_SignedMinimum(8)) {
OPM_Write('(');
@@ -901,21 +929,27 @@ void OPM_WriteInt (INT64 i)
OPM_WriteString((CHAR*)"-1)", 4);
} else {
i1 = __ABS(i);
- s[0] = (CHAR)(__MOD(i1, 10) + 48);
+ if (i1 <= 2147483647) {
+ k = 0;
+ } else {
+ __MOVE("LL", s, 3);
+ k = 2;
+ }
+ s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
- k = 1;
+ k += 1;
while (i1 > 0) {
- s[__X(k, 24)] = (CHAR)(__MOD(i1, 10) + 48);
+ s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k += 1;
}
if (i < 0) {
- s[__X(k, 24)] = '-';
+ s[__X(k, 26)] = '-';
k += 1;
}
while (k > 0) {
k -= 1;
- OPM_Write(s[__X(k, 24)]);
+ OPM_Write(s[__X(k, 26)]);
}
}
}
@@ -928,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') {
@@ -986,9 +1020,9 @@ static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F)
}
}
-void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
+void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len)
{
- CHAR FName[32];
+ OPM_FileName FName;
__COPY(moduleName, OPM_modName, 32);
OPM_HFile = Files_New((CHAR*)"", 1);
if (OPM_HFile != NIL) {
@@ -1014,7 +1048,7 @@ void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
void OPM_CloseFiles (void)
{
- CHAR FName[32];
+ OPM_FileName FName;
INT16 res;
if (OPM_noerr) {
OPM_LogWStr((CHAR*)" ", 3);
@@ -1050,6 +1084,59 @@ void OPM_CloseFiles (void)
Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, 0);
}
+static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len)
+{
+ CHAR testpath[4096];
+ Platform_FileIdentity identity;
+ __DUP(s, s__len, CHAR);
+ __COPY(OPM_InstallDir, testpath, 4096);
+ Strings_Append((CHAR*)"/lib/lib", 9, (void*)testpath, 4096);
+ Strings_Append((CHAR*)"voc", 4, (void*)testpath, 4096);
+ Strings_Append((CHAR*)"-O2.a", 6, (void*)testpath, 4096);
+ if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
+ __DEL(s);
+ return 0;
+ }
+ __COPY(OPM_InstallDir, testpath, 4096);
+ Strings_Append((CHAR*)"/2/include/Oberon.h", 20, (void*)testpath, 4096);
+ if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
+ __DEL(s);
+ return 0;
+ }
+ __COPY(OPM_InstallDir, testpath, 4096);
+ Strings_Append((CHAR*)"/2/sym/Files.sym", 17, (void*)testpath, 4096);
+ if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
+ __DEL(s);
+ return 0;
+ }
+ __DEL(s);
+ return 1;
+}
+
+static void OPM_FindInstallDir (void)
+{
+ INT16 i;
+ __COPY(Modules_BinaryDir, OPM_InstallDir, 1024);
+ Strings_Append((CHAR*)"/", 2, (void*)OPM_InstallDir, 1024);
+ Strings_Append((CHAR*)"voc", 4, (void*)OPM_InstallDir, 1024);
+ Strings_Append((CHAR*)".d", 3, (void*)OPM_InstallDir, 1024);
+ if (OPM_IsProbablyInstallDir(OPM_InstallDir, 1024)) {
+ return;
+ }
+ __COPY(Modules_BinaryDir, OPM_InstallDir, 1024);
+ i = Strings_Length(OPM_InstallDir, 1024);
+ while ((i > 0 && OPM_InstallDir[__X(i - 1, 1024)] != '/')) {
+ i -= 1;
+ }
+ if ((i > 0 && OPM_InstallDir[__X(i - 1, 1024)] == '/')) {
+ OPM_InstallDir[__X(i - 1, 1024)] = 0x00;
+ if (OPM_IsProbablyInstallDir(OPM_InstallDir, 1024)) {
+ return;
+ }
+ }
+ __COPY("", OPM_InstallDir, 1024);
+}
+
static void EnumPtrs(void (*P)(void*))
{
__ENUMR(&OPM_inR, Texts_Reader__typ, 48, 1, P);
@@ -1071,6 +1158,7 @@ export void *OPM__init(void)
__DEFMOD;
__MODULE_IMPORT(Configuration);
__MODULE_IMPORT(Files);
+ __MODULE_IMPORT(Modules);
__MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
@@ -1079,7 +1167,6 @@ export void *OPM__init(void)
__REGMOD("OPM", EnumPtrs);
__REGCMD("CloseFiles", OPM_CloseFiles);
__REGCMD("CloseOldSym", OPM_CloseOldSym);
- __REGCMD("DeleteNewSym", OPM_DeleteNewSym);
__REGCMD("InitOptions", OPM_InitOptions);
__REGCMD("LogWLn", OPM_LogWLn);
__REGCMD("RegisterNewSym", OPM_RegisterNewSym);
@@ -1089,5 +1176,8 @@ export void *OPM__init(void)
OPM_MaxLReal = 1.79769296342094e+308;
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 2d272feb..64c15a28 100644
--- a/bootstrap/unix-44/OPM.h
+++ b/bootstrap/unix-44/OPM.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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;
@@ -17,34 +17,39 @@ import INT32 OPM_curpos, OPM_errpos, OPM_breakpc;
import INT16 OPM_currFile, OPM_level, OPM_pc, OPM_entno;
import CHAR OPM_modName[32];
import CHAR OPM_objname[64];
+import CHAR OPM_InstallDir[1024];
import CHAR OPM_ResourceDir[1024];
import void OPM_CloseFiles (void);
import void OPM_CloseOldSym (void);
-import void OPM_DeleteNewSym (void);
+import void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
+import void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
import void OPM_FPrint (INT32 *fp, INT64 val);
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_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
+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);
-import void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
+import void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len);
+import void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len);
import void OPM_LogW (CHAR ch);
import void OPM_LogWLn (void);
import void OPM_LogWNum (INT64 i, INT64 len);
-import void OPM_LogWStr (CHAR *s, LONGINT s__len);
+import void OPM_LogWStr (CHAR *s, ADDRESS s__len);
import INT32 OPM_Longint (INT64 n);
import void OPM_Mark (INT16 n, INT32 pos);
-import void OPM_NewSym (CHAR *modName, LONGINT modName__len);
-import void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
-import void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
+import void OPM_NewSym (CHAR *modName, ADDRESS modName__len);
+import void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done);
+import void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len);
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);
@@ -61,8 +66,8 @@ import void OPM_WriteHex (INT64 i);
import void OPM_WriteInt (INT64 i);
import void OPM_WriteLn (void);
import void OPM_WriteReal (LONGREAL r, CHAR suffx);
-import void OPM_WriteString (CHAR *s, LONGINT s__len);
-import void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
+import void OPM_WriteString (CHAR *s, ADDRESS s__len);
+import void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
import BOOLEAN OPM_eofSF (void);
import void OPM_err (INT16 n);
import void *OPM__init(void);
diff --git a/bootstrap/unix-44/OPP.c b/bootstrap/unix-44/OPP.c
index 3f360d00..ad4a370a 100644
--- a/bootstrap/unix-44/OPP.c
+++ b/bootstrap/unix-44/OPP.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -527,7 +527,7 @@ static void OPP_selector (OPT_Node *x)
} else if (OPP_sym == 18) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
- __COPY(OPS_name, name, 256);
+ __MOVE(OPS_name, name, 256);
OPS_Get(&OPP_sym);
if ((*x)->typ != NIL) {
if ((*x)->typ->form == 11) {
@@ -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);
@@ -867,7 +867,7 @@ static void OPP_Receiver (INT8 *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct
} else {
*mode = 1;
}
- __COPY(OPS_name, name, 256);
+ __MOVE(OPS_name, name, 256);
OPP_CheckSym(38);
OPP_CheckSym(20);
if (OPP_sym == 38) {
@@ -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;
}
}
@@ -1030,7 +1030,7 @@ static void TProcDecl__23 (void)
}
OPP_Receiver(&objMode, objName, &objTyp, &recTyp);
if (OPP_sym == 38) {
- __COPY(OPS_name, *ProcedureDeclaration__16_s->name, 256);
+ __MOVE(OPS_name, *ProcedureDeclaration__16_s->name, 256);
OPP_CheckMark(&*ProcedureDeclaration__16_s->vis);
OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp, &*ProcedureDeclaration__16_s->fwd);
OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp->BaseTyp, &baseProc);
@@ -1129,7 +1129,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
TProcDecl__23();
} else if (OPP_sym == 38) {
OPT_Find(&fwd);
- __COPY(OPS_name, name, 256);
+ __MOVE(OPS_name, name, 256);
OPP_CheckMark(&vis);
if ((vis != 0 && mode == 6)) {
mode = 7;
@@ -1665,6 +1665,9 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
obj->typ = OPT_undftyp;
OPP_CheckMark(&obj->vis);
if (OPP_sym == 9) {
+ if (((((((((__STRCMP(obj->name, "SHORTINT") == 0 || __STRCMP(obj->name, "INTEGER") == 0) || __STRCMP(obj->name, "LONGINT") == 0) || __STRCMP(obj->name, "HUGEINT") == 0) || __STRCMP(obj->name, "REAL") == 0) || __STRCMP(obj->name, "LONGREAL") == 0) || __STRCMP(obj->name, "SET") == 0) || __STRCMP(obj->name, "CHAR") == 0) || __STRCMP(obj->name, "TRUE") == 0) || __STRCMP(obj->name, "FALSE") == 0) {
+ OPM_Mark(-310, OPM_curpos);
+ }
OPS_Get(&OPP_sym);
OPP_TypeDecl(&obj->typ, &obj->typ);
} else if (OPP_sym == 34 || OPP_sym == 20) {
@@ -1790,30 +1793,10 @@ void OPP_Module (OPT_Node *prog, UINT32 opt)
if (OPP_sym == 63) {
OPS_Get(&OPP_sym);
} else {
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Unexpected symbol found when MODULE expected:", 46);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" sym: ", 15);
- OPM_LogWNum(OPP_sym, 1);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.name: ", 15);
- OPM_LogWStr(OPS_name, 256);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.str: ", 15);
- OPM_LogWStr(OPS_str, 256);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.numtyp: ", 15);
- OPM_LogWNum(OPS_numtyp, 1);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.intval: ", 15);
- OPM_LogWNum(OPS_intval, 1);
- OPM_LogWLn();
OPP_err(16);
}
if (OPP_sym == 38) {
- OPM_LogWStr((CHAR*)"compiling ", 11);
- OPM_LogWStr(OPS_name, 256);
- OPM_LogW('.');
+ OPM_LogCompiling(OPS_name, 256);
OPT_Init(OPS_name, opt);
OPS_Get(&OPP_sym);
OPP_CheckSym(39);
diff --git a/bootstrap/unix-44/OPP.h b/bootstrap/unix-44/OPP.h
index 5a71eb39..3d8cefe8 100644
--- a/bootstrap/unix-44/OPP.h
+++ b/bootstrap/unix-44/OPP.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 6ee700e5..a25a2c12 100644
--- a/bootstrap/unix-44/OPS.c
+++ b/bootstrap/unix-44/OPS.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,9 +196,9 @@ 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(9223372036854775807 - (INT64)d, 10)) {
+ if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) {
OPS_intval = OPS_intval * 10 + (INT64)d;
} else {
OPS_err(203);
@@ -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 1f7a3e58..19e222ac 100644
--- a/bootstrap/unix-44/OPS.h
+++ b/bootstrap/unix-44/OPS.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 fb007184..72261b24 100644
--- a/bootstrap/unix-44/OPT.c
+++ b/bootstrap/unix-44/OPT.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -49,6 +49,15 @@ typedef
INT8 glbmno[64];
} OPT_ImpCtxt;
+typedef
+ struct OPT_LinkDesc *OPT_Link;
+
+typedef
+ struct OPT_LinkDesc {
+ OPS_Name name;
+ OPT_Link next;
+ } OPT_LinkDesc;
+
typedef
struct OPT_NodeDesc *OPT_Node;
@@ -74,6 +83,7 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
+ OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@@ -101,6 +111,7 @@ static OPT_ExpCtxt OPT_expCtxt;
static INT32 OPT_nofhdfld;
static BOOLEAN OPT_newsf, OPT_findpc, OPT_extsf, OPT_sfpresent, OPT_symExtended, OPT_symNew;
static INT32 OPT_recno;
+export OPT_Link OPT_Links;
export ADDRESS *OPT_ConstDesc__typ;
export ADDRESS *OPT_ObjDesc__typ;
@@ -108,6 +119,7 @@ export ADDRESS *OPT_StrDesc__typ;
export ADDRESS *OPT_NodeDesc__typ;
export ADDRESS *OPT_ImpCtxt__typ;
export ADDRESS *OPT_ExpCtxt__typ;
+export ADDRESS *OPT_LinkDesc__typ;
export void OPT_Align (INT32 *adr, INT32 base);
export INT32 OPT_BaseAlignment (OPT_Struct typ);
@@ -120,7 +132,7 @@ static void OPT_EnterTyp (OPS_Name name, INT8 form, INT16 size, OPT_Struct *res)
static void OPT_EnterTypeAlias (OPS_Name name, OPT_Object *res);
export void OPT_Export (BOOLEAN *ext, BOOLEAN *new);
export void OPT_FPrintErr (OPT_Object obj, INT16 errcode);
-static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len);
+static void OPT_FPrintName (INT32 *fp, CHAR *name, ADDRESS name__len);
export void OPT_FPrintObj (OPT_Object obj);
static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par);
export void OPT_FPrintStr (OPT_Struct typ);
@@ -131,8 +143,9 @@ export void OPT_IdFPrint (OPT_Struct typ);
export void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
static void OPT_InConstant (INT32 f, OPT_Const conval);
static OPT_Object OPT_InFld (void);
+static void OPT_InLinks (void);
static void OPT_InMod (INT8 *mno);
-static void OPT_InName (CHAR *name, LONGINT name__len);
+static void OPT_InName (CHAR *name, ADDRESS name__len);
static OPT_Object OPT_InObj (INT8 mno);
static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par);
static void OPT_InStruct (OPT_Struct *typ);
@@ -154,12 +167,14 @@ export void OPT_OpenScope (INT8 level, OPT_Object owner);
static void OPT_OutConstant (OPT_Object obj);
static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible);
static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr);
+static void OPT_OutLinks (void);
static void OPT_OutMod (INT16 mno);
-static void OPT_OutName (CHAR *name, LONGINT name__len);
+static void OPT_OutName (CHAR *name, ADDRESS name__len);
static void OPT_OutObj (OPT_Object obj);
static void OPT_OutSign (OPT_Struct result, OPT_Object par);
static void OPT_OutStr (OPT_Struct typ);
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj);
+static void OPT_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);
@@ -339,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;
@@ -375,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;
}
@@ -434,14 +453,16 @@ void OPT_Init (OPS_Name name, UINT32 opt)
OPT_topScope = OPT_universe;
OPT_OpenScope(0, NIL);
OPT_SYSimported = 0;
- __COPY(name, OPT_SelfName, 256);
- __COPY(name, OPT_topScope->name, 256);
+ __MOVE(name, OPT_SelfName, 256);
+ __MOVE(name, OPT_topScope->name, 256);
OPT_GlbMod[0] = OPT_topScope;
OPT_nofGmod = 1;
OPT_newsf = __IN(4, opt, 32);
OPT_findpc = __IN(8, opt, 32);
OPT_extsf = OPT_newsf || __IN(9, opt, 32);
OPT_sfpresent = 1;
+ __NEW(OPT_Links, OPT_LinkDesc);
+ __MOVE(name, OPT_Links->name, 256);
}
void OPT_Close (void)
@@ -539,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;
@@ -570,13 +593,23 @@ 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;
}
}
*obj = ob1;
}
-static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len)
+static void OPT_FPrintName (INT32 *fp, CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@@ -957,7 +990,7 @@ void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old)
}
}
-static void OPT_InName (CHAR *name, LONGINT name__len)
+static void OPT_InName (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@@ -1011,6 +1044,26 @@ static void OPT_InMod (INT8 *mno)
}
}
+static void OPT_InLinks (void)
+{
+ OPS_Name linkname;
+ OPT_Link l = NIL;
+ OPT_InName((void*)linkname, 256);
+ while (linkname[0] != 0x00) {
+ l = OPT_Links;
+ while ((l != NIL && __STRCMP(l->name, linkname) != 0)) {
+ l = l->next;
+ }
+ if (l == NIL) {
+ l = OPT_Links;
+ __NEW(OPT_Links, OPT_LinkDesc);
+ OPT_Links->next = l;
+ __MOVE(linkname, OPT_Links->name, 256);
+ }
+ OPT_InName((void*)linkname, 256);
+ }
+}
+
static void OPT_InConstant (INT32 f, OPT_Const conval)
{
CHAR ch;
@@ -1068,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) {
@@ -1186,7 +1246,7 @@ static void OPT_InStruct (OPT_Struct *typ)
}
*typ = OPT_NewStr(0, 1);
} else {
- __COPY(name, obj->name, 256);
+ __MOVE(name, obj->name, 256);
OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
if (old != NIL) {
OPT_FPrintObj(old);
@@ -1216,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) {
@@ -1346,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;
@@ -1362,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);
@@ -1377,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)]);
@@ -1389,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);
@@ -1458,9 +1565,15 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
OPT_impCtxt.nofm = 0;
OPT_impCtxt.self = __STRCMP(aliasName, "@self") == 0;
OPT_impCtxt.reffp = 0;
- OPM_OldSym((void*)name, 256, &*done);
+ if ((OPT_impCtxt.self && __IN(17, OPM_Options, 32))) {
+ OPM_DeleteSym((void*)name, 256);
+ *done = 0;
+ } else {
+ OPM_OldSym((void*)name, 256, &*done);
+ }
if (*done) {
OPT_InMod(&mno);
+ OPT_InLinks();
OPT_impCtxt.nextTag = OPM_SymRInt();
while (!OPM_eofSF()) {
obj = OPT_InObj(mno);
@@ -1483,7 +1596,7 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
}
}
-static void OPT_OutName (CHAR *name, LONGINT name__len)
+static void OPT_OutName (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@@ -1507,6 +1620,17 @@ static void OPT_OutMod (INT16 mno)
}
}
+static void OPT_OutLinks (void)
+{
+ OPT_Link l = NIL;
+ l = OPT_Links;
+ while (l != NIL) {
+ OPT_OutName((void*)l->name, 256);
+ l = l->next;
+ }
+ OPM_SymWCh(0x00);
+}
+
static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr)
{
INT32 i, j, n;
@@ -1700,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);
@@ -1728,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) {
@@ -1833,6 +1984,7 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
if (OPM_noerr) {
OPM_SymWInt(16);
OPT_OutName((void*)OPT_SelfName, 256);
+ OPT_OutLinks();
OPT_expCtxt.reffp = 0;
OPT_expCtxt.ref = 14;
OPT_expCtxt.nofm = 1;
@@ -1854,7 +2006,7 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
OPT_newsf = 0;
OPT_symNew = 0;
if (!OPM_noerr || OPT_findpc) {
- OPM_DeleteNewSym();
+ OPM_DeleteSym((void*)OPT_SelfName, 256);
}
}
}
@@ -1969,10 +2121,11 @@ static void EnumPtrs(void (*P)(void*))
P(OPT_universe);
P(OPT_syslink);
__ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 3140, 1, P);
+ P(OPT_Links);
}
__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,
@@ -2008,6 +2161,7 @@ __TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 3140), {16, 20, 24, 28, 32,
1936, 1940, 1944, 1948, 1952, 1956, 1960, 1964, 1968, 1972, 1976, 1980, 1984, 1988, 1992, 1996,
2000, 2004, 2008, 2012, 2016, 2020, 2024, 2028, 2032, 2036, 2040, 2044, 2048, 2052, -2044}};
__TDESC(OPT_ExpCtxt, 1, 0) = {__TDFLDS("ExpCtxt", 72), {-4}};
+__TDESC(OPT_LinkDesc, 1, 1) = {__TDFLDS("LinkDesc", 260), {256, -8}};
export void *OPT__init(void)
{
@@ -2024,6 +2178,7 @@ export void *OPT__init(void)
__INITYP(OPT_NodeDesc, OPT_NodeDesc, 0);
__INITYP(OPT_ImpCtxt, OPT_ImpCtxt, 0);
__INITYP(OPT_ExpCtxt, OPT_ExpCtxt, 0);
+ __INITYP(OPT_LinkDesc, OPT_LinkDesc, 0);
/* BEGIN */
OPT_topScope = NIL;
OPT_OpenScope(0, NIL);
diff --git a/bootstrap/unix-44/OPT.h b/bootstrap/unix-44/OPT.h
index 90fcacf5..cf456af5 100644
--- a/bootstrap/unix-44/OPT.h
+++ b/bootstrap/unix-44/OPT.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -21,6 +21,15 @@ typedef
LONGREAL realval;
} OPT_ConstDesc;
+typedef
+ struct OPT_LinkDesc *OPT_Link;
+
+typedef
+ struct OPT_LinkDesc {
+ OPS_Name name;
+ OPT_Link next;
+ } OPT_LinkDesc;
+
typedef
struct OPT_NodeDesc *OPT_Node;
@@ -52,6 +61,7 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
+ OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@@ -75,11 +85,13 @@ import INT8 OPT_nofGmod;
import OPT_Object OPT_GlbMod[64];
import OPS_Name OPT_SelfName;
import BOOLEAN OPT_SYSimported;
+import OPT_Link OPT_Links;
import ADDRESS *OPT_ConstDesc__typ;
import ADDRESS *OPT_ObjDesc__typ;
import ADDRESS *OPT_StrDesc__typ;
import ADDRESS *OPT_NodeDesc__typ;
+import ADDRESS *OPT_LinkDesc__typ;
import void OPT_Align (INT32 *adr, INT32 base);
import INT32 OPT_BaseAlignment (OPT_Struct typ);
diff --git a/bootstrap/unix-44/OPV.c b/bootstrap/unix-44/OPV.c
index 5c21cb97..0425b2e0 100644
--- a/bootstrap/unix-44/OPV.c
+++ b/bootstrap/unix-44/OPV.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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));
@@ -163,7 +163,7 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
}
scope = obj->scope;
scope->leaf = 1;
- __COPY(obj->name, scope->name, 256);
+ __MOVE(obj->name, scope->name, 256);
OPV_Stamp(scope->name);
if (mode == 9) {
obj->adr = 1;
@@ -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);
@@ -1286,7 +1297,17 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPM_WriteString((CHAR*)", ", 3);
if (r->typ == OPT_stringtyp) {
OPM_WriteInt(r->conval->intval2);
+ } else if (r->typ->comp == 3) {
+ OPM_WriteString((CHAR*)"__X(", 5);
+ OPC_Len(r->obj, r->typ, 0);
+ OPM_WriteString((CHAR*)" * ", 4);
+ OPM_WriteInt(r->typ->BaseTyp->size);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteInt(l->typ->size + 1);
+ OPM_Write(')');
} else {
+ __ASSERT(r->typ->comp == 2, 0);
+ __ASSERT(r->typ->size <= l->typ->size, 0);
OPM_WriteInt(r->typ->size);
}
OPM_Write(')');
diff --git a/bootstrap/unix-44/OPV.h b/bootstrap/unix-44/OPV.h
index c4a61586..fbabd8f4 100644
--- a/bootstrap/unix-44/OPV.h
+++ b/bootstrap/unix-44/OPV.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 39f383cf..ce936589 100644
--- a/bootstrap/unix-44/Out.c
+++ b/bootstrap/unix-44/Out.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 "Heap.h"
#include "Platform.h"
@@ -16,17 +17,18 @@ static INT16 Out_in;
export void Out_Char (CHAR ch);
export void Out_Flush (void);
+export void Out_Hex (INT64 x, INT64 n);
export void Out_Int (INT64 x, INT64 n);
-static INT32 Out_Length (CHAR *s, LONGINT s__len);
+static INT32 Out_Length (CHAR *s, ADDRESS s__len);
export void Out_Ln (void);
export void Out_LongReal (LONGREAL x, INT16 n);
export void Out_Open (void);
export void Out_Real (REAL x, INT16 n);
static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_);
-export void Out_String (CHAR *str, LONGINT str__len);
+export void Out_String (CHAR *str, ADDRESS str__len);
export LONGREAL Out_Ten (INT16 e);
-static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i);
-static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i);
+static void Out_digit (INT64 n, CHAR *s, ADDRESS s__len, INT16 *i);
+static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i);
#define Out_Entier64(x) (INT64)(x)
@@ -55,7 +57,7 @@ void Out_Char (CHAR ch)
}
}
-static INT32 Out_Length (CHAR *s, LONGINT s__len)
+static INT32 Out_Length (CHAR *s, ADDRESS s__len)
{
INT32 l;
l = 0;
@@ -65,7 +67,7 @@ static INT32 Out_Length (CHAR *s, LONGINT s__len)
return l;
}
-void Out_String (CHAR *str, LONGINT str__len)
+void Out_String (CHAR *str, ADDRESS str__len)
{
INT32 l;
INT16 error;
@@ -78,7 +80,7 @@ void Out_String (CHAR *str, LONGINT 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);
}
@@ -89,18 +91,18 @@ void Out_Int (INT64 x, INT64 n)
INT16 i;
BOOLEAN negative;
negative = x < 0;
- if (x == (-9223372036854775807-1)) {
+ if (x == (-9223372036854775807LL-1)) {
__MOVE("8085774586302733229", s, 20);
i = 19;
} else {
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;
}
@@ -119,19 +121,43 @@ void Out_Int (INT64 x, INT64 n)
}
}
+void Out_Hex (INT64 x, INT64 n)
+{
+ if (n < 1) {
+ n = 1;
+ } else if (n > 16) {
+ n = 16;
+ }
+ if (x >= 0) {
+ while ((n < 16 && __LSH(x, -__ASHL(n, 2), 64) != 0)) {
+ n += 1;
+ }
+ }
+ x = __ROT(x, __ASHL(16 - n, 2), 64);
+ while (n > 0) {
+ x = __ROTL(x, 4, 64);
+ n -= 1;
+ if (__MASK(x, -16) < 10) {
+ Out_Char(__CHR(__MASK(x, -16) + 48));
+ } else {
+ Out_Char(__CHR((__MASK(x, -16) - 10) + 65));
+ }
+ }
+}
+
void Out_Ln (void)
{
Out_String(Platform_NL, 3);
Out_Flush();
}
-static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i)
+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, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i)
+static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i)
{
INT16 j;
INT32 l;
@@ -140,7 +166,7 @@ static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT 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)];
@@ -175,7 +201,7 @@ static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_)
INT64 m;
INT16 d, dr;
e = (INT16)__MASK(__ASHR((__VAL(INT64, x)), 52), -2048);
- f = __MASK((__VAL(INT64, x)), -4503599627370496);
+ f = __MASK((__VAL(INT64, x)), -4503599627370496LL);
nn = (__VAL(INT64, x) < 0 && !((e == 2047 && f != 0)));
if (nn) {
n -= 1;
@@ -222,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 {
@@ -306,6 +332,7 @@ void Out_LongReal (LONGREAL x, INT16 n)
export void *Out__init(void)
{
__DEFMOD;
+ __MODULE_IMPORT(Heap);
__MODULE_IMPORT(Platform);
__REGMOD("Out", 0);
__REGCMD("Flush", Out_Flush);
diff --git a/bootstrap/unix-44/Out.h b/bootstrap/unix-44/Out.h
index 0e66420d..a72547f4 100644
--- a/bootstrap/unix-44/Out.h
+++ b/bootstrap/unix-44/Out.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -11,12 +11,13 @@ import BOOLEAN Out_IsConsole;
import void Out_Char (CHAR ch);
import void Out_Flush (void);
+import void Out_Hex (INT64 x, INT64 n);
import void Out_Int (INT64 x, INT64 n);
import void Out_Ln (void);
import void Out_LongReal (LONGREAL x, INT16 n);
import void Out_Open (void);
import void Out_Real (REAL x, INT16 n);
-import void Out_String (CHAR *str, LONGINT str__len);
+import void Out_String (CHAR *str, ADDRESS str__len);
import LONGREAL Out_Ten (INT16 e);
import void *Out__init(void);
diff --git a/bootstrap/unix-44/Platform.c b/bootstrap/unix-44/Platform.c
index 72c15bf8..befa6033 100644
--- a/bootstrap/unix-44/Platform.c
+++ b/bootstrap/unix-44/Platform.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,37 +7,18 @@
#include "SYSTEM.h"
-typedef
- CHAR (*Platform_ArgPtr)[1024];
-
-typedef
- Platform_ArgPtr (*Platform_ArgVec)[1024];
-
-typedef
- INT32 (*Platform_ArgVecPtr)[1];
-
-typedef
- CHAR (*Platform_EnvPtr)[1024];
-
typedef
struct Platform_FileIdentity {
INT32 volume, index, mtime;
} Platform_FileIdentity;
-typedef
- void (*Platform_HaltProcedure)(INT32);
-
typedef
void (*Platform_SignalHandler)(INT32);
export BOOLEAN Platform_LittleEndian;
-export INT32 Platform_MainStackFrame;
export INT16 Platform_PID;
export CHAR Platform_CWD[256];
-export INT16 Platform_ArgCount;
-export INT32 Platform_ArgVector;
-static Platform_HaltProcedure Platform_HaltHandler;
static INT32 Platform_TimeStart;
export INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
export CHAR Platform_NL[3];
@@ -45,35 +26,33 @@ export CHAR Platform_NL[3];
export ADDRESS *Platform_FileIdentity__typ;
export BOOLEAN Platform_Absent (INT16 e);
-export INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
-export INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
+export INT16 Platform_Chdir (CHAR *n, ADDRESS n__len);
export INT16 Platform_Close (INT32 h);
export BOOLEAN Platform_ConnectionFailed (INT16 e);
export void Platform_Delay (INT32 ms);
export BOOLEAN Platform_DifferentFilesystems (INT16 e);
export INT16 Platform_Error (void);
export void Platform_Exit (INT32 code);
-export void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
export void Platform_GetClock (INT32 *t, INT32 *d);
-export void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
-export void Platform_GetIntArg (INT16 n, INT32 *val);
+export void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
export void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec);
export INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *identity__typ);
-export INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
+export INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
export BOOLEAN Platform_Inaccessible (INT16 e);
-export void Platform_Init (INT32 argc, INT32 argvadr);
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_New (CHAR *n, LONGINT n__len, INT32 *h);
+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);
export void Platform_OSFree (INT32 address);
-export INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h);
-export INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h);
+export INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h);
+export INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h);
export INT16 Platform_Read (INT32 h, INT32 p, INT32 l, INT32 *n);
-export INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n);
-export INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
+export INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n);
+export INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len);
export BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2);
export BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2);
export INT16 Platform_Seek (INT32 h, INT32 offset, INT16 whence);
@@ -83,16 +62,16 @@ export void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__t
export void Platform_SetQuitHandler (Platform_SignalHandler handler);
export INT16 Platform_Size (INT32 h, INT32 *l);
export INT16 Platform_Sync (INT32 h);
-export INT16 Platform_System (CHAR *cmd, LONGINT cmd__len);
+export INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len);
static void Platform_TestLittleEndian (void);
export INT32 Platform_Time (void);
export BOOLEAN Platform_TimedOut (INT16 e);
export BOOLEAN Platform_TooManyFiles (INT16 e);
export INT16 Platform_Truncate (INT32 h, INT32 l);
-export INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
+export INT16 Platform_Unlink (CHAR *n, ADDRESS n__len);
export INT16 Platform_Write (INT32 h, INT32 p, INT32 l);
static void Platform_YMDHMStoClock (INT32 ye, INT32 mo, INT32 da, INT32 ho, INT32 mi, INT32 se, INT32 *t, INT32 *d);
-export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
+export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
#include
#include
@@ -102,6 +81,7 @@ export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT
#include
#include
#include
+#include
#include
#include
#define Platform_EACCES() EACCES
@@ -117,8 +97,8 @@ export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT
#define Platform_EROFS() EROFS
#define Platform_ETIMEDOUT() ETIMEDOUT
#define Platform_EXDEV() EXDEV
-extern void Heap_InitHeap();
-#define Platform_HeapInitHeap() Heap_InitHeap()
+#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)
@@ -129,7 +109,7 @@ extern void Heap_InitHeap();
#define Platform_fsync(fd) fsync(fd)
#define Platform_ftruncate(fd, l) ftruncate(fd, l)
#define Platform_getcwd(cwd, cwd__len) getcwd((char*)cwd, cwd__len)
-#define Platform_getenv(var, var__len) (Platform_EnvPtr)getenv((char*)var)
+#define Platform_getenv(var, var__len) getenv((char*)var)
#define Platform_getpid() (INTEGER)getpid()
#define Platform_gettimeval() struct timeval tv; gettimeofday(&tv,0)
#define Platform_isatty(fd) isatty(fd)
@@ -203,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);
@@ -213,21 +203,14 @@ void Platform_OSFree (INT32 address)
Platform_free(address);
}
-void Platform_Init (INT32 argc, INT32 argvadr)
-{
- Platform_ArgVecPtr av = NIL;
- Platform_MainStackFrame = argvadr;
- Platform_ArgCount = __VAL(INT16, argc);
- av = (Platform_ArgVecPtr)(ADDRESS)argvadr;
- Platform_ArgVector = (*av)[0];
- Platform_HeapInitHeap();
-}
+typedef
+ CHAR (*EnvPtr__83)[1024];
-BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
+BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{
- Platform_EnvPtr p = NIL;
+ EnvPtr__83 p = NIL;
__DUP(var, var__len, CHAR);
- p = Platform_getenv(var, var__len);
+ p = (EnvPtr__83)(ADDRESS)Platform_getenv(var, var__len);
if (p != NIL) {
__COPY(*p, val, val__len);
}
@@ -235,7 +218,7 @@ BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__le
return p != NIL;
}
-void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
+void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{
__DUP(var, var__len, CHAR);
if (!Platform_getEnv(var, var__len, (void*)val, val__len)) {
@@ -244,56 +227,6 @@ void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
__DEL(var);
}
-void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len)
-{
- Platform_ArgVec av = NIL;
- if (n < Platform_ArgCount) {
- av = (Platform_ArgVec)(ADDRESS)Platform_ArgVector;
- __COPY(*(*av)[__X(n, 1024)], val, val__len);
- }
-}
-
-void Platform_GetIntArg (INT16 n, INT32 *val)
-{
- CHAR s[64];
- INT32 k, d, i;
- s[0] = 0x00;
- Platform_GetArg(n, (void*)s, 64);
- i = 0;
- if (s[0] == '-') {
- i = 1;
- }
- k = 0;
- d = (INT16)s[__X(i, 64)] - 48;
- while ((d >= 0 && d <= 9)) {
- k = k * 10 + d;
- i += 1;
- d = (INT16)s[__X(i, 64)] - 48;
- }
- if (s[0] == '-') {
- k = -k;
- i -= 1;
- }
- if (i > 0) {
- *val = k;
- }
-}
-
-INT16 Platform_ArgPos (CHAR *s, LONGINT s__len)
-{
- INT16 i;
- CHAR arg[256];
- __DUP(s, s__len, CHAR);
- i = 0;
- Platform_GetArg(i, (void*)arg, 256);
- while ((i < Platform_ArgCount && __STRCMP(s, arg) != 0)) {
- i += 1;
- Platform_GetArg(i, (void*)arg, 256);
- }
- __DEL(s);
- return i;
-}
-
void Platform_SetInterruptHandler (Platform_SignalHandler handler)
{
Platform_sethandler(2, handler);
@@ -345,7 +278,7 @@ void Platform_Delay (INT32 ms)
Platform_nanosleep(s, ns);
}
-INT16 Platform_System (CHAR *cmd, LONGINT cmd__len)
+INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len)
{
__DUP(cmd, cmd__len, CHAR);
__DEL(cmd);
@@ -357,7 +290,7 @@ INT16 Platform_Error (void)
return Platform_err();
}
-INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h)
+INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h)
{
INT16 fd;
fd = Platform_openro(n, n__len);
@@ -370,7 +303,7 @@ INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h)
__RETCHK;
}
-INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h)
+INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h)
{
INT16 fd;
fd = Platform_openrw(n, n__len);
@@ -383,7 +316,7 @@ INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h)
__RETCHK;
}
-INT16 Platform_New (CHAR *n, LONGINT n__len, INT32 *h)
+INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h)
{
INT16 fd;
fd = Platform_opennew(n, n__len);
@@ -423,7 +356,7 @@ INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *iden
return 0;
}
-INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
+INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{
__DUP(n, n__len, CHAR);
Platform_structstats();
@@ -481,7 +414,7 @@ INT16 Platform_Read (INT32 h, INT32 p, INT32 l, INT32 *n)
__RETCHK;
}
-INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n)
+INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n)
{
*n = Platform_readfile(h, (ADDRESS)b, b__len);
if (*n < 0) {
@@ -535,7 +468,7 @@ INT16 Platform_Truncate (INT32 h, INT32 l)
__RETCHK;
}
-INT16 Platform_Unlink (CHAR *n, LONGINT n__len)
+INT16 Platform_Unlink (CHAR *n, ADDRESS n__len)
{
if (Platform_unlink(n, n__len) < 0) {
return Platform_err();
@@ -545,7 +478,7 @@ INT16 Platform_Unlink (CHAR *n, LONGINT n__len)
__RETCHK;
}
-INT16 Platform_Chdir (CHAR *n, LONGINT n__len)
+INT16 Platform_Chdir (CHAR *n, ADDRESS n__len)
{
INT16 r;
if ((Platform_chdir(n, n__len) >= 0 && Platform_getcwd((void*)Platform_CWD, 256) != NIL)) {
@@ -556,7 +489,7 @@ INT16 Platform_Chdir (CHAR *n, LONGINT n__len)
__RETCHK;
}
-INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len)
+INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len)
{
if (Platform_rename(o, o__len, n, n__len) < 0) {
return Platform_err();
@@ -587,7 +520,6 @@ export void *Platform__init(void)
__INITYP(Platform_FileIdentity, Platform_FileIdentity, 0);
/* BEGIN */
Platform_TestLittleEndian();
- Platform_HaltHandler = NIL;
Platform_TimeStart = 0;
Platform_TimeStart = Platform_Time();
Platform_PID = Platform_getpid();
diff --git a/bootstrap/unix-44/Platform.h b/bootstrap/unix-44/Platform.h
index b04f552d..fbeef8c7 100644
--- a/bootstrap/unix-44/Platform.h
+++ b/bootstrap/unix-44/Platform.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -16,46 +16,41 @@ typedef
import BOOLEAN Platform_LittleEndian;
-import INT32 Platform_MainStackFrame;
import INT16 Platform_PID;
import CHAR Platform_CWD[256];
-import INT16 Platform_ArgCount;
-import INT32 Platform_ArgVector;
import INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
import CHAR Platform_NL[3];
import ADDRESS *Platform_FileIdentity__typ;
import BOOLEAN Platform_Absent (INT16 e);
-import INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
-import INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
+import INT16 Platform_Chdir (CHAR *n, ADDRESS n__len);
import INT16 Platform_Close (INT32 h);
import BOOLEAN Platform_ConnectionFailed (INT16 e);
import void Platform_Delay (INT32 ms);
import BOOLEAN Platform_DifferentFilesystems (INT16 e);
import INT16 Platform_Error (void);
import void Platform_Exit (INT32 code);
-import void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
import void Platform_GetClock (INT32 *t, INT32 *d);
-import void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
-import void Platform_GetIntArg (INT16 n, INT32 *val);
+import void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
import void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec);
import INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *identity__typ);
-import INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
+import INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
import BOOLEAN Platform_Inaccessible (INT16 e);
-import void Platform_Init (INT32 argc, INT32 argvadr);
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_New (CHAR *n, LONGINT n__len, INT32 *h);
+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);
import void Platform_OSFree (INT32 address);
-import INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h);
-import INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h);
+import INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h);
+import INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h);
import INT16 Platform_Read (INT32 h, INT32 p, INT32 l, INT32 *n);
-import INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n);
-import INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
+import INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n);
+import INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len);
import BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2);
import BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2);
import INT16 Platform_Seek (INT32 h, INT32 offset, INT16 whence);
@@ -65,14 +60,14 @@ import void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__t
import void Platform_SetQuitHandler (Platform_SignalHandler handler);
import INT16 Platform_Size (INT32 h, INT32 *l);
import INT16 Platform_Sync (INT32 h);
-import INT16 Platform_System (CHAR *cmd, LONGINT cmd__len);
+import INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len);
import INT32 Platform_Time (void);
import BOOLEAN Platform_TimedOut (INT16 e);
import BOOLEAN Platform_TooManyFiles (INT16 e);
import INT16 Platform_Truncate (INT32 h, INT32 l);
-import INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
+import INT16 Platform_Unlink (CHAR *n, ADDRESS n__len);
import INT16 Platform_Write (INT32 h, INT32 p, INT32 l);
-import BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
+import BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
import void *Platform__init(void);
diff --git a/bootstrap/unix-44/Reals.c b/bootstrap/unix-44/Reals.c
index cd4c3c61..512ec2c4 100644
--- a/bootstrap/unix-44/Reals.c
+++ b/bootstrap/unix-44/Reals.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -10,11 +10,11 @@
-static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len);
-export void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len);
-export void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len);
-export void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len);
-export void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len);
+static void Reals_BytesToHex (SYSTEM_BYTE *b, ADDRESS b__len, SYSTEM_BYTE *d, ADDRESS d__len);
+export void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len);
+export void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len);
+export void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len);
+export void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len);
export INT16 Reals_Expo (REAL x);
export INT16 Reals_ExpoL (LONGREAL x);
export void Reals_SetExpo (REAL *x, INT16 ex);
@@ -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)
@@ -79,7 +79,7 @@ INT16 Reals_ExpoL (LONGREAL x)
return __MASK(__ASHR(i, 4), -2048);
}
-void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len)
+void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len)
{
INT32 i, j, k;
if (x < (LONGREAL)0) {
@@ -87,27 +87,27 @@ void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT 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;
}
}
-void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len)
+void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len)
{
Reals_ConvertL(x, n, (void*)d, d__len);
}
@@ -115,14 +115,14 @@ void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT 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;
}
-static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len)
+static void Reals_BytesToHex (SYSTEM_BYTE *b, ADDRESS b__len, SYSTEM_BYTE *d, ADDRESS d__len)
{
INT16 i;
INT32 l;
@@ -137,12 +137,12 @@ static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LO
}
}
-void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len)
+void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len)
{
Reals_BytesToHex((void*)&y, 4, (void*)d, d__len * 1);
}
-void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len)
+void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len)
{
Reals_BytesToHex((void*)&x, 8, (void*)d, d__len * 1);
}
diff --git a/bootstrap/unix-44/Reals.h b/bootstrap/unix-44/Reals.h
index f0c84ab1..93e7fa75 100644
--- a/bootstrap/unix-44/Reals.h
+++ b/bootstrap/unix-44/Reals.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -8,10 +8,10 @@
-import void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len);
-import void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len);
-import void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len);
-import void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len);
+import void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len);
+import void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len);
+import void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len);
+import void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len);
import INT16 Reals_Expo (REAL x);
import INT16 Reals_ExpoL (LONGREAL x);
import void Reals_SetExpo (REAL *x, INT16 ex);
diff --git a/bootstrap/unix-44/Strings.c b/bootstrap/unix-44/Strings.c
index b5707327..4b18812f 100644
--- a/bootstrap/unix-44/Strings.c
+++ b/bootstrap/unix-44/Strings.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,22 +6,25 @@
#define SET UINT32
#include "SYSTEM.h"
+#include "Reals.h"
-export void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
-export void Strings_Cap (CHAR *s, LONGINT s__len);
-export void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n);
-export void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len);
-export void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
-export INT16 Strings_Length (CHAR *s, LONGINT s__len);
-export BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len);
-export INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos);
-export void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
+export void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len);
+export void Strings_Cap (CHAR *s, ADDRESS s__len);
+export void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n);
+export void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len);
+export void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len);
+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, LONGINT s__len)
+INT16 Strings_Length (CHAR *s, ADDRESS s__len)
{
INT32 i;
__DUP(s, s__len, CHAR);
@@ -31,7 +34,7 @@ INT16 Strings_Length (CHAR *s, LONGINT s__len)
}
if (i <= 32767) {
__DEL(s);
- return (INT16)i;
+ return __SHORT(i, 32768);
} else {
__DEL(s);
return 32767;
@@ -39,7 +42,7 @@ INT16 Strings_Length (CHAR *s, LONGINT s__len)
__RETCHK;
}
-void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len)
+void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len)
{
INT16 n1, n2, i;
__DUP(extra, extra__len, CHAR);
@@ -56,7 +59,7 @@ void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__
__DEL(extra);
}
-void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
+void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
{
INT16 n1, n2, i;
__DUP(source, source__len, CHAR);
@@ -87,7 +90,7 @@ void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, L
__DEL(source);
}
-void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n)
+void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n)
{
INT16 len, i;
len = Strings_Length(s, s__len);
@@ -110,7 +113,7 @@ void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n)
}
}
-void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
+void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
{
__DUP(source, source__len, CHAR);
Strings_Delete((void*)dest, dest__len, pos, pos + Strings_Length(source, source__len));
@@ -118,12 +121,12 @@ void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest,
__DEL(source);
}
-void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len)
+void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len)
{
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;
}
@@ -143,7 +146,7 @@ void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHA
__DEL(source);
}
-INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos)
+INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos)
{
INT16 n1, n2, i, j;
__DUP(pattern, pattern__len, CHAR);
@@ -175,7 +178,7 @@ INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len,
return -1;
}
-void Strings_Cap (CHAR *s, LONGINT s__len)
+void Strings_Cap (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@@ -191,9 +194,9 @@ static struct Match__7 {
struct Match__7 *lnk;
} *Match__7_s;
-static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m);
+static BOOLEAN M__8 (CHAR *name, ADDRESS name__len, CHAR *mask, ADDRESS mask__len, INT16 n, INT16 m);
-static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m)
+static BOOLEAN M__8 (CHAR *name, ADDRESS name__len, CHAR *mask, ADDRESS mask__len, INT16 n, INT16 m)
{
while ((((n >= 0 && m >= 0)) && mask[__X(m, mask__len)] != '*')) {
if (name[__X(n, name__len)] != mask[__X(m, mask__len)]) {
@@ -220,7 +223,7 @@ static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__le
return 0;
}
-BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len)
+BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len)
{
struct Match__7 _s;
BOOLEAN __retval;
@@ -236,10 +239,135 @@ BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT
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 c987af8d..f0e3ae34 100644
--- a/bootstrap/unix-44/Strings.h
+++ b/bootstrap/unix-44/Strings.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -8,15 +8,17 @@
-import void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
-import void Strings_Cap (CHAR *s, LONGINT s__len);
-import void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n);
-import void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len);
-import void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
-import INT16 Strings_Length (CHAR *s, LONGINT s__len);
-import BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len);
-import INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos);
-import void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
+import void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len);
+import void Strings_Cap (CHAR *s, ADDRESS s__len);
+import void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n);
+import void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len);
+import void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len);
+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 0ac5c5f2..7e7522c2 100644
--- a/bootstrap/unix-44/Texts.c
+++ b/bootstrap/unix-44/Texts.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -187,20 +187,20 @@ export void Texts_Append (Texts_Text T, Texts_Buffer B);
export void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
static Texts_Elem Texts_CloneElem (Texts_Elem e);
static Texts_Piece Texts_ClonePiece (Texts_Piece p);
-export void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
+export void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len);
export void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
export void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
export void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
export Texts_Text Texts_ElemBase (Texts_Elem E);
export INT32 Texts_ElemPos (Texts_Elem E);
static void Texts_Find (Texts_Text T, INT32 *pos, Texts_Run *u, INT32 *org, INT32 *off);
-static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len);
+static Texts_FontsFont Texts_FontsThis (CHAR *name, ADDRESS name__len);
static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__typ);
export void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
export void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
static void Texts_Load0 (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v);
-export void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
+export void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len);
export void Texts_OpenBuf (Texts_Buffer B);
export void Texts_OpenReader (Texts_Reader *R, ADDRESS *R__typ, Texts_Text T, INT32 pos);
export void Texts_OpenScanner (Texts_Scanner *S, ADDRESS *S__typ, Texts_Text T, INT32 pos);
@@ -229,10 +229,10 @@ export void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x
export void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
export void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
export void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
-export void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
+export void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len);
-static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len)
+static Texts_FontsFont Texts_FontsThis (CHAR *name, ADDRESS name__len)
{
Texts_FontsFont F = NIL;
__NEW(F, Texts_FontDesc);
@@ -390,27 +390,27 @@ static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__t
if (__IS(msg__typ, Texts_CopyMsg, 1)) {
Texts_CopyMsg *msg__ = (void*)msg;
__NEW(e, Texts__1);
- Texts_CopyElem((void*)((Texts_Alien)E), (void*)e);
- e->file = ((Texts_Alien)E)->file;
- e->org = ((Texts_Alien)E)->org;
- e->span = ((Texts_Alien)E)->span;
- __COPY(((Texts_Alien)E)->mod, e->mod, 32);
- __COPY(((Texts_Alien)E)->proc, e->proc, 32);
+ Texts_CopyElem((void*)(*(Texts_Alien*)&E), (void*)e);
+ e->file = (*(Texts_Alien*)&E)->file;
+ e->org = (*(Texts_Alien*)&E)->org;
+ e->span = (*(Texts_Alien*)&E)->span;
+ __MOVE((*(Texts_Alien*)&E)->mod, e->mod, 32);
+ __MOVE((*(Texts_Alien*)&E)->proc, e->proc, 32);
(*msg__).e = (Texts_Elem)e;
} else __WITHCHK;
} else if (__IS(msg__typ, Texts_IdentifyMsg, 1)) {
if (__IS(msg__typ, Texts_IdentifyMsg, 1)) {
Texts_IdentifyMsg *msg__ = (void*)msg;
- __COPY(((Texts_Alien)E)->mod, (*msg__).mod, 32);
- __COPY(((Texts_Alien)E)->proc, (*msg__).proc, 32);
+ __COPY((*(Texts_Alien*)&E)->mod, (*msg__).mod, 32);
+ __COPY((*(Texts_Alien*)&E)->proc, (*msg__).proc, 32);
(*msg__).mod[31] = 0x01;
} else __WITHCHK;
} else if (__IS(msg__typ, Texts_FileMsg, 1)) {
if (__IS(msg__typ, Texts_FileMsg, 1)) {
Texts_FileMsg *msg__ = (void*)msg;
if ((*msg__).id == 1) {
- Files_Set(&r, Files_Rider__typ, ((Texts_Alien)E)->file, ((Texts_Alien)E)->org);
- i = ((Texts_Alien)E)->span;
+ Files_Set(&r, Files_Rider__typ, (*(Texts_Alien*)&E)->file, (*(Texts_Alien*)&E)->org);
+ i = (*(Texts_Alien*)&E)->span;
while (i > 0) {
Files_Read(&r, Files_Rider__typ, (void*)&ch);
Files_Write(&(*msg__).r, Files_Rider__typ, ch);
@@ -646,7 +646,7 @@ void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch)
u = u->next;
if (__ISP(u, Texts_PieceDesc, 1)) {
if (__ISP(u, Texts_PieceDesc, 1)) {
- Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
+ Files_Set(&(*R).rider, Files_Rider__typ, (*(Texts_Piece*)&u)->file, (*(Texts_Piece*)&u)->org);
} else __WITHCHK;
}
(*R).run = u;
@@ -673,7 +673,7 @@ void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ)
(*R).elem = __GUARDP(u, Texts_ElemDesc, 1);
if (__ISP(un, Texts_PieceDesc, 1)) {
if (__ISP(un, Texts_PieceDesc, 1)) {
- Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)un)->file, ((Texts_Piece)un)->org);
+ Files_Set(&(*R).rider, Files_Rider__typ, (*(Texts_Piece*)&un)->file, (*(Texts_Piece*)&un)->org);
} else __WITHCHK;
}
} else {
@@ -812,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;
}
@@ -1027,7 +1027,7 @@ void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ)
Texts_Write(&*W, W__typ, 0x0d);
}
-void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len)
+void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
@@ -1046,7 +1046,7 @@ void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n)
CHAR a[24];
i = 0;
if (x < 0) {
- if (x == (-9223372036854775807-1)) {
+ if (x == (-9223372036854775807LL-1)) {
Texts_WriteString(&*W, W__typ, (CHAR*)" -9223372036854775808", 22);
return;
} else {
@@ -1057,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));
@@ -1084,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;
@@ -1162,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));
}
}
@@ -1313,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 {
@@ -1344,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));
}
}
@@ -1374,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)
@@ -1406,8 +1406,8 @@ static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span
static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span, Texts_Elem *e)
{
- Modules_Module M = NIL;
- Modules_Command Cmd;
+ Heap_Module M = NIL;
+ Heap_Command Cmd;
Texts_Alien a = NIL;
INT32 org, ew, eh;
INT8 eno;
@@ -1539,7 +1539,7 @@ void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
Texts_Load0(&*r, r__typ, T);
}
-void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len)
+void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
Files_Rider r;
@@ -1715,9 +1715,9 @@ void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
while (u != T->head) {
if (__ISP(u, Texts_PieceDesc, 1)) {
if (__ISP(u, Texts_PieceDesc, 1)) {
- if (((Texts_Piece)u)->ascii) {
- Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
- delta = ((Texts_Piece)u)->len;
+ if ((*(Texts_Piece*)&u)->ascii) {
+ Files_Set(&r1, Files_Rider__typ, (*(Texts_Piece*)&u)->file, (*(Texts_Piece*)&u)->org);
+ delta = (*(Texts_Piece*)&u)->len;
while (delta > 0) {
Files_Read(&r1, Files_Rider__typ, (void*)&ch);
delta -= 1;
@@ -1728,8 +1728,8 @@ void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
}
}
} else {
- Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
- delta = ((Texts_Piece)u)->len;
+ Files_Set(&r1, Files_Rider__typ, (*(Texts_Piece*)&u)->file, (*(Texts_Piece*)&u)->org);
+ delta = (*(Texts_Piece*)&u)->len;
while (delta > 1024) {
Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, 1024, 1024);
Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, 1024, 1024);
@@ -1755,7 +1755,7 @@ void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
Store__39_s = _s.lnk;
}
-void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len)
+void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
Files_Rider r;
diff --git a/bootstrap/unix-44/Texts.h b/bootstrap/unix-44/Texts.h
index 0d5201cb..dc569fa9 100644
--- a/bootstrap/unix-44/Texts.h
+++ b/bootstrap/unix-44/Texts.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -130,7 +130,7 @@ import ADDRESS *Texts_Writer__typ;
import void Texts_Append (Texts_Text T, Texts_Buffer B);
import void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
-import void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
+import void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len);
import void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
import void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
import void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
@@ -138,7 +138,7 @@ import Texts_Text Texts_ElemBase (Texts_Elem E);
import INT32 Texts_ElemPos (Texts_Elem E);
import void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
import void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
-import void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
+import void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len);
import void Texts_OpenBuf (Texts_Buffer B);
import void Texts_OpenReader (Texts_Reader *R, ADDRESS *R__typ, Texts_Text T, INT32 pos);
import void Texts_OpenScanner (Texts_Scanner *S, ADDRESS *S__typ, Texts_Text T, INT32 pos);
@@ -165,7 +165,7 @@ import void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x
import void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
import void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
import void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
-import void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
+import void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len);
import void *Texts__init(void);
diff --git a/bootstrap/unix-44/VT100.c b/bootstrap/unix-44/VT100.c
index f69fd90e..346fb37b 100644
--- a/bootstrap/unix-44/VT100.c
+++ b/bootstrap/unix-44/VT100.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -27,23 +27,24 @@ export void VT100_DECTCEMl (void);
export void VT100_DSR (INT16 n);
export void VT100_ED (INT16 n);
export void VT100_EL (INT16 n);
-static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len);
-static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len);
-static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len);
-static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len);
+static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len);
+static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len);
+static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len);
+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, LONGINT str__len);
+export void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len);
export void VT100_RCP (void);
-static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end);
+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);
export void VT100_SGR (INT16 n);
export void VT100_SGR2 (INT16 n, INT16 m);
export void VT100_SU (INT16 n);
-export void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
+export void VT100_SetAttr (CHAR *attr, ADDRESS attr__len);
-static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end)
+static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end)
{
CHAR h;
while (start < end) {
@@ -55,7 +56,7 @@ static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end)
}
}
-void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
+void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len)
{
CHAR b[21];
INT16 s, e;
@@ -74,7 +75,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT 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));
@@ -84,7 +85,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
__COPY(b, str, str__len);
}
-static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len)
+static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len)
{
CHAR cmd[9];
__DUP(letter, letter__len, CHAR);
@@ -94,7 +95,7 @@ static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len)
__DEL(letter);
}
-static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len)
+static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len)
{
CHAR nstr[2];
CHAR cmd[7];
@@ -107,7 +108,7 @@ static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len)
__DEL(letter);
}
-static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len)
+static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len)
{
CHAR nstr[2];
CHAR cmd[7];
@@ -120,7 +121,7 @@ static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len)
__DEL(letter);
}
-static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len)
+static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len)
{
CHAR nstr[5], mstr[5];
CHAR cmd[12];
@@ -136,6 +137,15 @@ static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT 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);
@@ -236,7 +246,7 @@ void VT100_DECTCEMh (void)
VT100_EscSeq0((CHAR*)"\?25h", 5);
}
-void VT100_SetAttr (CHAR *attr, LONGINT attr__len)
+void VT100_SetAttr (CHAR *attr, ADDRESS attr__len)
{
CHAR tmpstr[16];
__DUP(attr, attr__len, CHAR);
@@ -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 d99406ec..4e708647 100644
--- a/bootstrap/unix-44/VT100.h
+++ b/bootstrap/unix-44/VT100.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -23,14 +23,15 @@ import void VT100_DSR (INT16 n);
import void VT100_ED (INT16 n);
import void VT100_EL (INT16 n);
import void VT100_HVP (INT16 n, INT16 m);
-import void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len);
+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);
import void VT100_SGR2 (INT16 n, INT16 m);
import void VT100_SU (INT16 n);
-import void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
+import void VT100_SetAttr (CHAR *attr, ADDRESS attr__len);
import void *VT100__init(void);
diff --git a/bootstrap/unix-44/extTools.c b/bootstrap/unix-44/extTools.c
index 37630d23..ce2fc413 100644
--- a/bootstrap/unix-44/extTools.c
+++ b/bootstrap/unix-44/extTools.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,33 +7,40 @@
#include "SYSTEM.h"
#include "Configuration.h"
+#include "Heap.h"
#include "Modules.h"
#include "OPM.h"
#include "Out.h"
#include "Platform.h"
#include "Strings.h"
-
-static CHAR extTools_CFLAGS[1023];
+typedef
+ CHAR extTools_CommandString[4096];
-export void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len);
-static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT s__len);
-export void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len);
-static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len);
+static extTools_CommandString extTools_CFLAGS;
-static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len)
+export void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__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);
+
+
+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, LONGINT title__len, CHAR *cmd, LONGIN
__DEL(cmd);
}
-static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT 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, LONGINT moduleName__len)
+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*)"Assemble: ", 11, 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, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len)
+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", 8, (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((CHAR*)"", 1, (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*)"Assemble and link: ", 20, 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 63e5df15..686f0b4e 100644
--- a/bootstrap/unix-44/extTools.h
+++ b/bootstrap/unix-44/extTools.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -8,8 +8,8 @@
-import void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len);
-import void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len);
+import void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len);
+import void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len);
import void *extTools__init(void);
diff --git a/bootstrap/unix-48/Compiler.c b/bootstrap/unix-48/Compiler.c
index dc4bb660..4460479d 100644
--- a/bootstrap/unix-48/Compiler.c
+++ b/bootstrap/unix-48/Compiler.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -20,9 +20,9 @@
#include "extTools.h"
-static CHAR Compiler_mname[256];
+static void Compiler_FindLocalObjectFiles (CHAR *objectnames, ADDRESS objectnames__len);
export void Compiler_Module (BOOLEAN *done);
static void Compiler_PropagateElementaryTypeSizes (void);
export void Compiler_Translate (void);
@@ -41,11 +41,12 @@ void Compiler_Module (BOOLEAN *done)
OPT_Export(&ext, &new);
if (OPM_noerr) {
OPM_OpenFiles((void*)OPT_SelfName, 256);
+ OPM_DeleteObj((void*)OPT_SelfName, 256);
OPC_Init();
OPV_Module(p);
if (OPM_noerr) {
if ((__IN(10, OPM_Options, 32) && __STRCMP(OPM_modName, "SYSTEM") != 0)) {
- OPM_DeleteNewSym();
+ OPM_DeleteSym((void*)OPT_SelfName, 256);
OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogWStr((CHAR*)" Main program.", 16);
OPM_LogVT100((CHAR*)"0m", 3);
@@ -61,7 +62,7 @@ void Compiler_Module (BOOLEAN *done)
}
}
} else {
- OPM_DeleteNewSym();
+ OPM_DeleteSym((void*)OPT_SelfName, 256);
}
}
}
@@ -88,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;
@@ -104,14 +105,44 @@ static void Compiler_PropagateElementaryTypeSizes (void)
}
}
+static void Compiler_FindLocalObjectFiles (CHAR *objectnames, ADDRESS objectnames__len)
+{
+ OPT_Link l = NIL;
+ CHAR fn[64];
+ Platform_FileIdentity id;
+ objectnames[0] = 0x00;
+ l = OPT_Links;
+ while (l != NIL) {
+ __COPY(l->name, fn, 64);
+ Strings_Append((CHAR*)".sym", 5, (void*)fn, 64);
+ if (Platform_IdentifyByName(fn, 64, &id, Platform_FileIdentity__typ) == 0) {
+ __COPY(l->name, fn, 64);
+ Strings_Append((CHAR*)".o", 3, (void*)fn, 64);
+ if (Platform_IdentifyByName(fn, 64, &id, Platform_FileIdentity__typ) == 0) {
+ Strings_Append((CHAR*)" ", 2, (void*)objectnames, objectnames__len);
+ Strings_Append(fn, 64, (void*)objectnames, objectnames__len);
+ } else {
+ OPM_LogVT100((CHAR*)"91m", 4);
+ OPM_LogWStr((CHAR*)"Link warning: a local symbol file is present for module ", 57);
+ OPM_LogWStr(l->name, 256);
+ OPM_LogWStr((CHAR*)", but local object file '", 26);
+ OPM_LogWStr(fn, 64);
+ OPM_LogWStr((CHAR*)"' is missing.", 14);
+ OPM_LogVT100((CHAR*)"0m", 3);
+ OPM_LogWLn();
+ }
+ }
+ l = l->next;
+ }
+}
+
void Compiler_Translate (void)
{
BOOLEAN done;
- CHAR modulesobj[2048];
- modulesobj[0] = 0x00;
+ CHAR linkfiles[2048];
if (OPM_OpenPar()) {
for (;;) {
- OPM_Init(&done, (void*)Compiler_mname, 256);
+ OPM_Init(&done);
if (!done) {
return;
}
@@ -131,11 +162,9 @@ void Compiler_Translate (void)
} else {
if (!__IN(10, OPM_Options, 32)) {
extTools_Assemble(OPM_modName, 32);
- Strings_Append((CHAR*)" ", 2, (void*)modulesobj, 2048);
- Strings_Append(OPM_modName, 32, (void*)modulesobj, 2048);
- Strings_Append((CHAR*)".o", 3, (void*)modulesobj, 2048);
} else {
- extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), modulesobj, 2048);
+ Compiler_FindLocalObjectFiles((void*)linkfiles, 2048);
+ extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), linkfiles, 2048);
}
}
}
diff --git a/bootstrap/unix-48/Configuration.c b/bootstrap/unix-48/Configuration.c
index 2d0061df..fa87c9de 100644
--- a/bootstrap/unix-48/Configuration.c
+++ b/bootstrap/unix-48/Configuration.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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("1.95 [2016/11/24]. 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 b28e0caa..c3c54eed 100644
--- a/bootstrap/unix-48/Configuration.h
+++ b/bootstrap/unix-48/Configuration.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 548774b0..54341368 100644
--- a/bootstrap/unix-48/Files.c
+++ b/bootstrap/unix-48/Files.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 {
@@ -36,7 +36,7 @@ typedef
INT32 fd, len, pos;
Files_Buffer bufs[4];
INT16 swapper, state;
- Files_File next;
+ struct Files_FileDesc *next;
} Files_FileDesc;
typedef
@@ -48,11 +48,12 @@ typedef
} Files_Rider;
-static Files_File Files_files;
+export INT16 Files_MaxPathLength, Files_MaxNameLength;
+static Files_FileDesc *Files_files;
static INT16 Files_tempno;
static CHAR Files_HOME[1024];
static struct {
- LONGINT len[1];
+ ADDRESS len[1];
CHAR data[1];
} *Files_SearchPath;
@@ -60,58 +61,68 @@ export ADDRESS *Files_FileDesc__typ;
export ADDRESS *Files_BufDesc__typ;
export ADDRESS *Files_Rider__typ;
+static void Files_Assert (BOOLEAN truth);
export Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
static Files_File Files_CacheEntry (Platform_FileIdentity identity);
-export void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
+export void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res);
export void Files_Close (Files_File f);
static void Files_CloseOSFile (Files_File f);
static void Files_Create (Files_File f);
-export void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res);
-static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode);
+export void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res);
+static void Files_Deregister (CHAR *name, ADDRESS name__len);
+static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode);
static void Files_Finalize (SYSTEM_PTR o);
-static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len);
+static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len);
static void Files_Flush (Files_Buffer buf);
export void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
-export void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
-static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len);
-static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len);
+export void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len);
+static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len);
+static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len);
export INT32 Files_Length (Files_File f);
-static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len);
-export Files_File Files_New (CHAR *name, LONGINT name__len);
-export Files_File Files_Old (CHAR *name, LONGINT name__len);
+static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len);
+export Files_File Files_New (CHAR *name, ADDRESS name__len);
+export Files_File Files_Old (CHAR *name, ADDRESS name__len);
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_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+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);
export void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
-export void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
-export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
+export void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
+export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
export void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
export void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
-export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
export void Files_Register (Files_File f);
-export void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res);
-static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len);
+export void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res);
+static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len);
export void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos);
-export void Files_SetSearchPath (CHAR *path, LONGINT path__len);
+export void Files_SetSearchPath (CHAR *path, ADDRESS path__len);
export void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
export void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
-export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
export void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
export void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
export void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
export void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
export void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
export void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
-export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
#define Files_IdxTrap() __HALT(-1)
-#define Files_ToAdr(x) (ADDRESS)x
-static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
+static void Files_Assert (BOOLEAN truth)
+{
+ if (!truth) {
+ Out_Ln();
+ __ASSERT(truth, 0);
+ }
+}
+
+static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
{
__DUP(s, s__len, CHAR);
Out_Ln();
@@ -120,17 +131,17 @@ static void Files_Err (CHAR *s, LONGINT 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();
@@ -138,98 +149,125 @@ static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
__DEL(s);
}
-static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len)
+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, LONGINT finalName__len, CHAR *name, LONGINT name__len)
+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);
}
+static void Files_Deregister (CHAR *name, ADDRESS name__len)
+{
+ Platform_FileIdentity identity;
+ Files_File osfile = NIL;
+ INT16 error;
+ __DUP(name, name__len, CHAR);
+ if (Platform_IdentifyByName(name, name__len, &identity, Platform_FileIdentity__typ) == 0) {
+ osfile = (Files_File)Files_files;
+ while ((osfile != NIL && !Platform_SameFile(osfile->identity, identity))) {
+ osfile = (Files_File)osfile->next;
+ }
+ if (osfile != NIL) {
+ __ASSERT(!osfile->tempFile, 0);
+ __ASSERT(osfile->fd >= 0, 0);
+ __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, 256, (void*)osfile->workName, 256);
+ if (error != 0) {
+ Files_Err((CHAR*)"Couldn't rename previous version of file being registered", 58, osfile, error);
+ }
+ }
+ }
+ __DEL(name);
+}
+
static void Files_Create (Files_File f)
{
- Platform_FileIdentity identity;
BOOLEAN done;
INT16 error;
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 if (f->state == 2) {
- __COPY(f->registerName, f->workName, 101);
+ } else {
+ __ASSERT(f->state == 2, 0);
+ 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;
@@ -275,27 +313,6 @@ static void Files_Flush (Files_Buffer buf)
}
}
-static void Files_CloseOSFile (Files_File f)
-{
- Files_File prev = NIL;
- INT16 error;
- if (Files_files == f) {
- Files_files = f->next;
- } else {
- prev = Files_files;
- while ((prev != NIL && prev->next != f)) {
- prev = prev->next;
- }
- if (prev->next != NIL) {
- prev->next = f->next;
- }
- }
- error = Platform_Close(f->fd);
- f->fd = -1;
- f->state = 1;
- Heap_FileCount -= 1;
-}
-
void Files_Close (Files_File f)
{
INT32 i;
@@ -303,11 +320,10 @@ 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;
}
- Files_CloseOSFile(f);
}
}
@@ -316,13 +332,13 @@ INT32 Files_Length (Files_File f)
return f->len;
}
-Files_File Files_New (CHAR *name, LONGINT name__len)
+Files_File Files_New (CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
__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;
@@ -332,7 +348,7 @@ Files_File Files_New (CHAR *name, LONGINT name__len)
return f;
}
-static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len)
+static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len)
{
INT16 i;
CHAR ch;
@@ -344,38 +360,38 @@ static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT 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, LONGINT name__len)
+static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@@ -383,7 +399,7 @@ static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
ch = name[0];
while ((ch != 0x00 && ch != '/')) {
i += 1;
- ch = name[i];
+ ch = name[__X(i, name__len)];
}
return ch == '/';
}
@@ -392,15 +408,15 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
{
Files_File f = NIL;
INT16 i, error;
- f = Files_files;
+ f = (Files_File)Files_files;
while (f != NIL) {
if (Platform_SameFile(identity, f->identity)) {
if (!Platform_SameFileTime(identity, f->identity)) {
i = 0;
while (i < 4) {
- if (f->bufs[i] != NIL) {
- f->bufs[i]->org = -1;
- f->bufs[i] = NIL;
+ if (f->bufs[__X(i, 4)] != NIL) {
+ f->bufs[__X(i, 4)]->org = -1;
+ f->bufs[__X(i, 4)] = NIL;
}
i += 1;
}
@@ -410,12 +426,12 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
}
return f;
}
- f = f->next;
+ f = (Files_File)f->next;
}
return NIL;
}
-Files_File Files_Old (CHAR *name, LONGINT name__len)
+Files_File Files_Old (CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
INT32 fd;
@@ -456,6 +472,7 @@ Files_File Files_Old (CHAR *name, LONGINT name__len)
error = Platform_Identify(fd, &identity, Platform_FileIdentity__typ);
f = Files_CacheEntry(identity);
if (f != NIL) {
+ error = Platform_Close(fd);
__DEL(name);
return f;
} else {
@@ -466,7 +483,7 @@ Files_File Files_Old (CHAR *name, LONGINT 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;
@@ -498,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;
}
@@ -526,7 +543,7 @@ void Files_GetDate (Files_File f, INT32 *t, INT32 *d)
INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ)
{
- __ASSERT((*r).offset <= 4096, 0);
+ Files_Assert((*r).offset <= 4096);
return (*r).org + (*r).offset;
}
@@ -544,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) {
@@ -585,7 +602,7 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
org = 0;
offset = 0;
}
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
(*r).buf = buf;
(*r).org = org;
(*r).offset = offset;
@@ -604,9 +621,9 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
buf = (*r).buf;
offset = (*r).offset;
}
- __ASSERT(offset <= buf->size, 0);
+ 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);
@@ -618,7 +635,12 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
}
}
-void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
+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;
Files_Buffer buf = NIL;
@@ -644,12 +666,12 @@ void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x
} else {
min = n;
}
- __MOVE((ADDRESS)buf->data + Files_ToAdr(offset), (ADDRESS)x + Files_ToAdr(xpos), min);
+ __MOVE((ADDRESS)&buf->data[__X(offset, 4096)], (ADDRESS)&x[__X(xpos, x__len)], min);
offset += min;
(*r).offset = offset;
xpos += min;
n -= min;
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
}
(*r).res = 0;
(*r).eof = 0;
@@ -666,14 +688,14 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
INT32 offset;
buf = (*r).buf;
offset = (*r).offset;
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
- __ASSERT(offset < 4096, 0);
- buf->data[offset] = x;
+ Files_Assert(offset < 4096);
+ buf->data[__X(offset, 4096)] = x;
buf->chg = 1;
if (offset == buf->size) {
buf->size += 1;
@@ -683,7 +705,7 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
(*r).res = 0;
}
-void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
+void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n)
{
INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
@@ -694,23 +716,23 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT
buf = (*r).buf;
offset = (*r).offset;
while (n > 0) {
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
restInBuf = 4096 - offset;
if (n > restInBuf) {
min = restInBuf;
} else {
min = n;
}
- __MOVE((ADDRESS)x + Files_ToAdr(xpos), (ADDRESS)buf->data + Files_ToAdr(offset), min);
+ __MOVE((ADDRESS)&x[__X(xpos, x__len)], (ADDRESS)&buf->data[__X(offset, 4096)], min);
offset += min;
(*r).offset = offset;
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
if (offset > buf->size) {
buf->f->len += offset - buf->size;
buf->size = offset;
@@ -722,14 +744,15 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT
(*r).res = 0;
}
-void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res)
+void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res)
{
__DUP(name, name__len, CHAR);
+ Files_Deregister(name, name__len);
*res = Platform_Unlink((void*)name, name__len);
__DEL(name);
}
-void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res)
+void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res)
{
INT32 fdold, fdnew, n;
INT16 error, ignore;
@@ -795,31 +818,30 @@ void Files_Register (Files_File f)
{
INT16 idx, errcode;
Files_File f1 = NIL;
- CHAR file[104];
if ((f->state == 1 && f->registerName[0] != 0x00)) {
f->state = 2;
}
Files_Close(f);
if (f->registerName[0] != 0x00) {
- Files_Rename(f->workName, 101, f->registerName, 101, &errcode);
+ Files_Deregister(f->registerName, 256);
+ Files_Rename(f->workName, 256, f->registerName, 256, &errcode);
if (errcode != 0) {
- __COPY(f->registerName, file, 104);
- __HALT(99);
+ Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode);
}
- __COPY(f->registerName, f->workName, 101);
+ __MOVE(f->registerName, f->workName, 256);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
}
-void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res)
+void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res)
{
__DUP(path, path__len, CHAR);
*res = Platform_Chdir((void*)path, path__len);
__DEL(path);
}
-static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len)
+static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len)
{
INT32 i, j;
if (!Platform_LittleEndian) {
@@ -827,7 +849,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT 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 {
@@ -877,36 +899,36 @@ void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x)
Files_FlipBytes((void*)b, 8, (void*)&*x, 8);
}
-void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
+void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
{
INT16 i;
CHAR ch;
i = 0;
do {
Files_Read(&*R, R__typ, (void*)&ch);
- x[i] = ch;
+ x[__X(i, x__len)] = ch;
i += 1;
} while (!(ch == 0x00));
}
-void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
+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, LONGINT x__len)
+void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len)
{
INT8 s, b;
INT64 q;
@@ -919,7 +941,7 @@ void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__
Files_Read(&*R, R__typ, (void*)&b);
}
q += (INT64)__ASH((__MASK(b, -64) - __ASHL(__ASHR(b, 6), 6)), s);
- __ASSERT(x__len <= 8, 0);
+ Files_Assert(x__len <= 8);
__MOVE((ADDRESS)&q, (ADDRESS)x, x__len);
}
@@ -931,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);
}
@@ -950,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);
}
@@ -972,11 +996,11 @@ void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x)
Files_WriteBytes(&*R, R__typ, (void*)b, 8, 8);
}
-void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
+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);
@@ -985,17 +1009,38 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT 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, LONGINT name__len)
+void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len)
{
__COPY(f->workName, name, name__len);
}
+static void Files_CloseOSFile (Files_File f)
+{
+ Files_File prev = NIL;
+ INT16 error;
+ if (Files_files == (void *) f) {
+ Files_files = f->next;
+ } else {
+ prev = (Files_File)Files_files;
+ while ((prev != NIL && prev->next != (void *) f)) {
+ prev = (Files_File)prev->next;
+ }
+ if (prev->next != NIL) {
+ prev->next = f->next;
+ }
+ }
+ error = Platform_Close(f->fd);
+ f->fd = -1;
+ f->state = 1;
+ Heap_FileCount -= 1;
+}
+
static void Files_Finalize (SYSTEM_PTR o)
{
Files_File f = NIL;
@@ -1004,12 +1049,12 @@ 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);
}
}
}
-void Files_SetSearchPath (CHAR *path, LONGINT path__len)
+void Files_SetSearchPath (CHAR *path, ADDRESS path__len)
{
__DUP(path, path__len, CHAR);
if (Strings_Length(path, path__len) != 0) {
@@ -1023,11 +1068,10 @@ void Files_SetSearchPath (CHAR *path, LONGINT path__len)
static void EnumPtrs(void (*P)(void*))
{
- P(Files_files);
P(Files_SearchPath);
}
-__TDESC(Files_FileDesc, 1, 5) = {__TDFLDS("FileDesc", 252), {228, 232, 236, 240, 248, -24}};
+__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}};
@@ -1047,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 79164af5..ccdabcc2 100644
--- a/bootstrap/unix-48/Files.h
+++ b/bootstrap/unix-48/Files.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -10,9 +10,8 @@ typedef
typedef
struct Files_FileDesc {
- char _prvt0[216];
- INT32 fd;
- char _prvt1[32];
+ INT32 _prvt0;
+ char _prvt1[560];
} Files_FileDesc;
typedef
@@ -23,46 +22,48 @@ typedef
} Files_Rider;
+import INT16 Files_MaxPathLength, Files_MaxNameLength;
import ADDRESS *Files_FileDesc__typ;
import ADDRESS *Files_Rider__typ;
import Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
-import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
+import void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res);
import void Files_Close (Files_File f);
-import void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res);
+import void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res);
import void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
-import void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
+import void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len);
import INT32 Files_Length (Files_File f);
-import Files_File Files_New (CHAR *name, LONGINT name__len);
-import Files_File Files_Old (CHAR *name, LONGINT name__len);
+import Files_File Files_New (CHAR *name, ADDRESS name__len);
+import Files_File Files_Old (CHAR *name, ADDRESS name__len);
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_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+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);
import void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
-import void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
-import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
+import void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
+import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
import void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
import void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
-import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
import void Files_Register (Files_File f);
-import void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res);
+import void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res);
import void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos);
-import void Files_SetSearchPath (CHAR *path, LONGINT path__len);
+import void Files_SetSearchPath (CHAR *path, ADDRESS path__len);
import void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
import void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
-import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
import void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
import void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
import void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
import void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
import void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
import void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
-import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
import void *Files__init(void);
diff --git a/bootstrap/unix-48/Heap.c b/bootstrap/unix-48/Heap.c
index 72677604..42552415 100644
--- a/bootstrap/unix-48/Heap.c
+++ b/bootstrap/unix-48/Heap.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,8 +68,10 @@ static INT32 Heap_freeList[10];
static INT32 Heap_bigBlocks;
export INT32 Heap_allocated;
static BOOLEAN Heap_firstTry;
-static INT32 Heap_heap, Heap_heapend;
-export INT32 Heap_heapsize;
+static INT16 Heap_ldUnit;
+export INT32 Heap_heap;
+static INT32 Heap_heapMin, Heap_heapMax;
+export INT32 Heap_heapsize, Heap_heapMinExpand;
static Heap_FinNode Heap_fin;
static INT16 Heap_lockdepth;
static BOOLEAN Heap_interrupted;
@@ -84,15 +86,16 @@ static void Heap_CheckFin (void);
static void Heap_ExtendHeap (INT32 blksz);
export void Heap_FINALL (void);
static void Heap_Finalize (void);
+export INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len);
export void Heap_GC (BOOLEAN markStack);
-static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len);
+static void Heap_HeapSort (INT32 n, INT32 *a, ADDRESS a__len);
export void Heap_INCREF (Heap_Module m);
export void Heap_InitHeap (void);
export void Heap_Lock (void);
static void Heap_Mark (INT32 q);
-static void Heap_MarkCandidates (INT32 n, INT32 *cand, LONGINT cand__len);
+static void Heap_MarkCandidates (INT32 n, INT32 *cand, ADDRESS cand__len);
static void Heap_MarkP (SYSTEM_PTR p);
-static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len);
+static void Heap_MarkStack (INT32 n, INT32 *cand, ADDRESS cand__len);
export SYSTEM_PTR Heap_NEWBLK (INT32 size);
export SYSTEM_PTR Heap_NEWREC (INT32 tag);
static INT32 Heap_NewChunk (INT32 blksz);
@@ -101,16 +104,18 @@ export SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs);
export void Heap_REGTYP (Heap_Module m, INT32 typ);
export void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize);
static void Heap_Scan (void);
-static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len);
+static void Heap_Sift (INT32 l, INT32 r, INT32 *a, ADDRESS a__len);
export void Heap_Unlock (void);
extern void *Heap__init();
-extern ADDRESS Platform_MainStackFrame;
+extern ADDRESS Modules_MainStackFrame;
extern ADDRESS Platform_OSAllocate(ADDRESS size);
#define Heap_HeapModuleInit() Heap__init()
#define Heap_ModulesHalt(code) Modules_Halt(code)
+#define Heap_ModulesMainStackFrame() Modules_MainStackFrame
#define Heap_OSAllocate(size) Platform_OSAllocate(size)
-#define Heap_PlatformMainStackFrame() Platform_MainStackFrame
+#define Heap_uLE(x, y) ((size_t)x <= (size_t)y)
+#define Heap_uLT(x, y) ((size_t)x < (size_t)y)
void Heap_Lock (void)
{
@@ -143,6 +148,35 @@ SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
return (void*)m;
}
+INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len)
+{
+ Heap_Module m, p;
+ __DUP(name, name__len, CHAR);
+ m = (Heap_Module)(ADDRESS)Heap_modules;
+ while ((m != NIL && __STRCMP(m->name, name) != 0)) {
+ p = m;
+ m = m->next;
+ }
+ if ((m != NIL && m->refcnt == 0)) {
+ if (m == (Heap_Module)(ADDRESS)Heap_modules) {
+ Heap_modules = (SYSTEM_PTR)m->next;
+ } else {
+ p->next = m->next;
+ }
+ __DEL(name);
+ return 0;
+ } else {
+ if (m == NIL) {
+ __DEL(name);
+ return -1;
+ } else {
+ __DEL(name);
+ return m->refcnt;
+ }
+ }
+ __RETCHK;
+}
+
void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd)
{
Heap_Cmd c;
@@ -170,16 +204,24 @@ void Heap_INCREF (Heap_Module m)
static INT32 Heap_NewChunk (INT32 blksz)
{
- INT32 chnk;
+ INT32 chnk, blk, end;
chnk = Heap_OSAllocate(blksz + 12);
if (chnk != 0) {
- __PUT(chnk + 4, chnk + (12 + blksz), INT32);
- __PUT(chnk + 12, chnk + 16, INT32);
- __PUT(chnk + 16, blksz, INT32);
- __PUT(chnk + 20, -4, INT32);
- __PUT(chnk + 24, Heap_bigBlocks, INT32);
- Heap_bigBlocks = chnk + 12;
+ blk = chnk + 12;
+ end = blk + blksz;
+ __PUT(chnk + 4, end, INT32);
+ __PUT(blk, blk + 4, INT32);
+ __PUT(blk + 4, blksz, INT32);
+ __PUT(blk + 8, -4, INT32);
+ __PUT(blk + 12, Heap_bigBlocks, INT32);
+ Heap_bigBlocks = blk;
Heap_heapsize += blksz;
+ if (Heap_uLT(blk + 4, Heap_heapMin)) {
+ Heap_heapMin = blk + 4;
+ }
+ if (Heap_uLT(Heap_heapMax, end)) {
+ Heap_heapMax = end;
+ }
}
return chnk;
}
@@ -187,29 +229,28 @@ static INT32 Heap_NewChunk (INT32 blksz)
static void Heap_ExtendHeap (INT32 blksz)
{
INT32 size, chnk, j, next;
- if (blksz > 160000) {
+ if (Heap_uLT(Heap_heapMinExpand, blksz)) {
size = blksz;
} else {
- size = 160000;
+ size = Heap_heapMinExpand;
}
chnk = Heap_NewChunk(size);
if (chnk != 0) {
- if (chnk < Heap_heap) {
+ if (Heap_uLT(chnk, Heap_heap)) {
__PUT(chnk, Heap_heap, INT32);
Heap_heap = chnk;
} else {
j = Heap_heap;
__GET(j, next, INT32);
- while ((next != 0 && chnk > next)) {
+ while ((next != 0 && Heap_uLT(next, chnk))) {
j = next;
__GET(j, next, INT32);
}
__PUT(chnk, next, INT32);
__PUT(j, chnk, INT32);
}
- if (next == 0) {
- __GET(chnk + 4, Heap_heapend, INT32);
- }
+ } else if (!Heap_firstTry) {
+ Heap_heapMinExpand = 16;
}
}
@@ -219,7 +260,7 @@ 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 (i < 9) {
adr = Heap_freeList[i];
@@ -251,16 +292,17 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
if (Heap_firstTry) {
Heap_GC(1);
blksz += 16;
- if (__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2) < Heap_heapsize) {
- Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize);
+ 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 {
@@ -269,7 +311,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
}
}
__GET(adr + 4, t, INT32);
- if (t >= blksz) {
+ if (Heap_uLE(blksz, t)) {
break;
}
prev = adr;
@@ -280,7 +322,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
__PUT(end + 4, blksz, INT32);
__PUT(end + 8, -4, INT32);
__PUT(end, end + 4, INT32);
- if (restsize > 144) {
+ if (Heap_uLT(144, restsize)) {
__PUT(adr + 4, restsize, INT32);
} else {
__GET(adr + 12, next, INT32);
@@ -289,7 +331,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
} else {
__PUT(prev + 12, next, INT32);
}
- if (restsize > 0) {
+ if (restsize != 0) {
di = __ASHR(restsize, 4);
__PUT(adr + 4, restsize, INT32);
__PUT(adr + 12, Heap_freeList[di], INT32);
@@ -300,7 +342,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
}
i = adr + 16;
end = adr + blksz;
- while (i < end) {
+ while (Heap_uLT(i, end)) {
__PUT(i, 0, INT32);
__PUT(i + 4, 0, INT32);
__PUT(i + 8, 0, INT32);
@@ -397,17 +439,17 @@ static void Heap_Scan (void)
while (chnk != 0) {
adr = chnk + 12;
__GET(chnk + 4, end, INT32);
- while (adr < end) {
+ while (Heap_uLT(adr, end)) {
__GET(adr, tag, INT32);
if (__ODD(tag)) {
- if (freesize > 0) {
+ if (freesize != 0) {
start = adr - freesize;
__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 (i < 9) {
+ if (Heap_uLT(i, 9)) {
__PUT(start + 12, Heap_freeList[i], INT32);
Heap_freeList[i] = start;
} else {
@@ -426,14 +468,14 @@ static void Heap_Scan (void)
adr += size;
}
}
- if (freesize > 0) {
+ if (freesize != 0) {
start = adr - freesize;
__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 (i < 9) {
+ if (Heap_uLT(i, 9)) {
__PUT(start + 12, Heap_freeList[i], INT32);
Heap_freeList[i] = start;
} else {
@@ -445,18 +487,19 @@ static void Heap_Scan (void)
}
}
-static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len)
+static void Heap_Sift (INT32 l, INT32 r, INT32 *a, ADDRESS a__len)
{
- INT32 i, j, x;
+ INT32 i, j;
+ INT32 x;
j = l;
x = a[j];
for (;;) {
i = j;
j = __ASHL(j, 1) + 1;
- if ((j < r && a[j] < a[j + 1])) {
+ if ((j < r && Heap_uLT(a[j], a[j + 1]))) {
j += 1;
}
- if (j > r || a[j] <= x) {
+ if (j > r || Heap_uLE(a[j], x)) {
break;
}
a[i] = a[j];
@@ -464,9 +507,10 @@ static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len)
a[i] = x;
}
-static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len)
+static void Heap_HeapSort (INT32 n, INT32 *a, ADDRESS a__len)
{
- INT32 l, r, x;
+ INT32 l, r;
+ INT32 x;
l = __ASHR(n, 1);
r = n - 1;
while (l > 0) {
@@ -482,37 +526,42 @@ static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len)
}
}
-static void Heap_MarkCandidates (INT32 n, INT32 *cand, LONGINT cand__len)
+static void Heap_MarkCandidates (INT32 n, INT32 *cand, ADDRESS cand__len)
{
- INT32 chnk, adr, tag, next, lim, lim1, i, ptr, size;
- chnk = Heap_heap;
+ INT32 chnk, end, adr, tag, next, i, ptr, size;
+ chnk = Heap_heap;
i = 0;
- lim = cand[n - 1];
- while ((chnk != 0 && chnk < lim)) {
+ while (chnk != 0) {
+ __GET(chnk + 4, end, INT32);
adr = chnk + 12;
- __GET(chnk + 4, lim1, INT32);
- if (lim < lim1) {
- lim1 = lim;
- }
- while (adr < lim1) {
+ while (Heap_uLT(adr, end)) {
__GET(adr, tag, INT32);
if (__ODD(tag)) {
__GET(tag - 1, size, INT32);
adr += size;
+ ptr = adr + 4;
+ while (Heap_uLT(cand[i], ptr)) {
+ i += 1;
+ if (i == n) {
+ return;
+ }
+ }
} else {
__GET(tag, size, INT32);
ptr = adr + 4;
- while (cand[i] < ptr) {
+ adr += size;
+ while (Heap_uLT(cand[i], ptr)) {
i += 1;
+ if (i == n) {
+ return;
+ }
}
- if (i == n) {
- return;
- }
- next = adr + size;
- if (cand[i] < next) {
+ if (Heap_uLT(cand[i], adr)) {
Heap_Mark(ptr);
}
- adr = next;
+ }
+ if (Heap_uLE(end, cand[i])) {
+ adr = end;
}
}
__GET(chnk, chnk, INT32);
@@ -571,10 +620,11 @@ void Heap_FINALL (void)
}
}
-static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len)
+static void Heap_MarkStack (INT32 n, INT32 *cand, ADDRESS cand__len)
{
SYSTEM_PTR frame;
- INT32 inc, nofcand, sp, p, stack0;
+ INT32 nofcand;
+ INT32 inc, sp, p, stack0;
struct Heap__1 align;
if (n > 0) {
Heap_MarkStack(n - 1, cand, cand__len);
@@ -585,14 +635,14 @@ static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len)
if (n == 0) {
nofcand = 0;
sp = (ADDRESS)&frame;
- stack0 = Heap_PlatformMainStackFrame();
+ stack0 = Heap_ModulesMainStackFrame();
inc = (ADDRESS)&align.p - (ADDRESS)&align;
- if (sp > stack0) {
+ if (Heap_uLT(stack0, sp)) {
inc = -inc;
}
while (sp != stack0) {
__GET(sp, p, INT32);
- if ((p > Heap_heap && p < Heap_heapend)) {
+ if ((Heap_uLE(Heap_heapMin, p) && Heap_uLT(p, Heap_heapMax))) {
if (nofcand == cand__len) {
Heap_HeapSort(nofcand, (void*)cand, cand__len);
Heap_MarkCandidates(nofcand, (void*)cand, cand__len);
@@ -615,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)
@@ -703,17 +751,21 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
void Heap_InitHeap (void)
{
- Heap_heap = Heap_NewChunk(128000);
- __GET(Heap_heap + 4, Heap_heapend, INT32);
- __PUT(Heap_heap, 0, INT32);
+ Heap_heap = 0;
+ Heap_heapsize = 0;
Heap_allocated = 0;
+ Heap_lockdepth = 0;
+ 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;
Heap_freeList[9] = 1;
- Heap_lockdepth = 0;
Heap_FileCount = 0;
Heap_modules = NIL;
- Heap_heapsize = 0;
- Heap_bigBlocks = 0;
Heap_fin = NIL;
Heap_interrupted = 0;
Heap_HeapModuleInit();
diff --git a/bootstrap/unix-48/Heap.h b/bootstrap/unix-48/Heap.h
index 0aa0a18b..3cde1c3b 100644
--- a/bootstrap/unix-48/Heap.h
+++ b/bootstrap/unix-48/Heap.h
@@ -1,16 +1,26 @@
-/* voc 1.95 [2016/11/24]. 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
#include "SYSTEM.h"
+typedef
+ struct Heap_CmdDesc *Heap_Cmd;
+
typedef
CHAR Heap_CmdName[24];
typedef
void (*Heap_Command)(void);
+typedef
+ struct Heap_CmdDesc {
+ Heap_Cmd next;
+ Heap_CmdName name;
+ Heap_Command cmd;
+ } Heap_CmdDesc;
+
typedef
void (*Heap_EnumProc)(void(*)(SYSTEM_PTR));
@@ -21,22 +31,31 @@ typedef
struct Heap_ModuleDesc *Heap_Module;
typedef
- struct Heap_ModuleDesc {
- INT32 _prvt0;
- char _prvt1[44];
- } Heap_ModuleDesc;
+ CHAR Heap_ModuleName[20];
typedef
- CHAR Heap_ModuleName[20];
+ struct Heap_ModuleDesc {
+ Heap_Module next;
+ Heap_ModuleName name;
+ INT32 refcnt;
+ Heap_Cmd cmds;
+ INT32 types;
+ Heap_EnumProc enumPtrs;
+ char _prvt0[8];
+ } Heap_ModuleDesc;
import SYSTEM_PTR Heap_modules;
-import INT32 Heap_allocated, Heap_heapsize;
+import INT32 Heap_allocated;
+import INT32 Heap_heap;
+import INT32 Heap_heapsize, Heap_heapMinExpand;
import INT16 Heap_FileCount;
import ADDRESS *Heap_ModuleDesc__typ;
+import ADDRESS *Heap_CmdDesc__typ;
import void Heap_FINALL (void);
+import INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len);
import void Heap_GC (BOOLEAN markStack);
import void Heap_INCREF (Heap_Module m);
import void Heap_InitHeap (void);
diff --git a/bootstrap/unix-48/Modules.c b/bootstrap/unix-48/Modules.c
index a5e72ba3..535721e8 100644
--- a/bootstrap/unix-48/Modules.c
+++ b/bootstrap/unix-48/Modules.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -9,81 +9,303 @@
#include "Heap.h"
#include "Platform.h"
-typedef
- struct Modules_CmdDesc *Modules_Cmd;
-
-typedef
- void (*Modules_Command)(void);
-
-typedef
- struct Modules_CmdDesc {
- Modules_Cmd next;
- CHAR name[24];
- Modules_Command cmd;
- } Modules_CmdDesc;
-
-typedef
- struct Modules_ModuleDesc *Modules_Module;
-
-typedef
- CHAR Modules_ModuleName[20];
-
-typedef
- struct Modules_ModuleDesc {
- Modules_Module next;
- Modules_ModuleName name;
- INT32 refcnt;
- Modules_Cmd cmds;
- INT32 types;
- void (*enumPtrs)(void(*)(INT32));
- INT32 reserved1, reserved2;
- } Modules_ModuleDesc;
-
export INT16 Modules_res;
export CHAR Modules_resMsg[256];
-export Modules_ModuleName Modules_imported, Modules_importing;
+export Heap_ModuleName Modules_imported, Modules_importing;
+export INT32 Modules_MainStackFrame;
+export INT16 Modules_ArgCount;
+export INT32 Modules_ArgVector;
+export CHAR Modules_BinaryDir[1024];
-export ADDRESS *Modules_ModuleDesc__typ;
-export ADDRESS *Modules_CmdDesc__typ;
-static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len);
+static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
+static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
+export INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len);
export void Modules_AssertFail (INT32 code);
+static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
+static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len);
static void Modules_DisplayHaltCode (INT32 code);
-export void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
+static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len);
+static void Modules_FindBinaryDir (CHAR *binarydir, ADDRESS binarydir__len);
+export void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all);
+export void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len);
+export void Modules_GetIntArg (INT16 n, INT32 *val);
export void Modules_Halt (INT32 code);
-export Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
-export Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
+export void Modules_Init (INT32 argc, INT32 argvadr);
+static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len);
+static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len);
+static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len);
+export Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len);
+export Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len);
+static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
static void Modules_errch (CHAR c);
static void Modules_errint (INT32 l);
-static void Modules_errstring (CHAR *s, LONGINT s__len);
+static void Modules_errstring (CHAR *s, ADDRESS s__len);
-#define Modules_modules() (Modules_Module)Heap_modules
-#define Modules_setmodules(m) Heap_modules = m
+extern void Heap_InitHeap();
+extern void *Modules__init(void);
+#define Modules_InitHeap() Heap_InitHeap()
+#define Modules_ModulesInit() Modules__init()
+#define Modules_modules() (Heap_Module)Heap_modules
-static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len)
+void Modules_Init (INT32 argc, INT32 argvadr)
{
- INT16 i, j;
- __DUP(b, b__len, CHAR);
+ Modules_MainStackFrame = argvadr;
+ Modules_ArgCount = __VAL(INT16, argc);
+ __GET(argvadr, Modules_ArgVector, INT32);
+ Modules_InitHeap();
+ Modules_ModulesInit();
+}
+
+typedef
+ CHAR (*argptr__15)[1024];
+
+void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len)
+{
+ argptr__15 arg = NIL;
+ if (n < Modules_ArgCount) {
+ __GET(Modules_ArgVector + __ASHL(n, 2), arg, argptr__15);
+ __COPY(*arg, val, val__len);
+ }
+}
+
+void Modules_GetIntArg (INT16 n, INT32 *val)
+{
+ CHAR s[64];
+ INT32 k, d, i;
+ s[0] = 0x00;
+ Modules_GetArg(n, (void*)s, 64);
i = 0;
- while (a[__X(i, a__len)] != 0x00) {
+ if (s[0] == '-') {
+ i = 1;
+ }
+ k = 0;
+ d = (INT16)s[__X(i, 64)] - 48;
+ while ((d >= 0 && d <= 9)) {
+ k = k * 10 + d;
+ i += 1;
+ d = (INT16)s[__X(i, 64)] - 48;
+ }
+ if (s[0] == '-') {
+ k = -k;
+ i -= 1;
+ }
+ if (i > 0) {
+ *val = k;
+ }
+}
+
+INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len)
+{
+ INT16 i;
+ CHAR arg[256];
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ Modules_GetArg(i, (void*)arg, 256);
+ while ((i < Modules_ArgCount && __STRCMP(s, arg) != 0)) {
+ i += 1;
+ Modules_GetArg(i, (void*)arg, 256);
+ }
+ __DEL(s);
+ return i;
+}
+
+static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len)
+{
+ INT16 i;
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
i += 1;
}
- j = 0;
- while (b[__X(j, b__len)] != 0x00) {
- a[__X(i, a__len)] = b[__X(j, b__len)];
+ __DEL(s);
+ return i;
+}
+
+static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
+{
+ INT16 i, j;
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ j = Modules_CharCount(d, d__len);
+ while (s[__X(i, s__len)] != 0x00) {
+ d[__X(j, d__len)] = s[__X(i, s__len)];
i += 1;
j += 1;
}
- a[__X(i, a__len)] = 0x00;
- __DEL(b);
+ d[__X(j, d__len)] = 0x00;
+ __DEL(s);
}
-Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
+static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{
- Modules_Module m = NIL;
+ INT16 i, j;
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ j = Modules_CharCount(d, d__len);
+ if ((j > 0 && d[__X(j - 1, d__len)] != c)) {
+ d[__X(j, d__len)] = c;
+ j += 1;
+ }
+ while (s[__X(i, s__len)] != 0x00) {
+ d[__X(j, d__len)] = s[__X(i, s__len)];
+ i += 1;
+ j += 1;
+ }
+ d[__X(j, d__len)] = 0x00;
+ __DEL(s);
+}
+
+static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len)
+{
+ INT16 i;
+ __DUP(s, s__len, CHAR);
+ if (c == 0x00) {
+ __DEL(s);
+ return 0;
+ }
+ i = 0;
+ while ((s[__X(i, s__len)] != c && s[__X(i, s__len)] != 0x00)) {
+ i += 1;
+ }
+ __DEL(s);
+ return s[__X(i, s__len)] == c;
+}
+
+static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len)
+{
+ __DUP(d, d__len, CHAR);
+ if (d[0] == 0x00) {
+ __DEL(d);
+ return 0;
+ }
+ if (Modules_IsOneOf(d[0], (CHAR*)"/\\", 3)) {
+ __DEL(d);
+ return 1;
+ }
+ if (d[__X(1, d__len)] == ':') {
+ __DEL(d);
+ return 1;
+ }
+ __DEL(d);
+ return 0;
+}
+
+static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
+{
+ __DUP(s, s__len, CHAR);
+ if (Modules_IsAbsolute(s, s__len)) {
+ __COPY(s, d, d__len);
+ } else {
+ __COPY(Platform_CWD, d, d__len);
+ Modules_AppendPart('/', s, s__len, (void*)d, d__len);
+ }
+ __DEL(s);
+}
+
+static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len)
+{
+ Platform_FileIdentity identity;
+ __DUP(s, s__len, CHAR);
+ __DEL(s);
+ return Platform_IdentifyByName(s, s__len, &identity, Platform_FileIdentity__typ) == 0;
+}
+
+static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len)
+{
+ INT16 j;
+ __DUP(s, s__len, CHAR);
+ __DUP(p, p__len, CHAR);
+ j = 0;
+ while ((s[__X(*i, s__len)] != 0x00 && !Modules_IsOneOf(s[__X(*i, s__len)], p, p__len))) {
+ d[__X(j, d__len)] = s[__X(*i, s__len)];
+ *i += 1;
+ j += 1;
+ }
+ d[__X(j, d__len)] = 0x00;
+ while (Modules_IsOneOf(s[__X(*i, s__len)], p, p__len)) {
+ *i += 1;
+ }
+ __DEL(s);
+ __DEL(p);
+}
+
+static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
+{
+ INT16 i, j;
+ CHAR part[1024];
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ j = 0;
+ while ((i < 2 && Modules_IsOneOf(s[__X(i, s__len)], (CHAR*)"/\\", 3))) {
+ i += 1;
+ d[__X(j, d__len)] = '/';
+ j += 1;
+ }
+ d[__X(j, d__len)] = 0x00;
+ while (s[__X(i, s__len)] != 0x00) {
+ Modules_ExtractPart(s, s__len, &i, (CHAR*)"/\\", 3, (void*)part, 1024);
+ if ((part[0] != 0x00 && __STRCMP(part, ".") != 0)) {
+ Modules_AppendPart('/', part, 1024, (void*)d, d__len);
+ }
+ }
+ __DEL(s);
+}
+
+typedef
+ CHAR pathstring__12[4096];
+
+static void Modules_FindBinaryDir (CHAR *binarydir, ADDRESS binarydir__len)
+{
+ pathstring__12 arg0, pathlist, pathdir, tempstr;
+ INT16 i, j, k;
+ BOOLEAN present;
+ if (Modules_ArgCount < 1) {
+ binarydir[0] = 0x00;
+ return;
+ }
+ Modules_GetArg(0, (void*)arg0, 4096);
+ i = 0;
+ while ((((arg0[__X(i, 4096)] != 0x00 && arg0[__X(i, 4096)] != '/')) && arg0[__X(i, 4096)] != '\\')) {
+ i += 1;
+ }
+ if (arg0[__X(i, 4096)] == '/' || arg0[__X(i, 4096)] == '\\') {
+ Modules_Trim(arg0, 4096, (void*)tempstr, 4096);
+ Modules_Canonify(tempstr, 4096, (void*)binarydir, binarydir__len);
+ present = Modules_IsFilePresent(binarydir, binarydir__len);
+ } else {
+ Platform_GetEnv((CHAR*)"PATH", 5, (void*)pathlist, 4096);
+ i = 0;
+ present = 0;
+ while ((!present && pathlist[__X(i, 4096)] != 0x00)) {
+ Modules_ExtractPart(pathlist, 4096, &i, (CHAR*)":;", 3, (void*)pathdir, 4096);
+ Modules_AppendPart('/', arg0, 4096, (void*)pathdir, 4096);
+ Modules_Trim(pathdir, 4096, (void*)tempstr, 4096);
+ Modules_Canonify(tempstr, 4096, (void*)binarydir, binarydir__len);
+ present = Modules_IsFilePresent(binarydir, binarydir__len);
+ }
+ }
+ if (present) {
+ k = Modules_CharCount(binarydir, binarydir__len);
+ while ((k > 0 && !Modules_IsOneOf(binarydir[__X(k - 1, binarydir__len)], (CHAR*)"/\\", 3))) {
+ k -= 1;
+ }
+ if (k == 0) {
+ binarydir[__X(k, binarydir__len)] = 0x00;
+ } else {
+ binarydir[__X(k - 1, binarydir__len)] = 0x00;
+ }
+ } else {
+ binarydir[0] = 0x00;
+ }
+}
+
+Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len)
+{
+ Heap_Module m = NIL;
CHAR bodyname[64];
- Modules_Command body;
+ Heap_Command body;
__DUP(name, name__len, CHAR);
m = Modules_modules();
while ((m != NIL && __STRCMP(m->name, name) != 0)) {
@@ -96,16 +318,16 @@ Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
Modules_res = 1;
__COPY(name, Modules_importing, 20);
__MOVE(" module \"", Modules_resMsg, 10);
- Modules_Append((void*)Modules_resMsg, 256, name, name__len);
- Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
+ Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
+ Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
}
__DEL(name);
return m;
}
-Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len)
+Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len)
{
- Modules_Cmd c = NIL;
+ Heap_Cmd c = NIL;
__DUP(name, name__len, CHAR);
c = mod->cmds;
while ((c != NIL && __STRCMP(c->name, name) != 0)) {
@@ -120,43 +342,36 @@ Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT nam
Modules_res = 2;
__MOVE(" command \"", Modules_resMsg, 11);
__COPY(name, Modules_importing, 20);
- Modules_Append((void*)Modules_resMsg, 256, mod->name, 20);
- Modules_Append((void*)Modules_resMsg, 256, (CHAR*)".", 2);
- Modules_Append((void*)Modules_resMsg, 256, name, name__len);
- Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
+ Modules_Append(mod->name, 20, (void*)Modules_resMsg, 256);
+ Modules_Append((CHAR*)".", 2, (void*)Modules_resMsg, 256);
+ Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
+ Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
__DEL(name);
return NIL;
}
__RETCHK;
}
-void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all)
+void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all)
{
- Modules_Module m = NIL, p = NIL;
+ Heap_Module m = NIL, p = NIL;
+ INT32 refcount;
__DUP(name, name__len, CHAR);
m = Modules_modules();
if (all) {
Modules_res = 1;
__MOVE("unloading \"all\" not yet supported", Modules_resMsg, 34);
} else {
- while ((m != NIL && __STRCMP(m->name, name) != 0)) {
- p = m;
- m = m->next;
- }
- if ((m != NIL && m->refcnt == 0)) {
- if (m == Modules_modules()) {
- Modules_setmodules(m->next);
- } else {
- p->next = m->next;
- }
+ refcount = Heap_FreeModule(name, name__len);
+ if (refcount == 0) {
Modules_res = 0;
} else {
- Modules_res = 1;
- if (m == NIL) {
+ if (refcount < 0) {
__MOVE("module not found", Modules_resMsg, 17);
} else {
__MOVE("clients of this module exist", Modules_resMsg, 29);
}
+ Modules_res = 1;
}
}
__DEL(name);
@@ -168,7 +383,7 @@ static void Modules_errch (CHAR c)
e = Platform_Write(1, (ADDRESS)&c, 1);
}
-static void Modules_errstring (CHAR *s, LONGINT s__len)
+static void Modules_errstring (CHAR *s, ADDRESS s__len)
{
INT32 i;
__DUP(s, s__len, CHAR);
@@ -189,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)
@@ -250,6 +465,7 @@ static void Modules_DisplayHaltCode (INT32 code)
void Modules_Halt (INT32 code)
{
+ Heap_FINALL();
Modules_errstring((CHAR*)"Terminated by Halt(", 20);
Modules_errint(code);
Modules_errstring((CHAR*)"). ", 4);
@@ -262,6 +478,7 @@ void Modules_Halt (INT32 code)
void Modules_AssertFail (INT32 code)
{
+ Heap_FINALL();
Modules_errstring((CHAR*)"Assertion failure.", 19);
if (code != 0) {
Modules_errstring((CHAR*)" ASSERT code ", 14);
@@ -269,11 +486,13 @@ void Modules_AssertFail (INT32 code)
Modules_errstring((CHAR*)".", 2);
}
Modules_errstring(Platform_NL, 3);
- Platform_Exit(code);
+ if (code > 0) {
+ Platform_Exit(code);
+ } else {
+ Platform_Exit(-1);
+ }
}
-__TDESC(Modules_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 48), {0, 28, -12}};
-__TDESC(Modules_CmdDesc, 1, 1) = {__TDFLDS("CmdDesc", 32), {0, -8}};
export void *Modules__init(void)
{
@@ -281,8 +500,7 @@ export void *Modules__init(void)
__MODULE_IMPORT(Heap);
__MODULE_IMPORT(Platform);
__REGMOD("Modules", 0);
- __INITYP(Modules_ModuleDesc, Modules_ModuleDesc, 0);
- __INITYP(Modules_CmdDesc, Modules_CmdDesc, 0);
/* BEGIN */
+ Modules_FindBinaryDir((void*)Modules_BinaryDir, 1024);
__ENDMOD;
}
diff --git a/bootstrap/unix-48/Modules.h b/bootstrap/unix-48/Modules.h
index 8bb89fe5..26d86b38 100644
--- a/bootstrap/unix-48/Modules.h
+++ b/bootstrap/unix-48/Modules.h
@@ -1,53 +1,30 @@
-/* voc 1.95 [2016/11/24]. 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
#include "SYSTEM.h"
-
-typedef
- struct Modules_CmdDesc *Modules_Cmd;
-
-typedef
- void (*Modules_Command)(void);
-
-typedef
- struct Modules_CmdDesc {
- Modules_Cmd next;
- CHAR name[24];
- Modules_Command cmd;
- } Modules_CmdDesc;
-
-typedef
- struct Modules_ModuleDesc *Modules_Module;
-
-typedef
- CHAR Modules_ModuleName[20];
-
-typedef
- struct Modules_ModuleDesc {
- Modules_Module next;
- Modules_ModuleName name;
- INT32 refcnt;
- Modules_Cmd cmds;
- INT32 types;
- void (*enumPtrs)(void(*)(INT32));
- char _prvt0[8];
- } Modules_ModuleDesc;
+#include "Heap.h"
import INT16 Modules_res;
import CHAR Modules_resMsg[256];
-import Modules_ModuleName Modules_imported, Modules_importing;
+import Heap_ModuleName Modules_imported, Modules_importing;
+import INT32 Modules_MainStackFrame;
+import INT16 Modules_ArgCount;
+import INT32 Modules_ArgVector;
+import CHAR Modules_BinaryDir[1024];
-import ADDRESS *Modules_ModuleDesc__typ;
-import ADDRESS *Modules_CmdDesc__typ;
+import INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len);
import void Modules_AssertFail (INT32 code);
-import void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
+import void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all);
+import void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len);
+import void Modules_GetIntArg (INT16 n, INT32 *val);
import void Modules_Halt (INT32 code);
-import Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
-import Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
+import void Modules_Init (INT32 argc, INT32 argvadr);
+import Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len);
+import Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len);
import void *Modules__init(void);
diff --git a/bootstrap/unix-48/OPB.c b/bootstrap/unix-48/OPB.c
index 3ef8e2f9..913fbf2d 100644
--- a/bootstrap/unix-48/OPB.c
+++ b/bootstrap/unix-48/OPB.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -253,7 +253,7 @@ OPT_Node OPB_NewString (OPS_String str, INT64 len)
x->conval->intval = -1;
x->conval->intval2 = OPM_Longint(len);
x->conval->ext = OPT_NewExt();
- __COPY(str, *x->conval->ext, 256);
+ __MOVE(str, *x->conval->ext, 256);
return x;
}
@@ -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;
@@ -550,7 +550,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
if (__IN(f, 0xf0, 32)) {
if (z->class == 7) {
if (f == 4) {
- if (z->conval->intval == (-9223372036854775807-1)) {
+ if (z->conval->intval == (-9223372036854775807LL-1)) {
OPB_err(203);
} else {
z->conval->intval = -z->conval->intval;
@@ -577,7 +577,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
if (__IN(f, 0x70, 32)) {
if (z->class == 7) {
if (f == 4) {
- if (z->conval->intval == (-9223372036854775807-1)) {
+ if (z->conval->intval == (-9223372036854775807LL-1)) {
OPB_err(203);
} else {
z->conval->intval = __ABS(z->conval->intval);
@@ -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);
@@ -920,7 +920,7 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
if (f == 4) {
xv = xval->intval;
yv = yval->intval;
- if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807-1))) && yv != (-9223372036854775807-1))) && -xv <= __DIV(9223372036854775807, -yv))) {
+ if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807LL, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807LL-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807LL-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807LL-1))) && yv != (-9223372036854775807LL-1))) && -xv <= __DIV(9223372036854775807LL, -yv))) {
xval->intval = xv * yv;
OPB_SetIntType(x);
} else {
@@ -999,8 +999,8 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
break;
case 6:
if (f == 4) {
- temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807 - yval->intval);
- if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807-1) - yval->intval)) {
+ temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807LL - yval->intval);
+ if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807LL-1) - yval->intval)) {
xval->intval += yval->intval;
OPB_SetIntType(x);
} else {
@@ -1023,7 +1023,7 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
break;
case 7:
if (f == 4) {
- if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807 + yval->intval)) {
+ if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807LL-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807LL + yval->intval)) {
xval->intval -= yval->intval;
OPB_SetIntType(x);
} else {
@@ -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);
}
}
@@ -1624,23 +1624,20 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
g = 8;
}
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) {
OPB_err(114);
}
- } else if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
} else {
OPB_err(113);
}
} else {
OPB_err(113);
}
- } else if ((x->comp == 3 && x->BaseTyp == OPT_chartyp)) {
- if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
- } else {
- OPB_err(113);
- }
} else if (x->comp == 4) {
if (x == y) {
} else if (y->comp == 4) {
@@ -2091,7 +2088,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
OPB_err(208);
p->conval->intval = 1;
} else if (x->conval->intval >= 0) {
- if (__ABS(p->conval->intval) <= __DIV(9223372036854775807, (INT64)__ASH(1, x->conval->intval))) {
+ if (__ABS(p->conval->intval) <= __DIV(9223372036854775807LL, (INT64)__ASH(1, x->conval->intval))) {
p->conval->intval = p->conval->intval * (INT64)__ASH(1, x->conval->intval);
} else {
OPB_err(208);
@@ -2536,7 +2533,6 @@ void OPB_Return (OPT_Node *x, OPT_Object proc)
void OPB_Assign (OPT_Node *x, OPT_Node y)
{
OPT_Node z = NIL;
- INT8 subcl;
if ((*x)->class >= 7) {
OPB_err(56);
}
@@ -2562,13 +2558,8 @@ void OPB_Assign (OPT_Node *x, OPT_Node y)
y->conval->intval = 0;
OPB_Index(&*x, OPB_NewIntConst(0));
}
- if ((((((__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp == OPT_chartyp)) && __IN(y->typ->comp, 0x0c, 32))) && y->typ->BaseTyp == OPT_chartyp)) {
- subcl = 18;
- } else {
- subcl = 0;
- }
OPB_BindNodes(19, OPT_notyp, &*x, y);
- (*x)->subcl = subcl;
+ (*x)->subcl = 0;
}
void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ)
@@ -2595,7 +2586,7 @@ export void *OPB__init(void)
__MODULE_IMPORT(OPT);
__REGMOD("OPB", 0);
/* BEGIN */
- OPB_maxExp = OPB_log(4611686018427387904);
+ OPB_maxExp = OPB_log(4611686018427387904LL);
OPB_maxExp = OPB_exp;
__ENDMOD;
}
diff --git a/bootstrap/unix-48/OPB.h b/bootstrap/unix-48/OPB.h
index 0be714e8..f66fcd66 100644
--- a/bootstrap/unix-48/OPB.h
+++ b/bootstrap/unix-48/OPB.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 ef4b429f..7b92ccc1 100644
--- a/bootstrap/unix-48/OPC.c
+++ b/bootstrap/unix-48/OPC.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -56,7 +56,7 @@ static void OPC_GenHeaderMsg (void);
export void OPC_Halt (INT32 n);
export void OPC_Ident (OPT_Object obj);
static void OPC_IdentList (OPT_Object obj, INT16 vis);
-static void OPC_Include (CHAR *name, LONGINT name__len);
+static void OPC_Include (CHAR *name, ADDRESS name__len);
static void OPC_IncludeImports (OPT_Object obj, INT16 vis);
export void OPC_Increment (BOOLEAN decrement);
export void OPC_Indent (INT16 count);
@@ -68,11 +68,11 @@ static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj);
export void OPC_IntLiteral (INT64 n, INT32 size);
export void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim);
static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName);
-static INT16 OPC_Length (CHAR *s, LONGINT s__len);
+static INT16 OPC_Length (CHAR *s, ADDRESS s__len);
export BOOLEAN OPC_NeedsRetval (OPT_Object proc);
export INT32 OPC_NofPtrs (OPT_Struct typ);
-static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len);
-static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len);
+static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len);
+static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len);
static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define);
static void OPC_ProcPredefs (OPT_Object obj, INT8 vis);
static void OPC_PutBase (OPT_Struct typ);
@@ -80,8 +80,8 @@ static void OPC_PutPtrOffsets (OPT_Struct typ, INT32 adr, INT32 *cnt);
static void OPC_RegCmds (OPT_Object obj);
export void OPC_SetInclude (BOOLEAN exclude);
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
-static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x);
-static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l);
+static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x);
+static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l);
export void OPC_TDescDecl (OPT_Struct typ);
export void OPC_TypeDefs (OPT_Object obj, INT16 vis);
export void OPC_TypeOf (OPT_Object ap);
@@ -137,7 +137,7 @@ void OPC_EndBlk0 (void)
OPM_Write('}');
}
-static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
+static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x)
{
CHAR ch;
INT16 i;
@@ -156,7 +156,7 @@ static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
__DEL(s);
}
-static INT16 OPC_Length (CHAR *s, LONGINT s__len)
+static INT16 OPC_Length (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@@ -166,7 +166,7 @@ static INT16 OPC_Length (CHAR *s, LONGINT s__len)
return i;
}
-static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len)
+static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len)
{
INT16 i, h;
i = 0;
@@ -364,7 +364,7 @@ static void OPC_DeclareBase (OPT_Object dcl)
OPM_WriteString((CHAR*)"struct ", 8);
OPC_BegBlk();
OPC_BegStat();
- OPC_Str1((CHAR*)"LONGINT len[#]", 15, nofdims);
+ OPC_Str1((CHAR*)"ADDRESS len[#]", 15, nofdims);
OPC_EndStat();
OPC_BegStat();
__NEW(obj, OPT_ObjDesc);
@@ -511,7 +511,7 @@ static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamNa
typ = par->typ->BaseTyp;
while (typ->comp == 3) {
if (ansiDefine) {
- OPM_WriteString((CHAR*)", LONGINT ", 11);
+ OPM_WriteString((CHAR*)", ADDRESS ", 11);
} else {
OPM_WriteString((CHAR*)", ", 3);
}
@@ -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,12 +721,19 @@ 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();
+ }
}
}
}
}
-static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len)
+static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len)
{
INT16 i;
__DUP(y, y__len, CHAR);
@@ -968,8 +981,8 @@ static void OPC_IdentList (OPT_Object obj, INT16 vis)
if (obj->typ->comp == 3) {
OPC_EndStat();
OPC_BegStat();
- base = OPT_linttyp;
- OPM_WriteString((CHAR*)"LONGINT ", 9);
+ base = OPT_adrtyp;
+ OPM_WriteString((CHAR*)"ADDRESS ", 9);
OPC_LenList(obj, 0, 1);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPC_EndStat();
@@ -1008,7 +1021,7 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
__COPY(name, obj->name, 256);
}
if (obj->typ->comp == 3) {
- OPM_WriteString((CHAR*)", LONGINT ", 11);
+ OPM_WriteString((CHAR*)", ADDRESS ", 11);
OPC_LenList(obj, 1, showParamNames);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPM_WriteString((CHAR*)", ADDRESS *", 12);
@@ -1062,7 +1075,7 @@ static void OPC_ProcPredefs (OPT_Object obj, INT8 vis)
}
}
-static void OPC_Include (CHAR *name, LONGINT name__len)
+static void OPC_Include (CHAR *name, ADDRESS name__len)
{
__DUP(name, name__len, CHAR);
OPM_WriteString((CHAR*)"#include ", 10);
@@ -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) {
@@ -1659,9 +1672,9 @@ void OPC_CompleteIdent (OPT_Object obj)
OPC_Ident(obj);
OPM_WriteString((CHAR*)"__", 3);
} else {
- OPM_WriteString((CHAR*)"((", 3);
+ OPM_WriteString((CHAR*)"(*(", 4);
OPC_Ident(obj->typ->strobj);
- OPM_Write(')');
+ OPM_WriteString((CHAR*)"*)&", 4);
OPC_Ident(obj);
OPM_Write(')');
}
@@ -1739,12 +1752,12 @@ 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('\'');
}
}
-static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l)
+static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
{
INT32 i;
INT16 c;
@@ -1755,16 +1768,16 @@ static void OPC_StringLiteral (CHAR *s, LONGINT 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);
}
}
@@ -1912,9 +1927,9 @@ static struct InitKeywords__46 {
struct InitKeywords__46 *lnk;
} *InitKeywords__46_s;
-static void Enter__47 (CHAR *s, LONGINT s__len);
+static void Enter__47 (CHAR *s, ADDRESS s__len);
-static void Enter__47 (CHAR *s, LONGINT s__len)
+static void Enter__47 (CHAR *s, ADDRESS s__len)
{
INT16 h;
__DUP(s, s__len, CHAR);
diff --git a/bootstrap/unix-48/OPC.h b/bootstrap/unix-48/OPC.h
index 842e7dec..3bfd88b8 100644
--- a/bootstrap/unix-48/OPC.h
+++ b/bootstrap/unix-48/OPC.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 e76d763e..bcb39247 100644
--- a/bootstrap/unix-48/OPM.c
+++ b/bootstrap/unix-48/OPM.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,6 +8,7 @@
#include "SYSTEM.h"
#include "Configuration.h"
#include "Files.h"
+#include "Modules.h"
#include "Out.h"
#include "Platform.h"
#include "Strings.h"
@@ -18,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];
@@ -26,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;
@@ -41,41 +44,48 @@ static Files_Rider OPM_oldSF, OPM_newSF;
static Files_Rider OPM_R[3];
static Files_File OPM_oldSFile, OPM_newSFile, OPM_HFile, OPM_BFile, OPM_HIFile;
static INT16 OPM_S;
+export CHAR OPM_InstallDir[1024];
export CHAR OPM_ResourceDir[1024];
static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F);
export void OPM_CloseFiles (void);
export void OPM_CloseOldSym (void);
-export void OPM_DeleteNewSym (void);
+export void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
+export void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
export void OPM_FPrint (INT32 *fp, INT64 val);
export void OPM_FPrintLReal (INT32 *fp, LONGREAL val);
export void OPM_FPrintReal (INT32 *fp, REAL val);
export void OPM_FPrintSet (INT32 *fp, UINT64 val);
+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, LONGINT bytes__len);
+static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len);
export void OPM_Get (CHAR *ch);
-export void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
+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);
+static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len);
+export void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len);
static void OPM_LogErrMsg (INT16 n);
-export void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
+export void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len);
export void OPM_LogW (CHAR ch);
export void OPM_LogWLn (void);
export void OPM_LogWNum (INT64 i, INT64 len);
-export void OPM_LogWStr (CHAR *s, LONGINT s__len);
+export void OPM_LogWStr (CHAR *s, ADDRESS s__len);
export INT32 OPM_Longint (INT64 n);
-static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len);
+static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len);
export void OPM_Mark (INT16 n, INT32 pos);
-export void OPM_NewSym (CHAR *modName, LONGINT modName__len);
-export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
-export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
+export void OPM_NewSym (CHAR *modName, ADDRESS modName__len);
+export void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done);
+export void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len);
export BOOLEAN OPM_OpenPar (void);
export void OPM_RegisterNewSym (void);
-static void OPM_ScanOptions (CHAR *s, LONGINT s__len);
+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);
@@ -87,14 +97,13 @@ export void OPM_SymWInt (INT64 i);
export void OPM_SymWLReal (LONGREAL lr);
export void OPM_SymWReal (REAL r);
export void OPM_SymWSet (UINT64 s);
-static void OPM_VerboseListSizes (void);
export void OPM_Write (CHAR ch);
export void OPM_WriteHex (INT64 i);
export void OPM_WriteInt (INT64 i);
export void OPM_WriteLn (void);
export void OPM_WriteReal (LONGREAL r, CHAR suffx);
-export void OPM_WriteString (CHAR *s, LONGINT s__len);
-export void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
+export void OPM_WriteString (CHAR *s, ADDRESS s__len);
+export void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
export BOOLEAN OPM_eofSF (void);
export void OPM_err (INT16 n);
@@ -105,7 +114,7 @@ void OPM_LogW (CHAR ch)
Out_Char(ch);
}
-void OPM_LogWStr (CHAR *s, LONGINT s__len)
+void OPM_LogWStr (CHAR *s, ADDRESS s__len)
{
__DUP(s, s__len, CHAR);
Out_String(s, s__len);
@@ -122,7 +131,7 @@ void OPM_LogWLn (void)
Out_Ln();
}
-void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
+void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len)
{
__DUP(vt100code, vt100code__len, CHAR);
if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) {
@@ -131,6 +140,57 @@ void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
__DEL(vt100code);
}
+void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len)
+{
+ __DUP(modname, modname__len, CHAR);
+ OPM_LogWStr((CHAR*)"Compiling ", 11);
+ OPM_LogWStr(modname, modname__len);
+ if (__IN(18, OPM_Options, 32)) {
+ OPM_LogWStr((CHAR*)", s:", 5);
+ OPM_LogWNum(__ASHL(OPM_ShortintSize, 3), 1);
+ OPM_LogWStr((CHAR*)" i:", 4);
+ OPM_LogWNum(__ASHL(OPM_IntegerSize, 3), 1);
+ OPM_LogWStr((CHAR*)" l:", 4);
+ OPM_LogWNum(__ASHL(OPM_LongintSize, 3), 1);
+ OPM_LogWStr((CHAR*)" adr:", 6);
+ OPM_LogWNum(__ASHL(OPM_AddressSize, 3), 1);
+ OPM_LogWStr((CHAR*)" algn:", 7);
+ OPM_LogWNum(__ASHL(OPM_Alignment, 3), 1);
+ }
+ OPM_LogW('.');
+ __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;
@@ -154,7 +214,7 @@ INT16 OPM_Integer (INT64 n)
return __VAL(INT16, n);
}
-static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
+static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
@@ -227,29 +287,6 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
i += 2;
}
break;
- case 'B':
- if (s[__X(i + 1, s__len)] != 0x00) {
- i += 1;
- OPM_IntegerSize = (INT16)s[__X(i, s__len)] - 48;
- }
- if (s[__X(i + 1, s__len)] != 0x00) {
- i += 1;
- OPM_AddressSize = (INT16)s[__X(i, s__len)] - 48;
- }
- if (s[__X(i + 1, s__len)] != 0x00) {
- i += 1;
- OPM_Alignment = (INT16)s[__X(i, s__len)] - 48;
- }
- __ASSERT(OPM_IntegerSize == 2 || OPM_IntegerSize == 4, 0);
- __ASSERT(OPM_AddressSize == 4 || OPM_AddressSize == 8, 0);
- __ASSERT(OPM_Alignment == 4 || OPM_Alignment == 8, 0);
- if (OPM_IntegerSize == 2) {
- OPM_LongintSize = 4;
- } else {
- OPM_LongintSize = 8;
- }
- Files_SetSearchPath((CHAR*)"", 1);
- break;
default:
OPM_LogWStr((CHAR*)" warning: option ", 19);
OPM_LogW('-');
@@ -266,16 +303,19 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
BOOLEAN OPM_OpenPar (void)
{
CHAR s[256];
- if (Platform_ArgCount == 1) {
+ 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);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Further development by Norayr Chilingarian, David Brown and others.", 68);
OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Loaded from ", 13);
+ OPM_LogWStr(Modules_BinaryDir, 1024);
+ OPM_LogWLn();
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Usage:", 7);
OPM_LogWLn();
@@ -332,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();
@@ -362,64 +402,38 @@ BOOLEAN OPM_OpenPar (void)
OPM_Options = 0xa9;
OPM_S = 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
}
OPM_GlobalAddressSize = OPM_AddressSize;
OPM_GlobalAlignment = OPM_Alignment;
- __COPY(OPM_Model, OPM_GlobalModel, 10);
+ __MOVE(OPM_Model, OPM_GlobalModel, 10);
OPM_GlobalOptions = OPM_Options;
return 1;
}
__RETCHK;
}
-static void OPM_VerboseListSizes (void)
-{
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Type Size", 15);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"SHORTINT ", 12);
- OPM_LogWNum(OPM_ShortintSize, 4);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"INTEGER ", 12);
- OPM_LogWNum(OPM_IntegerSize, 4);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"LONGINT ", 12);
- OPM_LogWNum(OPM_LongintSize, 4);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"SET ", 12);
- OPM_LogWNum(OPM_LongintSize, 4);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"ADDRESS ", 12);
- OPM_LogWNum(OPM_AddressSize, 4);
- OPM_LogWLn();
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Alignment: ", 12);
- OPM_LogWNum(OPM_Alignment, 4);
- OPM_LogWLn();
-}
-
void OPM_InitOptions (void)
{
CHAR s[256];
CHAR searchpath[1024], modules[1024];
CHAR MODULES[1024];
OPM_Options = OPM_GlobalOptions;
- __COPY(OPM_GlobalModel, OPM_Model, 10);
+ __MOVE(OPM_GlobalModel, OPM_Model, 10);
OPM_Alignment = OPM_GlobalAlignment;
OPM_AddressSize = OPM_GlobalAddressSize;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
}
if (__IN(15, OPM_Options, 32)) {
OPM_Options |= __SETOF(10,32);
@@ -430,29 +444,32 @@ 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;
}
- if (__IN(18, OPM_Options, 32)) {
- OPM_VerboseListSizes();
+ __MOVE(OPM_InstallDir, OPM_ResourceDir, 1024);
+ if (OPM_ResourceDir[0] != 0x00) {
+ Strings_Append((CHAR*)"/", 2, (void*)OPM_ResourceDir, 1024);
+ Strings_Append(OPM_Model, 10, (void*)OPM_ResourceDir, 1024);
}
- OPM_ResourceDir[0] = 0x00;
- Strings_Append((CHAR*)"/", 2, (void*)OPM_ResourceDir, 1024);
- Strings_Append(OPM_Model, 10, (void*)OPM_ResourceDir, 1024);
modules[0] = 0x00;
Platform_GetEnv((CHAR*)"MODULES", 8, (void*)modules, 1024);
__MOVE(".", searchpath, 2);
@@ -465,23 +482,22 @@ void OPM_InitOptions (void)
Files_SetSearchPath(searchpath, 1024);
}
-void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
+void OPM_Init (BOOLEAN *done)
{
Texts_Text T = NIL;
INT32 beg, end, time;
CHAR s[256];
*done = 0;
OPM_curpos = 0;
- if (OPM_S >= Platform_ArgCount) {
+ if (OPM_S >= Modules_ArgCount) {
return;
}
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
__NEW(T, Texts_TextDesc);
Texts_Open(T, s, 256);
OPM_LogWStr(s, 256);
OPM_LogWStr((CHAR*)" ", 3);
- __COPY(s, mname, mname__len);
__COPY(s, OPM_SourceFileName, 256);
if (T->len == 0) {
OPM_LogWStr(s, 256);
@@ -503,18 +519,14 @@ void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
void OPM_Get (CHAR *ch)
{
+ OPM_curpos = Texts_Pos(&OPM_inR, Texts_Reader__typ);
Texts_Read(&OPM_inR, Texts_Reader__typ, &*ch);
- if (*ch == 0x0d) {
- OPM_curpos = Texts_Pos(&OPM_inR, Texts_Reader__typ);
- } else {
- OPM_curpos += 1;
- }
if ((*ch < 0x09 && !OPM_inR.eot)) {
*ch = ' ';
}
}
-static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len)
+static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len)
{
INT16 i, j;
CHAR ch;
@@ -632,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;
@@ -640,7 +652,6 @@ static void OPM_ShowLine (INT64 pos)
OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogW('^');
OPM_LogVT100((CHAR*)"0m", 3);
- Files_Close(f);
}
void OPM_Mark (INT16 n, INT32 pos)
@@ -700,7 +711,7 @@ void OPM_err (INT16 n)
OPM_Mark(n, OPM_errpos);
}
-static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len)
+static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len)
{
INT16 i;
INT32 l;
@@ -772,10 +783,13 @@ void OPM_CloseOldSym (void)
Files_Close(Files_Base(&OPM_oldSF, Files_Rider__typ));
}
-void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done)
+void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done)
{
CHAR tag, ver;
OPM_FileName fileName;
+ INT16 res;
+ OPM_oldSFile = NIL;
+ *done = 0;
OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
OPM_oldSFile = Files_Old(fileName, 32);
*done = OPM_oldSFile != NIL;
@@ -783,8 +797,10 @@ void OPM_OldSym (CHAR *modName, LONGINT 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 != 0x82) {
- OPM_err(-306);
+ if (tag != 0xf7 || ver != 0x84) {
+ if (!__IN(4, OPM_Options, 32)) {
+ OPM_err(-306);
+ }
OPM_CloseOldSym();
*done = 0;
}
@@ -828,11 +844,23 @@ void OPM_RegisterNewSym (void)
}
}
-void OPM_DeleteNewSym (void)
+void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len)
{
+ OPM_FileName fn;
+ INT16 res;
+ OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".sym", 5);
+ Files_Delete(fn, 32, &res);
}
-void OPM_NewSym (CHAR *modName, LONGINT modName__len)
+void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len)
+{
+ OPM_FileName fn;
+ INT16 res;
+ OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".o", 3);
+ Files_Delete(fn, 32, &res);
+}
+
+void OPM_NewSym (CHAR *modName, ADDRESS modName__len)
{
OPM_FileName fileName;
OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
@@ -840,7 +868,7 @@ void OPM_NewSym (CHAR *modName, LONGINT 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, 0x82);
+ Files_Write(&OPM_newSF, Files_Rider__typ, 0x84);
} else {
OPM_err(153);
}
@@ -851,7 +879,7 @@ void OPM_Write (CHAR ch)
Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, ch);
}
-void OPM_WriteString (CHAR *s, LONGINT s__len)
+void OPM_WriteString (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@@ -861,7 +889,7 @@ void OPM_WriteString (CHAR *s, LONGINT s__len)
Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}
-void OPM_WriteStringVar (CHAR *s, LONGINT s__len)
+void OPM_WriteStringVar (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@@ -875,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);
@@ -893,7 +921,7 @@ void OPM_WriteHex (INT64 i)
void OPM_WriteInt (INT64 i)
{
- CHAR s[24];
+ CHAR s[26];
INT64 i1, k;
if ((i == OPM_SignedMinimum(2) || i == OPM_SignedMinimum(4)) || i == OPM_SignedMinimum(8)) {
OPM_Write('(');
@@ -901,21 +929,27 @@ void OPM_WriteInt (INT64 i)
OPM_WriteString((CHAR*)"-1)", 4);
} else {
i1 = __ABS(i);
- s[0] = (CHAR)(__MOD(i1, 10) + 48);
+ if (i1 <= 2147483647) {
+ k = 0;
+ } else {
+ __MOVE("LL", s, 3);
+ k = 2;
+ }
+ s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
- k = 1;
+ k += 1;
while (i1 > 0) {
- s[__X(k, 24)] = (CHAR)(__MOD(i1, 10) + 48);
+ s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k += 1;
}
if (i < 0) {
- s[__X(k, 24)] = '-';
+ s[__X(k, 26)] = '-';
k += 1;
}
while (k > 0) {
k -= 1;
- OPM_Write(s[__X(k, 24)]);
+ OPM_Write(s[__X(k, 26)]);
}
}
}
@@ -928,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') {
@@ -986,9 +1020,9 @@ static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F)
}
}
-void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
+void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len)
{
- CHAR FName[32];
+ OPM_FileName FName;
__COPY(moduleName, OPM_modName, 32);
OPM_HFile = Files_New((CHAR*)"", 1);
if (OPM_HFile != NIL) {
@@ -1014,7 +1048,7 @@ void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
void OPM_CloseFiles (void)
{
- CHAR FName[32];
+ OPM_FileName FName;
INT16 res;
if (OPM_noerr) {
OPM_LogWStr((CHAR*)" ", 3);
@@ -1050,6 +1084,59 @@ void OPM_CloseFiles (void)
Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, 0);
}
+static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len)
+{
+ CHAR testpath[4096];
+ Platform_FileIdentity identity;
+ __DUP(s, s__len, CHAR);
+ __COPY(OPM_InstallDir, testpath, 4096);
+ Strings_Append((CHAR*)"/lib/lib", 9, (void*)testpath, 4096);
+ Strings_Append((CHAR*)"voc", 4, (void*)testpath, 4096);
+ Strings_Append((CHAR*)"-O2.a", 6, (void*)testpath, 4096);
+ if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
+ __DEL(s);
+ return 0;
+ }
+ __COPY(OPM_InstallDir, testpath, 4096);
+ Strings_Append((CHAR*)"/2/include/Oberon.h", 20, (void*)testpath, 4096);
+ if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
+ __DEL(s);
+ return 0;
+ }
+ __COPY(OPM_InstallDir, testpath, 4096);
+ Strings_Append((CHAR*)"/2/sym/Files.sym", 17, (void*)testpath, 4096);
+ if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
+ __DEL(s);
+ return 0;
+ }
+ __DEL(s);
+ return 1;
+}
+
+static void OPM_FindInstallDir (void)
+{
+ INT16 i;
+ __COPY(Modules_BinaryDir, OPM_InstallDir, 1024);
+ Strings_Append((CHAR*)"/", 2, (void*)OPM_InstallDir, 1024);
+ Strings_Append((CHAR*)"voc", 4, (void*)OPM_InstallDir, 1024);
+ Strings_Append((CHAR*)".d", 3, (void*)OPM_InstallDir, 1024);
+ if (OPM_IsProbablyInstallDir(OPM_InstallDir, 1024)) {
+ return;
+ }
+ __COPY(Modules_BinaryDir, OPM_InstallDir, 1024);
+ i = Strings_Length(OPM_InstallDir, 1024);
+ while ((i > 0 && OPM_InstallDir[__X(i - 1, 1024)] != '/')) {
+ i -= 1;
+ }
+ if ((i > 0 && OPM_InstallDir[__X(i - 1, 1024)] == '/')) {
+ OPM_InstallDir[__X(i - 1, 1024)] = 0x00;
+ if (OPM_IsProbablyInstallDir(OPM_InstallDir, 1024)) {
+ return;
+ }
+ }
+ __COPY("", OPM_InstallDir, 1024);
+}
+
static void EnumPtrs(void (*P)(void*))
{
__ENUMR(&OPM_inR, Texts_Reader__typ, 48, 1, P);
@@ -1071,6 +1158,7 @@ export void *OPM__init(void)
__DEFMOD;
__MODULE_IMPORT(Configuration);
__MODULE_IMPORT(Files);
+ __MODULE_IMPORT(Modules);
__MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
@@ -1079,7 +1167,6 @@ export void *OPM__init(void)
__REGMOD("OPM", EnumPtrs);
__REGCMD("CloseFiles", OPM_CloseFiles);
__REGCMD("CloseOldSym", OPM_CloseOldSym);
- __REGCMD("DeleteNewSym", OPM_DeleteNewSym);
__REGCMD("InitOptions", OPM_InitOptions);
__REGCMD("LogWLn", OPM_LogWLn);
__REGCMD("RegisterNewSym", OPM_RegisterNewSym);
@@ -1089,5 +1176,8 @@ export void *OPM__init(void)
OPM_MaxLReal = 1.79769296342094e+308;
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 2d272feb..64c15a28 100644
--- a/bootstrap/unix-48/OPM.h
+++ b/bootstrap/unix-48/OPM.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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;
@@ -17,34 +17,39 @@ import INT32 OPM_curpos, OPM_errpos, OPM_breakpc;
import INT16 OPM_currFile, OPM_level, OPM_pc, OPM_entno;
import CHAR OPM_modName[32];
import CHAR OPM_objname[64];
+import CHAR OPM_InstallDir[1024];
import CHAR OPM_ResourceDir[1024];
import void OPM_CloseFiles (void);
import void OPM_CloseOldSym (void);
-import void OPM_DeleteNewSym (void);
+import void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
+import void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
import void OPM_FPrint (INT32 *fp, INT64 val);
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_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
+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);
-import void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
+import void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len);
+import void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len);
import void OPM_LogW (CHAR ch);
import void OPM_LogWLn (void);
import void OPM_LogWNum (INT64 i, INT64 len);
-import void OPM_LogWStr (CHAR *s, LONGINT s__len);
+import void OPM_LogWStr (CHAR *s, ADDRESS s__len);
import INT32 OPM_Longint (INT64 n);
import void OPM_Mark (INT16 n, INT32 pos);
-import void OPM_NewSym (CHAR *modName, LONGINT modName__len);
-import void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
-import void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
+import void OPM_NewSym (CHAR *modName, ADDRESS modName__len);
+import void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done);
+import void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len);
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);
@@ -61,8 +66,8 @@ import void OPM_WriteHex (INT64 i);
import void OPM_WriteInt (INT64 i);
import void OPM_WriteLn (void);
import void OPM_WriteReal (LONGREAL r, CHAR suffx);
-import void OPM_WriteString (CHAR *s, LONGINT s__len);
-import void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
+import void OPM_WriteString (CHAR *s, ADDRESS s__len);
+import void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
import BOOLEAN OPM_eofSF (void);
import void OPM_err (INT16 n);
import void *OPM__init(void);
diff --git a/bootstrap/unix-48/OPP.c b/bootstrap/unix-48/OPP.c
index 3f360d00..ad4a370a 100644
--- a/bootstrap/unix-48/OPP.c
+++ b/bootstrap/unix-48/OPP.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -527,7 +527,7 @@ static void OPP_selector (OPT_Node *x)
} else if (OPP_sym == 18) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
- __COPY(OPS_name, name, 256);
+ __MOVE(OPS_name, name, 256);
OPS_Get(&OPP_sym);
if ((*x)->typ != NIL) {
if ((*x)->typ->form == 11) {
@@ -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);
@@ -867,7 +867,7 @@ static void OPP_Receiver (INT8 *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct
} else {
*mode = 1;
}
- __COPY(OPS_name, name, 256);
+ __MOVE(OPS_name, name, 256);
OPP_CheckSym(38);
OPP_CheckSym(20);
if (OPP_sym == 38) {
@@ -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;
}
}
@@ -1030,7 +1030,7 @@ static void TProcDecl__23 (void)
}
OPP_Receiver(&objMode, objName, &objTyp, &recTyp);
if (OPP_sym == 38) {
- __COPY(OPS_name, *ProcedureDeclaration__16_s->name, 256);
+ __MOVE(OPS_name, *ProcedureDeclaration__16_s->name, 256);
OPP_CheckMark(&*ProcedureDeclaration__16_s->vis);
OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp, &*ProcedureDeclaration__16_s->fwd);
OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp->BaseTyp, &baseProc);
@@ -1129,7 +1129,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
TProcDecl__23();
} else if (OPP_sym == 38) {
OPT_Find(&fwd);
- __COPY(OPS_name, name, 256);
+ __MOVE(OPS_name, name, 256);
OPP_CheckMark(&vis);
if ((vis != 0 && mode == 6)) {
mode = 7;
@@ -1665,6 +1665,9 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
obj->typ = OPT_undftyp;
OPP_CheckMark(&obj->vis);
if (OPP_sym == 9) {
+ if (((((((((__STRCMP(obj->name, "SHORTINT") == 0 || __STRCMP(obj->name, "INTEGER") == 0) || __STRCMP(obj->name, "LONGINT") == 0) || __STRCMP(obj->name, "HUGEINT") == 0) || __STRCMP(obj->name, "REAL") == 0) || __STRCMP(obj->name, "LONGREAL") == 0) || __STRCMP(obj->name, "SET") == 0) || __STRCMP(obj->name, "CHAR") == 0) || __STRCMP(obj->name, "TRUE") == 0) || __STRCMP(obj->name, "FALSE") == 0) {
+ OPM_Mark(-310, OPM_curpos);
+ }
OPS_Get(&OPP_sym);
OPP_TypeDecl(&obj->typ, &obj->typ);
} else if (OPP_sym == 34 || OPP_sym == 20) {
@@ -1790,30 +1793,10 @@ void OPP_Module (OPT_Node *prog, UINT32 opt)
if (OPP_sym == 63) {
OPS_Get(&OPP_sym);
} else {
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Unexpected symbol found when MODULE expected:", 46);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" sym: ", 15);
- OPM_LogWNum(OPP_sym, 1);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.name: ", 15);
- OPM_LogWStr(OPS_name, 256);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.str: ", 15);
- OPM_LogWStr(OPS_str, 256);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.numtyp: ", 15);
- OPM_LogWNum(OPS_numtyp, 1);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.intval: ", 15);
- OPM_LogWNum(OPS_intval, 1);
- OPM_LogWLn();
OPP_err(16);
}
if (OPP_sym == 38) {
- OPM_LogWStr((CHAR*)"compiling ", 11);
- OPM_LogWStr(OPS_name, 256);
- OPM_LogW('.');
+ OPM_LogCompiling(OPS_name, 256);
OPT_Init(OPS_name, opt);
OPS_Get(&OPP_sym);
OPP_CheckSym(39);
diff --git a/bootstrap/unix-48/OPP.h b/bootstrap/unix-48/OPP.h
index 5a71eb39..3d8cefe8 100644
--- a/bootstrap/unix-48/OPP.h
+++ b/bootstrap/unix-48/OPP.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 6ee700e5..a25a2c12 100644
--- a/bootstrap/unix-48/OPS.c
+++ b/bootstrap/unix-48/OPS.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,9 +196,9 @@ 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(9223372036854775807 - (INT64)d, 10)) {
+ if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) {
OPS_intval = OPS_intval * 10 + (INT64)d;
} else {
OPS_err(203);
@@ -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 1f7a3e58..19e222ac 100644
--- a/bootstrap/unix-48/OPS.h
+++ b/bootstrap/unix-48/OPS.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 75820a95..ebb47dd8 100644
--- a/bootstrap/unix-48/OPT.c
+++ b/bootstrap/unix-48/OPT.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -49,6 +49,15 @@ typedef
INT8 glbmno[64];
} OPT_ImpCtxt;
+typedef
+ struct OPT_LinkDesc *OPT_Link;
+
+typedef
+ struct OPT_LinkDesc {
+ OPS_Name name;
+ OPT_Link next;
+ } OPT_LinkDesc;
+
typedef
struct OPT_NodeDesc *OPT_Node;
@@ -74,6 +83,7 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
+ OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@@ -101,6 +111,7 @@ static OPT_ExpCtxt OPT_expCtxt;
static INT32 OPT_nofhdfld;
static BOOLEAN OPT_newsf, OPT_findpc, OPT_extsf, OPT_sfpresent, OPT_symExtended, OPT_symNew;
static INT32 OPT_recno;
+export OPT_Link OPT_Links;
export ADDRESS *OPT_ConstDesc__typ;
export ADDRESS *OPT_ObjDesc__typ;
@@ -108,6 +119,7 @@ export ADDRESS *OPT_StrDesc__typ;
export ADDRESS *OPT_NodeDesc__typ;
export ADDRESS *OPT_ImpCtxt__typ;
export ADDRESS *OPT_ExpCtxt__typ;
+export ADDRESS *OPT_LinkDesc__typ;
export void OPT_Align (INT32 *adr, INT32 base);
export INT32 OPT_BaseAlignment (OPT_Struct typ);
@@ -120,7 +132,7 @@ static void OPT_EnterTyp (OPS_Name name, INT8 form, INT16 size, OPT_Struct *res)
static void OPT_EnterTypeAlias (OPS_Name name, OPT_Object *res);
export void OPT_Export (BOOLEAN *ext, BOOLEAN *new);
export void OPT_FPrintErr (OPT_Object obj, INT16 errcode);
-static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len);
+static void OPT_FPrintName (INT32 *fp, CHAR *name, ADDRESS name__len);
export void OPT_FPrintObj (OPT_Object obj);
static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par);
export void OPT_FPrintStr (OPT_Struct typ);
@@ -131,8 +143,9 @@ export void OPT_IdFPrint (OPT_Struct typ);
export void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
static void OPT_InConstant (INT32 f, OPT_Const conval);
static OPT_Object OPT_InFld (void);
+static void OPT_InLinks (void);
static void OPT_InMod (INT8 *mno);
-static void OPT_InName (CHAR *name, LONGINT name__len);
+static void OPT_InName (CHAR *name, ADDRESS name__len);
static OPT_Object OPT_InObj (INT8 mno);
static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par);
static void OPT_InStruct (OPT_Struct *typ);
@@ -154,12 +167,14 @@ export void OPT_OpenScope (INT8 level, OPT_Object owner);
static void OPT_OutConstant (OPT_Object obj);
static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible);
static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr);
+static void OPT_OutLinks (void);
static void OPT_OutMod (INT16 mno);
-static void OPT_OutName (CHAR *name, LONGINT name__len);
+static void OPT_OutName (CHAR *name, ADDRESS name__len);
static void OPT_OutObj (OPT_Object obj);
static void OPT_OutSign (OPT_Struct result, OPT_Object par);
static void OPT_OutStr (OPT_Struct typ);
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj);
+static void OPT_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);
@@ -339,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;
@@ -375,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;
}
@@ -434,14 +453,16 @@ void OPT_Init (OPS_Name name, UINT32 opt)
OPT_topScope = OPT_universe;
OPT_OpenScope(0, NIL);
OPT_SYSimported = 0;
- __COPY(name, OPT_SelfName, 256);
- __COPY(name, OPT_topScope->name, 256);
+ __MOVE(name, OPT_SelfName, 256);
+ __MOVE(name, OPT_topScope->name, 256);
OPT_GlbMod[0] = OPT_topScope;
OPT_nofGmod = 1;
OPT_newsf = __IN(4, opt, 32);
OPT_findpc = __IN(8, opt, 32);
OPT_extsf = OPT_newsf || __IN(9, opt, 32);
OPT_sfpresent = 1;
+ __NEW(OPT_Links, OPT_LinkDesc);
+ __MOVE(name, OPT_Links->name, 256);
}
void OPT_Close (void)
@@ -539,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;
@@ -570,13 +593,23 @@ 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;
}
}
*obj = ob1;
}
-static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len)
+static void OPT_FPrintName (INT32 *fp, CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@@ -957,7 +990,7 @@ void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old)
}
}
-static void OPT_InName (CHAR *name, LONGINT name__len)
+static void OPT_InName (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@@ -1011,6 +1044,26 @@ static void OPT_InMod (INT8 *mno)
}
}
+static void OPT_InLinks (void)
+{
+ OPS_Name linkname;
+ OPT_Link l = NIL;
+ OPT_InName((void*)linkname, 256);
+ while (linkname[0] != 0x00) {
+ l = OPT_Links;
+ while ((l != NIL && __STRCMP(l->name, linkname) != 0)) {
+ l = l->next;
+ }
+ if (l == NIL) {
+ l = OPT_Links;
+ __NEW(OPT_Links, OPT_LinkDesc);
+ OPT_Links->next = l;
+ __MOVE(linkname, OPT_Links->name, 256);
+ }
+ OPT_InName((void*)linkname, 256);
+ }
+}
+
static void OPT_InConstant (INT32 f, OPT_Const conval)
{
CHAR ch;
@@ -1068,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) {
@@ -1186,7 +1246,7 @@ static void OPT_InStruct (OPT_Struct *typ)
}
*typ = OPT_NewStr(0, 1);
} else {
- __COPY(name, obj->name, 256);
+ __MOVE(name, obj->name, 256);
OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
if (old != NIL) {
OPT_FPrintObj(old);
@@ -1216,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) {
@@ -1346,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;
@@ -1362,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);
@@ -1377,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)]);
@@ -1389,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);
@@ -1458,9 +1565,15 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
OPT_impCtxt.nofm = 0;
OPT_impCtxt.self = __STRCMP(aliasName, "@self") == 0;
OPT_impCtxt.reffp = 0;
- OPM_OldSym((void*)name, 256, &*done);
+ if ((OPT_impCtxt.self && __IN(17, OPM_Options, 32))) {
+ OPM_DeleteSym((void*)name, 256);
+ *done = 0;
+ } else {
+ OPM_OldSym((void*)name, 256, &*done);
+ }
if (*done) {
OPT_InMod(&mno);
+ OPT_InLinks();
OPT_impCtxt.nextTag = OPM_SymRInt();
while (!OPM_eofSF()) {
obj = OPT_InObj(mno);
@@ -1483,7 +1596,7 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
}
}
-static void OPT_OutName (CHAR *name, LONGINT name__len)
+static void OPT_OutName (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@@ -1507,6 +1620,17 @@ static void OPT_OutMod (INT16 mno)
}
}
+static void OPT_OutLinks (void)
+{
+ OPT_Link l = NIL;
+ l = OPT_Links;
+ while (l != NIL) {
+ OPT_OutName((void*)l->name, 256);
+ l = l->next;
+ }
+ OPM_SymWCh(0x00);
+}
+
static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr)
{
INT32 i, j, n;
@@ -1700,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);
@@ -1728,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) {
@@ -1833,6 +1984,7 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
if (OPM_noerr) {
OPM_SymWInt(16);
OPT_OutName((void*)OPT_SelfName, 256);
+ OPT_OutLinks();
OPT_expCtxt.reffp = 0;
OPT_expCtxt.ref = 14;
OPT_expCtxt.nofm = 1;
@@ -1854,7 +2006,7 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
OPT_newsf = 0;
OPT_symNew = 0;
if (!OPM_noerr || OPT_findpc) {
- OPM_DeleteNewSym();
+ OPM_DeleteSym((void*)OPT_SelfName, 256);
}
}
}
@@ -1969,10 +2121,11 @@ static void EnumPtrs(void (*P)(void*))
P(OPT_universe);
P(OPT_syslink);
__ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 3140, 1, P);
+ P(OPT_Links);
}
__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,
@@ -2008,6 +2161,7 @@ __TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 3140), {16, 20, 24, 28, 32,
1936, 1940, 1944, 1948, 1952, 1956, 1960, 1964, 1968, 1972, 1976, 1980, 1984, 1988, 1992, 1996,
2000, 2004, 2008, 2012, 2016, 2020, 2024, 2028, 2032, 2036, 2040, 2044, 2048, 2052, -2044}};
__TDESC(OPT_ExpCtxt, 1, 0) = {__TDFLDS("ExpCtxt", 72), {-4}};
+__TDESC(OPT_LinkDesc, 1, 1) = {__TDFLDS("LinkDesc", 260), {256, -8}};
export void *OPT__init(void)
{
@@ -2024,6 +2178,7 @@ export void *OPT__init(void)
__INITYP(OPT_NodeDesc, OPT_NodeDesc, 0);
__INITYP(OPT_ImpCtxt, OPT_ImpCtxt, 0);
__INITYP(OPT_ExpCtxt, OPT_ExpCtxt, 0);
+ __INITYP(OPT_LinkDesc, OPT_LinkDesc, 0);
/* BEGIN */
OPT_topScope = NIL;
OPT_OpenScope(0, NIL);
diff --git a/bootstrap/unix-48/OPT.h b/bootstrap/unix-48/OPT.h
index 90fcacf5..cf456af5 100644
--- a/bootstrap/unix-48/OPT.h
+++ b/bootstrap/unix-48/OPT.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -21,6 +21,15 @@ typedef
LONGREAL realval;
} OPT_ConstDesc;
+typedef
+ struct OPT_LinkDesc *OPT_Link;
+
+typedef
+ struct OPT_LinkDesc {
+ OPS_Name name;
+ OPT_Link next;
+ } OPT_LinkDesc;
+
typedef
struct OPT_NodeDesc *OPT_Node;
@@ -52,6 +61,7 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
+ OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@@ -75,11 +85,13 @@ import INT8 OPT_nofGmod;
import OPT_Object OPT_GlbMod[64];
import OPS_Name OPT_SelfName;
import BOOLEAN OPT_SYSimported;
+import OPT_Link OPT_Links;
import ADDRESS *OPT_ConstDesc__typ;
import ADDRESS *OPT_ObjDesc__typ;
import ADDRESS *OPT_StrDesc__typ;
import ADDRESS *OPT_NodeDesc__typ;
+import ADDRESS *OPT_LinkDesc__typ;
import void OPT_Align (INT32 *adr, INT32 base);
import INT32 OPT_BaseAlignment (OPT_Struct typ);
diff --git a/bootstrap/unix-48/OPV.c b/bootstrap/unix-48/OPV.c
index 5c21cb97..0425b2e0 100644
--- a/bootstrap/unix-48/OPV.c
+++ b/bootstrap/unix-48/OPV.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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));
@@ -163,7 +163,7 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
}
scope = obj->scope;
scope->leaf = 1;
- __COPY(obj->name, scope->name, 256);
+ __MOVE(obj->name, scope->name, 256);
OPV_Stamp(scope->name);
if (mode == 9) {
obj->adr = 1;
@@ -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);
@@ -1286,7 +1297,17 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPM_WriteString((CHAR*)", ", 3);
if (r->typ == OPT_stringtyp) {
OPM_WriteInt(r->conval->intval2);
+ } else if (r->typ->comp == 3) {
+ OPM_WriteString((CHAR*)"__X(", 5);
+ OPC_Len(r->obj, r->typ, 0);
+ OPM_WriteString((CHAR*)" * ", 4);
+ OPM_WriteInt(r->typ->BaseTyp->size);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteInt(l->typ->size + 1);
+ OPM_Write(')');
} else {
+ __ASSERT(r->typ->comp == 2, 0);
+ __ASSERT(r->typ->size <= l->typ->size, 0);
OPM_WriteInt(r->typ->size);
}
OPM_Write(')');
diff --git a/bootstrap/unix-48/OPV.h b/bootstrap/unix-48/OPV.h
index c4a61586..fbabd8f4 100644
--- a/bootstrap/unix-48/OPV.h
+++ b/bootstrap/unix-48/OPV.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 39f383cf..ce936589 100644
--- a/bootstrap/unix-48/Out.c
+++ b/bootstrap/unix-48/Out.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 "Heap.h"
#include "Platform.h"
@@ -16,17 +17,18 @@ static INT16 Out_in;
export void Out_Char (CHAR ch);
export void Out_Flush (void);
+export void Out_Hex (INT64 x, INT64 n);
export void Out_Int (INT64 x, INT64 n);
-static INT32 Out_Length (CHAR *s, LONGINT s__len);
+static INT32 Out_Length (CHAR *s, ADDRESS s__len);
export void Out_Ln (void);
export void Out_LongReal (LONGREAL x, INT16 n);
export void Out_Open (void);
export void Out_Real (REAL x, INT16 n);
static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_);
-export void Out_String (CHAR *str, LONGINT str__len);
+export void Out_String (CHAR *str, ADDRESS str__len);
export LONGREAL Out_Ten (INT16 e);
-static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i);
-static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i);
+static void Out_digit (INT64 n, CHAR *s, ADDRESS s__len, INT16 *i);
+static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i);
#define Out_Entier64(x) (INT64)(x)
@@ -55,7 +57,7 @@ void Out_Char (CHAR ch)
}
}
-static INT32 Out_Length (CHAR *s, LONGINT s__len)
+static INT32 Out_Length (CHAR *s, ADDRESS s__len)
{
INT32 l;
l = 0;
@@ -65,7 +67,7 @@ static INT32 Out_Length (CHAR *s, LONGINT s__len)
return l;
}
-void Out_String (CHAR *str, LONGINT str__len)
+void Out_String (CHAR *str, ADDRESS str__len)
{
INT32 l;
INT16 error;
@@ -78,7 +80,7 @@ void Out_String (CHAR *str, LONGINT 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);
}
@@ -89,18 +91,18 @@ void Out_Int (INT64 x, INT64 n)
INT16 i;
BOOLEAN negative;
negative = x < 0;
- if (x == (-9223372036854775807-1)) {
+ if (x == (-9223372036854775807LL-1)) {
__MOVE("8085774586302733229", s, 20);
i = 19;
} else {
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;
}
@@ -119,19 +121,43 @@ void Out_Int (INT64 x, INT64 n)
}
}
+void Out_Hex (INT64 x, INT64 n)
+{
+ if (n < 1) {
+ n = 1;
+ } else if (n > 16) {
+ n = 16;
+ }
+ if (x >= 0) {
+ while ((n < 16 && __LSH(x, -__ASHL(n, 2), 64) != 0)) {
+ n += 1;
+ }
+ }
+ x = __ROT(x, __ASHL(16 - n, 2), 64);
+ while (n > 0) {
+ x = __ROTL(x, 4, 64);
+ n -= 1;
+ if (__MASK(x, -16) < 10) {
+ Out_Char(__CHR(__MASK(x, -16) + 48));
+ } else {
+ Out_Char(__CHR((__MASK(x, -16) - 10) + 65));
+ }
+ }
+}
+
void Out_Ln (void)
{
Out_String(Platform_NL, 3);
Out_Flush();
}
-static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i)
+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, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i)
+static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i)
{
INT16 j;
INT32 l;
@@ -140,7 +166,7 @@ static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT 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)];
@@ -175,7 +201,7 @@ static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_)
INT64 m;
INT16 d, dr;
e = (INT16)__MASK(__ASHR((__VAL(INT64, x)), 52), -2048);
- f = __MASK((__VAL(INT64, x)), -4503599627370496);
+ f = __MASK((__VAL(INT64, x)), -4503599627370496LL);
nn = (__VAL(INT64, x) < 0 && !((e == 2047 && f != 0)));
if (nn) {
n -= 1;
@@ -222,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 {
@@ -306,6 +332,7 @@ void Out_LongReal (LONGREAL x, INT16 n)
export void *Out__init(void)
{
__DEFMOD;
+ __MODULE_IMPORT(Heap);
__MODULE_IMPORT(Platform);
__REGMOD("Out", 0);
__REGCMD("Flush", Out_Flush);
diff --git a/bootstrap/unix-48/Out.h b/bootstrap/unix-48/Out.h
index 0e66420d..a72547f4 100644
--- a/bootstrap/unix-48/Out.h
+++ b/bootstrap/unix-48/Out.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -11,12 +11,13 @@ import BOOLEAN Out_IsConsole;
import void Out_Char (CHAR ch);
import void Out_Flush (void);
+import void Out_Hex (INT64 x, INT64 n);
import void Out_Int (INT64 x, INT64 n);
import void Out_Ln (void);
import void Out_LongReal (LONGREAL x, INT16 n);
import void Out_Open (void);
import void Out_Real (REAL x, INT16 n);
-import void Out_String (CHAR *str, LONGINT str__len);
+import void Out_String (CHAR *str, ADDRESS str__len);
import LONGREAL Out_Ten (INT16 e);
import void *Out__init(void);
diff --git a/bootstrap/unix-48/Platform.c b/bootstrap/unix-48/Platform.c
index 72c15bf8..befa6033 100644
--- a/bootstrap/unix-48/Platform.c
+++ b/bootstrap/unix-48/Platform.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,37 +7,18 @@
#include "SYSTEM.h"
-typedef
- CHAR (*Platform_ArgPtr)[1024];
-
-typedef
- Platform_ArgPtr (*Platform_ArgVec)[1024];
-
-typedef
- INT32 (*Platform_ArgVecPtr)[1];
-
-typedef
- CHAR (*Platform_EnvPtr)[1024];
-
typedef
struct Platform_FileIdentity {
INT32 volume, index, mtime;
} Platform_FileIdentity;
-typedef
- void (*Platform_HaltProcedure)(INT32);
-
typedef
void (*Platform_SignalHandler)(INT32);
export BOOLEAN Platform_LittleEndian;
-export INT32 Platform_MainStackFrame;
export INT16 Platform_PID;
export CHAR Platform_CWD[256];
-export INT16 Platform_ArgCount;
-export INT32 Platform_ArgVector;
-static Platform_HaltProcedure Platform_HaltHandler;
static INT32 Platform_TimeStart;
export INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
export CHAR Platform_NL[3];
@@ -45,35 +26,33 @@ export CHAR Platform_NL[3];
export ADDRESS *Platform_FileIdentity__typ;
export BOOLEAN Platform_Absent (INT16 e);
-export INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
-export INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
+export INT16 Platform_Chdir (CHAR *n, ADDRESS n__len);
export INT16 Platform_Close (INT32 h);
export BOOLEAN Platform_ConnectionFailed (INT16 e);
export void Platform_Delay (INT32 ms);
export BOOLEAN Platform_DifferentFilesystems (INT16 e);
export INT16 Platform_Error (void);
export void Platform_Exit (INT32 code);
-export void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
export void Platform_GetClock (INT32 *t, INT32 *d);
-export void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
-export void Platform_GetIntArg (INT16 n, INT32 *val);
+export void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
export void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec);
export INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *identity__typ);
-export INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
+export INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
export BOOLEAN Platform_Inaccessible (INT16 e);
-export void Platform_Init (INT32 argc, INT32 argvadr);
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_New (CHAR *n, LONGINT n__len, INT32 *h);
+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);
export void Platform_OSFree (INT32 address);
-export INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h);
-export INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h);
+export INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h);
+export INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h);
export INT16 Platform_Read (INT32 h, INT32 p, INT32 l, INT32 *n);
-export INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n);
-export INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
+export INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n);
+export INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len);
export BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2);
export BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2);
export INT16 Platform_Seek (INT32 h, INT32 offset, INT16 whence);
@@ -83,16 +62,16 @@ export void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__t
export void Platform_SetQuitHandler (Platform_SignalHandler handler);
export INT16 Platform_Size (INT32 h, INT32 *l);
export INT16 Platform_Sync (INT32 h);
-export INT16 Platform_System (CHAR *cmd, LONGINT cmd__len);
+export INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len);
static void Platform_TestLittleEndian (void);
export INT32 Platform_Time (void);
export BOOLEAN Platform_TimedOut (INT16 e);
export BOOLEAN Platform_TooManyFiles (INT16 e);
export INT16 Platform_Truncate (INT32 h, INT32 l);
-export INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
+export INT16 Platform_Unlink (CHAR *n, ADDRESS n__len);
export INT16 Platform_Write (INT32 h, INT32 p, INT32 l);
static void Platform_YMDHMStoClock (INT32 ye, INT32 mo, INT32 da, INT32 ho, INT32 mi, INT32 se, INT32 *t, INT32 *d);
-export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
+export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
#include
#include
@@ -102,6 +81,7 @@ export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT
#include
#include
#include
+#include
#include
#include
#define Platform_EACCES() EACCES
@@ -117,8 +97,8 @@ export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT
#define Platform_EROFS() EROFS
#define Platform_ETIMEDOUT() ETIMEDOUT
#define Platform_EXDEV() EXDEV
-extern void Heap_InitHeap();
-#define Platform_HeapInitHeap() Heap_InitHeap()
+#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)
@@ -129,7 +109,7 @@ extern void Heap_InitHeap();
#define Platform_fsync(fd) fsync(fd)
#define Platform_ftruncate(fd, l) ftruncate(fd, l)
#define Platform_getcwd(cwd, cwd__len) getcwd((char*)cwd, cwd__len)
-#define Platform_getenv(var, var__len) (Platform_EnvPtr)getenv((char*)var)
+#define Platform_getenv(var, var__len) getenv((char*)var)
#define Platform_getpid() (INTEGER)getpid()
#define Platform_gettimeval() struct timeval tv; gettimeofday(&tv,0)
#define Platform_isatty(fd) isatty(fd)
@@ -203,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);
@@ -213,21 +203,14 @@ void Platform_OSFree (INT32 address)
Platform_free(address);
}
-void Platform_Init (INT32 argc, INT32 argvadr)
-{
- Platform_ArgVecPtr av = NIL;
- Platform_MainStackFrame = argvadr;
- Platform_ArgCount = __VAL(INT16, argc);
- av = (Platform_ArgVecPtr)(ADDRESS)argvadr;
- Platform_ArgVector = (*av)[0];
- Platform_HeapInitHeap();
-}
+typedef
+ CHAR (*EnvPtr__83)[1024];
-BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
+BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{
- Platform_EnvPtr p = NIL;
+ EnvPtr__83 p = NIL;
__DUP(var, var__len, CHAR);
- p = Platform_getenv(var, var__len);
+ p = (EnvPtr__83)(ADDRESS)Platform_getenv(var, var__len);
if (p != NIL) {
__COPY(*p, val, val__len);
}
@@ -235,7 +218,7 @@ BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__le
return p != NIL;
}
-void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
+void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{
__DUP(var, var__len, CHAR);
if (!Platform_getEnv(var, var__len, (void*)val, val__len)) {
@@ -244,56 +227,6 @@ void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
__DEL(var);
}
-void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len)
-{
- Platform_ArgVec av = NIL;
- if (n < Platform_ArgCount) {
- av = (Platform_ArgVec)(ADDRESS)Platform_ArgVector;
- __COPY(*(*av)[__X(n, 1024)], val, val__len);
- }
-}
-
-void Platform_GetIntArg (INT16 n, INT32 *val)
-{
- CHAR s[64];
- INT32 k, d, i;
- s[0] = 0x00;
- Platform_GetArg(n, (void*)s, 64);
- i = 0;
- if (s[0] == '-') {
- i = 1;
- }
- k = 0;
- d = (INT16)s[__X(i, 64)] - 48;
- while ((d >= 0 && d <= 9)) {
- k = k * 10 + d;
- i += 1;
- d = (INT16)s[__X(i, 64)] - 48;
- }
- if (s[0] == '-') {
- k = -k;
- i -= 1;
- }
- if (i > 0) {
- *val = k;
- }
-}
-
-INT16 Platform_ArgPos (CHAR *s, LONGINT s__len)
-{
- INT16 i;
- CHAR arg[256];
- __DUP(s, s__len, CHAR);
- i = 0;
- Platform_GetArg(i, (void*)arg, 256);
- while ((i < Platform_ArgCount && __STRCMP(s, arg) != 0)) {
- i += 1;
- Platform_GetArg(i, (void*)arg, 256);
- }
- __DEL(s);
- return i;
-}
-
void Platform_SetInterruptHandler (Platform_SignalHandler handler)
{
Platform_sethandler(2, handler);
@@ -345,7 +278,7 @@ void Platform_Delay (INT32 ms)
Platform_nanosleep(s, ns);
}
-INT16 Platform_System (CHAR *cmd, LONGINT cmd__len)
+INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len)
{
__DUP(cmd, cmd__len, CHAR);
__DEL(cmd);
@@ -357,7 +290,7 @@ INT16 Platform_Error (void)
return Platform_err();
}
-INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h)
+INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h)
{
INT16 fd;
fd = Platform_openro(n, n__len);
@@ -370,7 +303,7 @@ INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h)
__RETCHK;
}
-INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h)
+INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h)
{
INT16 fd;
fd = Platform_openrw(n, n__len);
@@ -383,7 +316,7 @@ INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h)
__RETCHK;
}
-INT16 Platform_New (CHAR *n, LONGINT n__len, INT32 *h)
+INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h)
{
INT16 fd;
fd = Platform_opennew(n, n__len);
@@ -423,7 +356,7 @@ INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *iden
return 0;
}
-INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
+INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{
__DUP(n, n__len, CHAR);
Platform_structstats();
@@ -481,7 +414,7 @@ INT16 Platform_Read (INT32 h, INT32 p, INT32 l, INT32 *n)
__RETCHK;
}
-INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n)
+INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n)
{
*n = Platform_readfile(h, (ADDRESS)b, b__len);
if (*n < 0) {
@@ -535,7 +468,7 @@ INT16 Platform_Truncate (INT32 h, INT32 l)
__RETCHK;
}
-INT16 Platform_Unlink (CHAR *n, LONGINT n__len)
+INT16 Platform_Unlink (CHAR *n, ADDRESS n__len)
{
if (Platform_unlink(n, n__len) < 0) {
return Platform_err();
@@ -545,7 +478,7 @@ INT16 Platform_Unlink (CHAR *n, LONGINT n__len)
__RETCHK;
}
-INT16 Platform_Chdir (CHAR *n, LONGINT n__len)
+INT16 Platform_Chdir (CHAR *n, ADDRESS n__len)
{
INT16 r;
if ((Platform_chdir(n, n__len) >= 0 && Platform_getcwd((void*)Platform_CWD, 256) != NIL)) {
@@ -556,7 +489,7 @@ INT16 Platform_Chdir (CHAR *n, LONGINT n__len)
__RETCHK;
}
-INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len)
+INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len)
{
if (Platform_rename(o, o__len, n, n__len) < 0) {
return Platform_err();
@@ -587,7 +520,6 @@ export void *Platform__init(void)
__INITYP(Platform_FileIdentity, Platform_FileIdentity, 0);
/* BEGIN */
Platform_TestLittleEndian();
- Platform_HaltHandler = NIL;
Platform_TimeStart = 0;
Platform_TimeStart = Platform_Time();
Platform_PID = Platform_getpid();
diff --git a/bootstrap/unix-48/Platform.h b/bootstrap/unix-48/Platform.h
index b04f552d..fbeef8c7 100644
--- a/bootstrap/unix-48/Platform.h
+++ b/bootstrap/unix-48/Platform.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -16,46 +16,41 @@ typedef
import BOOLEAN Platform_LittleEndian;
-import INT32 Platform_MainStackFrame;
import INT16 Platform_PID;
import CHAR Platform_CWD[256];
-import INT16 Platform_ArgCount;
-import INT32 Platform_ArgVector;
import INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
import CHAR Platform_NL[3];
import ADDRESS *Platform_FileIdentity__typ;
import BOOLEAN Platform_Absent (INT16 e);
-import INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
-import INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
+import INT16 Platform_Chdir (CHAR *n, ADDRESS n__len);
import INT16 Platform_Close (INT32 h);
import BOOLEAN Platform_ConnectionFailed (INT16 e);
import void Platform_Delay (INT32 ms);
import BOOLEAN Platform_DifferentFilesystems (INT16 e);
import INT16 Platform_Error (void);
import void Platform_Exit (INT32 code);
-import void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
import void Platform_GetClock (INT32 *t, INT32 *d);
-import void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
-import void Platform_GetIntArg (INT16 n, INT32 *val);
+import void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
import void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec);
import INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *identity__typ);
-import INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
+import INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
import BOOLEAN Platform_Inaccessible (INT16 e);
-import void Platform_Init (INT32 argc, INT32 argvadr);
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_New (CHAR *n, LONGINT n__len, INT32 *h);
+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);
import void Platform_OSFree (INT32 address);
-import INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h);
-import INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h);
+import INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h);
+import INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h);
import INT16 Platform_Read (INT32 h, INT32 p, INT32 l, INT32 *n);
-import INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n);
-import INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
+import INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n);
+import INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len);
import BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2);
import BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2);
import INT16 Platform_Seek (INT32 h, INT32 offset, INT16 whence);
@@ -65,14 +60,14 @@ import void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__t
import void Platform_SetQuitHandler (Platform_SignalHandler handler);
import INT16 Platform_Size (INT32 h, INT32 *l);
import INT16 Platform_Sync (INT32 h);
-import INT16 Platform_System (CHAR *cmd, LONGINT cmd__len);
+import INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len);
import INT32 Platform_Time (void);
import BOOLEAN Platform_TimedOut (INT16 e);
import BOOLEAN Platform_TooManyFiles (INT16 e);
import INT16 Platform_Truncate (INT32 h, INT32 l);
-import INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
+import INT16 Platform_Unlink (CHAR *n, ADDRESS n__len);
import INT16 Platform_Write (INT32 h, INT32 p, INT32 l);
-import BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
+import BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
import void *Platform__init(void);
diff --git a/bootstrap/unix-48/Reals.c b/bootstrap/unix-48/Reals.c
index cd4c3c61..512ec2c4 100644
--- a/bootstrap/unix-48/Reals.c
+++ b/bootstrap/unix-48/Reals.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -10,11 +10,11 @@
-static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len);
-export void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len);
-export void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len);
-export void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len);
-export void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len);
+static void Reals_BytesToHex (SYSTEM_BYTE *b, ADDRESS b__len, SYSTEM_BYTE *d, ADDRESS d__len);
+export void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len);
+export void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len);
+export void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len);
+export void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len);
export INT16 Reals_Expo (REAL x);
export INT16 Reals_ExpoL (LONGREAL x);
export void Reals_SetExpo (REAL *x, INT16 ex);
@@ -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)
@@ -79,7 +79,7 @@ INT16 Reals_ExpoL (LONGREAL x)
return __MASK(__ASHR(i, 4), -2048);
}
-void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len)
+void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len)
{
INT32 i, j, k;
if (x < (LONGREAL)0) {
@@ -87,27 +87,27 @@ void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT 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;
}
}
-void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len)
+void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len)
{
Reals_ConvertL(x, n, (void*)d, d__len);
}
@@ -115,14 +115,14 @@ void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT 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;
}
-static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len)
+static void Reals_BytesToHex (SYSTEM_BYTE *b, ADDRESS b__len, SYSTEM_BYTE *d, ADDRESS d__len)
{
INT16 i;
INT32 l;
@@ -137,12 +137,12 @@ static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LO
}
}
-void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len)
+void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len)
{
Reals_BytesToHex((void*)&y, 4, (void*)d, d__len * 1);
}
-void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len)
+void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len)
{
Reals_BytesToHex((void*)&x, 8, (void*)d, d__len * 1);
}
diff --git a/bootstrap/unix-48/Reals.h b/bootstrap/unix-48/Reals.h
index f0c84ab1..93e7fa75 100644
--- a/bootstrap/unix-48/Reals.h
+++ b/bootstrap/unix-48/Reals.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -8,10 +8,10 @@
-import void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len);
-import void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len);
-import void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len);
-import void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len);
+import void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len);
+import void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len);
+import void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len);
+import void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len);
import INT16 Reals_Expo (REAL x);
import INT16 Reals_ExpoL (LONGREAL x);
import void Reals_SetExpo (REAL *x, INT16 ex);
diff --git a/bootstrap/unix-48/Strings.c b/bootstrap/unix-48/Strings.c
index b5707327..4b18812f 100644
--- a/bootstrap/unix-48/Strings.c
+++ b/bootstrap/unix-48/Strings.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,22 +6,25 @@
#define SET UINT32
#include "SYSTEM.h"
+#include "Reals.h"
-export void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
-export void Strings_Cap (CHAR *s, LONGINT s__len);
-export void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n);
-export void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len);
-export void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
-export INT16 Strings_Length (CHAR *s, LONGINT s__len);
-export BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len);
-export INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos);
-export void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
+export void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len);
+export void Strings_Cap (CHAR *s, ADDRESS s__len);
+export void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n);
+export void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len);
+export void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len);
+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, LONGINT s__len)
+INT16 Strings_Length (CHAR *s, ADDRESS s__len)
{
INT32 i;
__DUP(s, s__len, CHAR);
@@ -31,7 +34,7 @@ INT16 Strings_Length (CHAR *s, LONGINT s__len)
}
if (i <= 32767) {
__DEL(s);
- return (INT16)i;
+ return __SHORT(i, 32768);
} else {
__DEL(s);
return 32767;
@@ -39,7 +42,7 @@ INT16 Strings_Length (CHAR *s, LONGINT s__len)
__RETCHK;
}
-void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len)
+void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len)
{
INT16 n1, n2, i;
__DUP(extra, extra__len, CHAR);
@@ -56,7 +59,7 @@ void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__
__DEL(extra);
}
-void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
+void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
{
INT16 n1, n2, i;
__DUP(source, source__len, CHAR);
@@ -87,7 +90,7 @@ void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, L
__DEL(source);
}
-void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n)
+void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n)
{
INT16 len, i;
len = Strings_Length(s, s__len);
@@ -110,7 +113,7 @@ void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n)
}
}
-void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
+void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
{
__DUP(source, source__len, CHAR);
Strings_Delete((void*)dest, dest__len, pos, pos + Strings_Length(source, source__len));
@@ -118,12 +121,12 @@ void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest,
__DEL(source);
}
-void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len)
+void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len)
{
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;
}
@@ -143,7 +146,7 @@ void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHA
__DEL(source);
}
-INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos)
+INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos)
{
INT16 n1, n2, i, j;
__DUP(pattern, pattern__len, CHAR);
@@ -175,7 +178,7 @@ INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len,
return -1;
}
-void Strings_Cap (CHAR *s, LONGINT s__len)
+void Strings_Cap (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@@ -191,9 +194,9 @@ static struct Match__7 {
struct Match__7 *lnk;
} *Match__7_s;
-static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m);
+static BOOLEAN M__8 (CHAR *name, ADDRESS name__len, CHAR *mask, ADDRESS mask__len, INT16 n, INT16 m);
-static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m)
+static BOOLEAN M__8 (CHAR *name, ADDRESS name__len, CHAR *mask, ADDRESS mask__len, INT16 n, INT16 m)
{
while ((((n >= 0 && m >= 0)) && mask[__X(m, mask__len)] != '*')) {
if (name[__X(n, name__len)] != mask[__X(m, mask__len)]) {
@@ -220,7 +223,7 @@ static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__le
return 0;
}
-BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len)
+BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len)
{
struct Match__7 _s;
BOOLEAN __retval;
@@ -236,10 +239,135 @@ BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT
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 c987af8d..f0e3ae34 100644
--- a/bootstrap/unix-48/Strings.h
+++ b/bootstrap/unix-48/Strings.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -8,15 +8,17 @@
-import void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
-import void Strings_Cap (CHAR *s, LONGINT s__len);
-import void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n);
-import void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len);
-import void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
-import INT16 Strings_Length (CHAR *s, LONGINT s__len);
-import BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len);
-import INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos);
-import void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
+import void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len);
+import void Strings_Cap (CHAR *s, ADDRESS s__len);
+import void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n);
+import void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len);
+import void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len);
+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 ad26b1cb..43c3858f 100644
--- a/bootstrap/unix-48/Texts.c
+++ b/bootstrap/unix-48/Texts.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -187,20 +187,20 @@ export void Texts_Append (Texts_Text T, Texts_Buffer B);
export void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
static Texts_Elem Texts_CloneElem (Texts_Elem e);
static Texts_Piece Texts_ClonePiece (Texts_Piece p);
-export void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
+export void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len);
export void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
export void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
export void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
export Texts_Text Texts_ElemBase (Texts_Elem E);
export INT32 Texts_ElemPos (Texts_Elem E);
static void Texts_Find (Texts_Text T, INT32 *pos, Texts_Run *u, INT32 *org, INT32 *off);
-static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len);
+static Texts_FontsFont Texts_FontsThis (CHAR *name, ADDRESS name__len);
static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__typ);
export void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
export void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
static void Texts_Load0 (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v);
-export void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
+export void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len);
export void Texts_OpenBuf (Texts_Buffer B);
export void Texts_OpenReader (Texts_Reader *R, ADDRESS *R__typ, Texts_Text T, INT32 pos);
export void Texts_OpenScanner (Texts_Scanner *S, ADDRESS *S__typ, Texts_Text T, INT32 pos);
@@ -229,10 +229,10 @@ export void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x
export void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
export void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
export void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
-export void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
+export void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len);
-static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len)
+static Texts_FontsFont Texts_FontsThis (CHAR *name, ADDRESS name__len)
{
Texts_FontsFont F = NIL;
__NEW(F, Texts_FontDesc);
@@ -390,27 +390,27 @@ static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__t
if (__IS(msg__typ, Texts_CopyMsg, 1)) {
Texts_CopyMsg *msg__ = (void*)msg;
__NEW(e, Texts__1);
- Texts_CopyElem((void*)((Texts_Alien)E), (void*)e);
- e->file = ((Texts_Alien)E)->file;
- e->org = ((Texts_Alien)E)->org;
- e->span = ((Texts_Alien)E)->span;
- __COPY(((Texts_Alien)E)->mod, e->mod, 32);
- __COPY(((Texts_Alien)E)->proc, e->proc, 32);
+ Texts_CopyElem((void*)(*(Texts_Alien*)&E), (void*)e);
+ e->file = (*(Texts_Alien*)&E)->file;
+ e->org = (*(Texts_Alien*)&E)->org;
+ e->span = (*(Texts_Alien*)&E)->span;
+ __MOVE((*(Texts_Alien*)&E)->mod, e->mod, 32);
+ __MOVE((*(Texts_Alien*)&E)->proc, e->proc, 32);
(*msg__).e = (Texts_Elem)e;
} else __WITHCHK;
} else if (__IS(msg__typ, Texts_IdentifyMsg, 1)) {
if (__IS(msg__typ, Texts_IdentifyMsg, 1)) {
Texts_IdentifyMsg *msg__ = (void*)msg;
- __COPY(((Texts_Alien)E)->mod, (*msg__).mod, 32);
- __COPY(((Texts_Alien)E)->proc, (*msg__).proc, 32);
+ __COPY((*(Texts_Alien*)&E)->mod, (*msg__).mod, 32);
+ __COPY((*(Texts_Alien*)&E)->proc, (*msg__).proc, 32);
(*msg__).mod[31] = 0x01;
} else __WITHCHK;
} else if (__IS(msg__typ, Texts_FileMsg, 1)) {
if (__IS(msg__typ, Texts_FileMsg, 1)) {
Texts_FileMsg *msg__ = (void*)msg;
if ((*msg__).id == 1) {
- Files_Set(&r, Files_Rider__typ, ((Texts_Alien)E)->file, ((Texts_Alien)E)->org);
- i = ((Texts_Alien)E)->span;
+ Files_Set(&r, Files_Rider__typ, (*(Texts_Alien*)&E)->file, (*(Texts_Alien*)&E)->org);
+ i = (*(Texts_Alien*)&E)->span;
while (i > 0) {
Files_Read(&r, Files_Rider__typ, (void*)&ch);
Files_Write(&(*msg__).r, Files_Rider__typ, ch);
@@ -646,7 +646,7 @@ void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch)
u = u->next;
if (__ISP(u, Texts_PieceDesc, 1)) {
if (__ISP(u, Texts_PieceDesc, 1)) {
- Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
+ Files_Set(&(*R).rider, Files_Rider__typ, (*(Texts_Piece*)&u)->file, (*(Texts_Piece*)&u)->org);
} else __WITHCHK;
}
(*R).run = u;
@@ -673,7 +673,7 @@ void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ)
(*R).elem = __GUARDP(u, Texts_ElemDesc, 1);
if (__ISP(un, Texts_PieceDesc, 1)) {
if (__ISP(un, Texts_PieceDesc, 1)) {
- Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)un)->file, ((Texts_Piece)un)->org);
+ Files_Set(&(*R).rider, Files_Rider__typ, (*(Texts_Piece*)&un)->file, (*(Texts_Piece*)&un)->org);
} else __WITHCHK;
}
} else {
@@ -812,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;
}
@@ -1027,7 +1027,7 @@ void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ)
Texts_Write(&*W, W__typ, 0x0d);
}
-void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len)
+void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
@@ -1046,7 +1046,7 @@ void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n)
CHAR a[24];
i = 0;
if (x < 0) {
- if (x == (-9223372036854775807-1)) {
+ if (x == (-9223372036854775807LL-1)) {
Texts_WriteString(&*W, W__typ, (CHAR*)" -9223372036854775808", 22);
return;
} else {
@@ -1057,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));
@@ -1084,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;
@@ -1162,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));
}
}
@@ -1313,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 {
@@ -1344,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));
}
}
@@ -1374,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)
@@ -1406,8 +1406,8 @@ static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span
static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span, Texts_Elem *e)
{
- Modules_Module M = NIL;
- Modules_Command Cmd;
+ Heap_Module M = NIL;
+ Heap_Command Cmd;
Texts_Alien a = NIL;
INT32 org, ew, eh;
INT8 eno;
@@ -1539,7 +1539,7 @@ void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
Texts_Load0(&*r, r__typ, T);
}
-void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len)
+void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
Files_Rider r;
@@ -1715,9 +1715,9 @@ void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
while (u != T->head) {
if (__ISP(u, Texts_PieceDesc, 1)) {
if (__ISP(u, Texts_PieceDesc, 1)) {
- if (((Texts_Piece)u)->ascii) {
- Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
- delta = ((Texts_Piece)u)->len;
+ if ((*(Texts_Piece*)&u)->ascii) {
+ Files_Set(&r1, Files_Rider__typ, (*(Texts_Piece*)&u)->file, (*(Texts_Piece*)&u)->org);
+ delta = (*(Texts_Piece*)&u)->len;
while (delta > 0) {
Files_Read(&r1, Files_Rider__typ, (void*)&ch);
delta -= 1;
@@ -1728,8 +1728,8 @@ void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
}
}
} else {
- Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
- delta = ((Texts_Piece)u)->len;
+ Files_Set(&r1, Files_Rider__typ, (*(Texts_Piece*)&u)->file, (*(Texts_Piece*)&u)->org);
+ delta = (*(Texts_Piece*)&u)->len;
while (delta > 1024) {
Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, 1024, 1024);
Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, 1024, 1024);
@@ -1755,7 +1755,7 @@ void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
Store__39_s = _s.lnk;
}
-void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len)
+void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
Files_Rider r;
diff --git a/bootstrap/unix-48/Texts.h b/bootstrap/unix-48/Texts.h
index e2c03958..fd0c0fa5 100644
--- a/bootstrap/unix-48/Texts.h
+++ b/bootstrap/unix-48/Texts.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -131,7 +131,7 @@ import ADDRESS *Texts_Writer__typ;
import void Texts_Append (Texts_Text T, Texts_Buffer B);
import void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
-import void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
+import void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len);
import void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
import void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
import void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
@@ -139,7 +139,7 @@ import Texts_Text Texts_ElemBase (Texts_Elem E);
import INT32 Texts_ElemPos (Texts_Elem E);
import void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
import void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
-import void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
+import void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len);
import void Texts_OpenBuf (Texts_Buffer B);
import void Texts_OpenReader (Texts_Reader *R, ADDRESS *R__typ, Texts_Text T, INT32 pos);
import void Texts_OpenScanner (Texts_Scanner *S, ADDRESS *S__typ, Texts_Text T, INT32 pos);
@@ -166,7 +166,7 @@ import void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x
import void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
import void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
import void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
-import void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
+import void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len);
import void *Texts__init(void);
diff --git a/bootstrap/unix-48/VT100.c b/bootstrap/unix-48/VT100.c
index f69fd90e..346fb37b 100644
--- a/bootstrap/unix-48/VT100.c
+++ b/bootstrap/unix-48/VT100.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -27,23 +27,24 @@ export void VT100_DECTCEMl (void);
export void VT100_DSR (INT16 n);
export void VT100_ED (INT16 n);
export void VT100_EL (INT16 n);
-static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len);
-static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len);
-static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len);
-static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len);
+static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len);
+static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len);
+static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len);
+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, LONGINT str__len);
+export void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len);
export void VT100_RCP (void);
-static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end);
+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);
export void VT100_SGR (INT16 n);
export void VT100_SGR2 (INT16 n, INT16 m);
export void VT100_SU (INT16 n);
-export void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
+export void VT100_SetAttr (CHAR *attr, ADDRESS attr__len);
-static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end)
+static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end)
{
CHAR h;
while (start < end) {
@@ -55,7 +56,7 @@ static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end)
}
}
-void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
+void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len)
{
CHAR b[21];
INT16 s, e;
@@ -74,7 +75,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT 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));
@@ -84,7 +85,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
__COPY(b, str, str__len);
}
-static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len)
+static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len)
{
CHAR cmd[9];
__DUP(letter, letter__len, CHAR);
@@ -94,7 +95,7 @@ static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len)
__DEL(letter);
}
-static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len)
+static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len)
{
CHAR nstr[2];
CHAR cmd[7];
@@ -107,7 +108,7 @@ static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len)
__DEL(letter);
}
-static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len)
+static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len)
{
CHAR nstr[2];
CHAR cmd[7];
@@ -120,7 +121,7 @@ static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len)
__DEL(letter);
}
-static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len)
+static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len)
{
CHAR nstr[5], mstr[5];
CHAR cmd[12];
@@ -136,6 +137,15 @@ static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT 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);
@@ -236,7 +246,7 @@ void VT100_DECTCEMh (void)
VT100_EscSeq0((CHAR*)"\?25h", 5);
}
-void VT100_SetAttr (CHAR *attr, LONGINT attr__len)
+void VT100_SetAttr (CHAR *attr, ADDRESS attr__len)
{
CHAR tmpstr[16];
__DUP(attr, attr__len, CHAR);
@@ -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 d99406ec..4e708647 100644
--- a/bootstrap/unix-48/VT100.h
+++ b/bootstrap/unix-48/VT100.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -23,14 +23,15 @@ import void VT100_DSR (INT16 n);
import void VT100_ED (INT16 n);
import void VT100_EL (INT16 n);
import void VT100_HVP (INT16 n, INT16 m);
-import void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len);
+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);
import void VT100_SGR2 (INT16 n, INT16 m);
import void VT100_SU (INT16 n);
-import void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
+import void VT100_SetAttr (CHAR *attr, ADDRESS attr__len);
import void *VT100__init(void);
diff --git a/bootstrap/unix-48/extTools.c b/bootstrap/unix-48/extTools.c
index 37630d23..ce2fc413 100644
--- a/bootstrap/unix-48/extTools.c
+++ b/bootstrap/unix-48/extTools.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,33 +7,40 @@
#include "SYSTEM.h"
#include "Configuration.h"
+#include "Heap.h"
#include "Modules.h"
#include "OPM.h"
#include "Out.h"
#include "Platform.h"
#include "Strings.h"
-
-static CHAR extTools_CFLAGS[1023];
+typedef
+ CHAR extTools_CommandString[4096];
-export void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len);
-static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT s__len);
-export void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len);
-static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len);
+static extTools_CommandString extTools_CFLAGS;
-static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len)
+export void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__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);
+
+
+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, LONGINT title__len, CHAR *cmd, LONGIN
__DEL(cmd);
}
-static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT 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, LONGINT moduleName__len)
+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*)"Assemble: ", 11, 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, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len)
+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", 8, (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((CHAR*)"", 1, (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*)"Assemble and link: ", 20, 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 63e5df15..686f0b4e 100644
--- a/bootstrap/unix-48/extTools.h
+++ b/bootstrap/unix-48/extTools.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -8,8 +8,8 @@
-import void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len);
-import void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len);
+import void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len);
+import void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len);
import void *extTools__init(void);
diff --git a/bootstrap/unix-88/Compiler.c b/bootstrap/unix-88/Compiler.c
index dc4bb660..4460479d 100644
--- a/bootstrap/unix-88/Compiler.c
+++ b/bootstrap/unix-88/Compiler.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -20,9 +20,9 @@
#include "extTools.h"
-static CHAR Compiler_mname[256];
+static void Compiler_FindLocalObjectFiles (CHAR *objectnames, ADDRESS objectnames__len);
export void Compiler_Module (BOOLEAN *done);
static void Compiler_PropagateElementaryTypeSizes (void);
export void Compiler_Translate (void);
@@ -41,11 +41,12 @@ void Compiler_Module (BOOLEAN *done)
OPT_Export(&ext, &new);
if (OPM_noerr) {
OPM_OpenFiles((void*)OPT_SelfName, 256);
+ OPM_DeleteObj((void*)OPT_SelfName, 256);
OPC_Init();
OPV_Module(p);
if (OPM_noerr) {
if ((__IN(10, OPM_Options, 32) && __STRCMP(OPM_modName, "SYSTEM") != 0)) {
- OPM_DeleteNewSym();
+ OPM_DeleteSym((void*)OPT_SelfName, 256);
OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogWStr((CHAR*)" Main program.", 16);
OPM_LogVT100((CHAR*)"0m", 3);
@@ -61,7 +62,7 @@ void Compiler_Module (BOOLEAN *done)
}
}
} else {
- OPM_DeleteNewSym();
+ OPM_DeleteSym((void*)OPT_SelfName, 256);
}
}
}
@@ -88,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;
@@ -104,14 +105,44 @@ static void Compiler_PropagateElementaryTypeSizes (void)
}
}
+static void Compiler_FindLocalObjectFiles (CHAR *objectnames, ADDRESS objectnames__len)
+{
+ OPT_Link l = NIL;
+ CHAR fn[64];
+ Platform_FileIdentity id;
+ objectnames[0] = 0x00;
+ l = OPT_Links;
+ while (l != NIL) {
+ __COPY(l->name, fn, 64);
+ Strings_Append((CHAR*)".sym", 5, (void*)fn, 64);
+ if (Platform_IdentifyByName(fn, 64, &id, Platform_FileIdentity__typ) == 0) {
+ __COPY(l->name, fn, 64);
+ Strings_Append((CHAR*)".o", 3, (void*)fn, 64);
+ if (Platform_IdentifyByName(fn, 64, &id, Platform_FileIdentity__typ) == 0) {
+ Strings_Append((CHAR*)" ", 2, (void*)objectnames, objectnames__len);
+ Strings_Append(fn, 64, (void*)objectnames, objectnames__len);
+ } else {
+ OPM_LogVT100((CHAR*)"91m", 4);
+ OPM_LogWStr((CHAR*)"Link warning: a local symbol file is present for module ", 57);
+ OPM_LogWStr(l->name, 256);
+ OPM_LogWStr((CHAR*)", but local object file '", 26);
+ OPM_LogWStr(fn, 64);
+ OPM_LogWStr((CHAR*)"' is missing.", 14);
+ OPM_LogVT100((CHAR*)"0m", 3);
+ OPM_LogWLn();
+ }
+ }
+ l = l->next;
+ }
+}
+
void Compiler_Translate (void)
{
BOOLEAN done;
- CHAR modulesobj[2048];
- modulesobj[0] = 0x00;
+ CHAR linkfiles[2048];
if (OPM_OpenPar()) {
for (;;) {
- OPM_Init(&done, (void*)Compiler_mname, 256);
+ OPM_Init(&done);
if (!done) {
return;
}
@@ -131,11 +162,9 @@ void Compiler_Translate (void)
} else {
if (!__IN(10, OPM_Options, 32)) {
extTools_Assemble(OPM_modName, 32);
- Strings_Append((CHAR*)" ", 2, (void*)modulesobj, 2048);
- Strings_Append(OPM_modName, 32, (void*)modulesobj, 2048);
- Strings_Append((CHAR*)".o", 3, (void*)modulesobj, 2048);
} else {
- extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), modulesobj, 2048);
+ Compiler_FindLocalObjectFiles((void*)linkfiles, 2048);
+ extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), linkfiles, 2048);
}
}
}
diff --git a/bootstrap/unix-88/Configuration.c b/bootstrap/unix-88/Configuration.c
index 2d0061df..fa87c9de 100644
--- a/bootstrap/unix-88/Configuration.c
+++ b/bootstrap/unix-88/Configuration.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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("1.95 [2016/11/24]. 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 b28e0caa..c3c54eed 100644
--- a/bootstrap/unix-88/Configuration.h
+++ b/bootstrap/unix-88/Configuration.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 826c3d63..57e78310 100644
--- a/bootstrap/unix-88/Files.c
+++ b/bootstrap/unix-88/Files.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 {
@@ -36,7 +36,7 @@ typedef
INT32 fd, len, pos;
Files_Buffer bufs[4];
INT16 swapper, state;
- Files_File next;
+ struct Files_FileDesc *next;
} Files_FileDesc;
typedef
@@ -48,11 +48,12 @@ typedef
} Files_Rider;
-static Files_File Files_files;
+export INT16 Files_MaxPathLength, Files_MaxNameLength;
+static Files_FileDesc *Files_files;
static INT16 Files_tempno;
static CHAR Files_HOME[1024];
static struct {
- LONGINT len[1];
+ ADDRESS len[1];
CHAR data[1];
} *Files_SearchPath;
@@ -60,58 +61,68 @@ export ADDRESS *Files_FileDesc__typ;
export ADDRESS *Files_BufDesc__typ;
export ADDRESS *Files_Rider__typ;
+static void Files_Assert (BOOLEAN truth);
export Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
static Files_File Files_CacheEntry (Platform_FileIdentity identity);
-export void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
+export void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res);
export void Files_Close (Files_File f);
static void Files_CloseOSFile (Files_File f);
static void Files_Create (Files_File f);
-export void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res);
-static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode);
+export void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res);
+static void Files_Deregister (CHAR *name, ADDRESS name__len);
+static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode);
static void Files_Finalize (SYSTEM_PTR o);
-static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len);
+static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len);
static void Files_Flush (Files_Buffer buf);
export void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
-export void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
-static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len);
-static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len);
+export void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len);
+static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len);
+static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len);
export INT32 Files_Length (Files_File f);
-static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len);
-export Files_File Files_New (CHAR *name, LONGINT name__len);
-export Files_File Files_Old (CHAR *name, LONGINT name__len);
+static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len);
+export Files_File Files_New (CHAR *name, ADDRESS name__len);
+export Files_File Files_Old (CHAR *name, ADDRESS name__len);
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_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+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);
export void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
-export void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
-export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
+export void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
+export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
export void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
export void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
-export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
export void Files_Register (Files_File f);
-export void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res);
-static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len);
+export void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res);
+static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len);
export void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos);
-export void Files_SetSearchPath (CHAR *path, LONGINT path__len);
+export void Files_SetSearchPath (CHAR *path, ADDRESS path__len);
export void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
export void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
-export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
export void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
export void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
export void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
export void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
export void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
export void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
-export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
#define Files_IdxTrap() __HALT(-1)
-#define Files_ToAdr(x) (ADDRESS)x
-static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
+static void Files_Assert (BOOLEAN truth)
+{
+ if (!truth) {
+ Out_Ln();
+ __ASSERT(truth, 0);
+ }
+}
+
+static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
{
__DUP(s, s__len, CHAR);
Out_Ln();
@@ -120,17 +131,17 @@ static void Files_Err (CHAR *s, LONGINT 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();
@@ -138,98 +149,125 @@ static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
__DEL(s);
}
-static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len)
+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, LONGINT finalName__len, CHAR *name, LONGINT name__len)
+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);
}
+static void Files_Deregister (CHAR *name, ADDRESS name__len)
+{
+ Platform_FileIdentity identity;
+ Files_File osfile = NIL;
+ INT16 error;
+ __DUP(name, name__len, CHAR);
+ if (Platform_IdentifyByName(name, name__len, &identity, Platform_FileIdentity__typ) == 0) {
+ osfile = (Files_File)Files_files;
+ while ((osfile != NIL && !Platform_SameFile(osfile->identity, identity))) {
+ osfile = (Files_File)osfile->next;
+ }
+ if (osfile != NIL) {
+ __ASSERT(!osfile->tempFile, 0);
+ __ASSERT(osfile->fd >= 0, 0);
+ __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, 256, (void*)osfile->workName, 256);
+ if (error != 0) {
+ Files_Err((CHAR*)"Couldn't rename previous version of file being registered", 58, osfile, error);
+ }
+ }
+ }
+ __DEL(name);
+}
+
static void Files_Create (Files_File f)
{
- Platform_FileIdentity identity;
BOOLEAN done;
INT16 error;
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 if (f->state == 2) {
- __COPY(f->registerName, f->workName, 101);
+ } else {
+ __ASSERT(f->state == 2, 0);
+ 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;
@@ -275,27 +313,6 @@ static void Files_Flush (Files_Buffer buf)
}
}
-static void Files_CloseOSFile (Files_File f)
-{
- Files_File prev = NIL;
- INT16 error;
- if (Files_files == f) {
- Files_files = f->next;
- } else {
- prev = Files_files;
- while ((prev != NIL && prev->next != f)) {
- prev = prev->next;
- }
- if (prev->next != NIL) {
- prev->next = f->next;
- }
- }
- error = Platform_Close(f->fd);
- f->fd = -1;
- f->state = 1;
- Heap_FileCount -= 1;
-}
-
void Files_Close (Files_File f)
{
INT32 i;
@@ -303,11 +320,10 @@ 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;
}
- Files_CloseOSFile(f);
}
}
@@ -316,13 +332,13 @@ INT32 Files_Length (Files_File f)
return f->len;
}
-Files_File Files_New (CHAR *name, LONGINT name__len)
+Files_File Files_New (CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
__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;
@@ -332,7 +348,7 @@ Files_File Files_New (CHAR *name, LONGINT name__len)
return f;
}
-static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len)
+static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len)
{
INT16 i;
CHAR ch;
@@ -344,38 +360,38 @@ static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT 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, LONGINT name__len)
+static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@@ -383,7 +399,7 @@ static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
ch = name[0];
while ((ch != 0x00 && ch != '/')) {
i += 1;
- ch = name[i];
+ ch = name[__X(i, name__len)];
}
return ch == '/';
}
@@ -392,15 +408,15 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
{
Files_File f = NIL;
INT16 i, error;
- f = Files_files;
+ f = (Files_File)Files_files;
while (f != NIL) {
if (Platform_SameFile(identity, f->identity)) {
if (!Platform_SameFileTime(identity, f->identity)) {
i = 0;
while (i < 4) {
- if (f->bufs[i] != NIL) {
- f->bufs[i]->org = -1;
- f->bufs[i] = NIL;
+ if (f->bufs[__X(i, 4)] != NIL) {
+ f->bufs[__X(i, 4)]->org = -1;
+ f->bufs[__X(i, 4)] = NIL;
}
i += 1;
}
@@ -410,12 +426,12 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
}
return f;
}
- f = f->next;
+ f = (Files_File)f->next;
}
return NIL;
}
-Files_File Files_Old (CHAR *name, LONGINT name__len)
+Files_File Files_Old (CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
INT32 fd;
@@ -456,6 +472,7 @@ Files_File Files_Old (CHAR *name, LONGINT name__len)
error = Platform_Identify(fd, &identity, Platform_FileIdentity__typ);
f = Files_CacheEntry(identity);
if (f != NIL) {
+ error = Platform_Close(fd);
__DEL(name);
return f;
} else {
@@ -466,7 +483,7 @@ Files_File Files_Old (CHAR *name, LONGINT 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;
@@ -498,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;
}
@@ -526,7 +543,7 @@ void Files_GetDate (Files_File f, INT32 *t, INT32 *d)
INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ)
{
- __ASSERT((*r).offset <= 4096, 0);
+ Files_Assert((*r).offset <= 4096);
return (*r).org + (*r).offset;
}
@@ -544,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) {
@@ -585,7 +602,7 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
org = 0;
offset = 0;
}
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
(*r).buf = buf;
(*r).org = org;
(*r).offset = offset;
@@ -604,9 +621,9 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
buf = (*r).buf;
offset = (*r).offset;
}
- __ASSERT(offset <= buf->size, 0);
+ 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);
@@ -618,7 +635,12 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
}
}
-void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
+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;
Files_Buffer buf = NIL;
@@ -644,12 +666,12 @@ void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x
} else {
min = n;
}
- __MOVE((ADDRESS)buf->data + Files_ToAdr(offset), (ADDRESS)x + Files_ToAdr(xpos), min);
+ __MOVE((ADDRESS)&buf->data[__X(offset, 4096)], (ADDRESS)&x[__X(xpos, x__len)], min);
offset += min;
(*r).offset = offset;
xpos += min;
n -= min;
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
}
(*r).res = 0;
(*r).eof = 0;
@@ -666,14 +688,14 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
INT32 offset;
buf = (*r).buf;
offset = (*r).offset;
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
- __ASSERT(offset < 4096, 0);
- buf->data[offset] = x;
+ Files_Assert(offset < 4096);
+ buf->data[__X(offset, 4096)] = x;
buf->chg = 1;
if (offset == buf->size) {
buf->size += 1;
@@ -683,7 +705,7 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
(*r).res = 0;
}
-void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
+void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n)
{
INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
@@ -694,23 +716,23 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT
buf = (*r).buf;
offset = (*r).offset;
while (n > 0) {
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
restInBuf = 4096 - offset;
if (n > restInBuf) {
min = restInBuf;
} else {
min = n;
}
- __MOVE((ADDRESS)x + Files_ToAdr(xpos), (ADDRESS)buf->data + Files_ToAdr(offset), min);
+ __MOVE((ADDRESS)&x[__X(xpos, x__len)], (ADDRESS)&buf->data[__X(offset, 4096)], min);
offset += min;
(*r).offset = offset;
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
if (offset > buf->size) {
buf->f->len += offset - buf->size;
buf->size = offset;
@@ -722,14 +744,15 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT
(*r).res = 0;
}
-void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res)
+void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res)
{
__DUP(name, name__len, CHAR);
+ Files_Deregister(name, name__len);
*res = Platform_Unlink((void*)name, name__len);
__DEL(name);
}
-void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res)
+void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res)
{
INT32 fdold, fdnew, n;
INT16 error, ignore;
@@ -795,31 +818,30 @@ void Files_Register (Files_File f)
{
INT16 idx, errcode;
Files_File f1 = NIL;
- CHAR file[104];
if ((f->state == 1 && f->registerName[0] != 0x00)) {
f->state = 2;
}
Files_Close(f);
if (f->registerName[0] != 0x00) {
- Files_Rename(f->workName, 101, f->registerName, 101, &errcode);
+ Files_Deregister(f->registerName, 256);
+ Files_Rename(f->workName, 256, f->registerName, 256, &errcode);
if (errcode != 0) {
- __COPY(f->registerName, file, 104);
- __HALT(99);
+ Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode);
}
- __COPY(f->registerName, f->workName, 101);
+ __MOVE(f->registerName, f->workName, 256);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
}
-void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res)
+void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res)
{
__DUP(path, path__len, CHAR);
*res = Platform_Chdir((void*)path, path__len);
__DEL(path);
}
-static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len)
+static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len)
{
INT32 i, j;
if (!Platform_LittleEndian) {
@@ -827,7 +849,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT 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 {
@@ -877,36 +899,36 @@ void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x)
Files_FlipBytes((void*)b, 8, (void*)&*x, 8);
}
-void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
+void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
{
INT16 i;
CHAR ch;
i = 0;
do {
Files_Read(&*R, R__typ, (void*)&ch);
- x[i] = ch;
+ x[__X(i, x__len)] = ch;
i += 1;
} while (!(ch == 0x00));
}
-void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
+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, LONGINT x__len)
+void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len)
{
INT8 s, b;
INT64 q;
@@ -919,7 +941,7 @@ void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__
Files_Read(&*R, R__typ, (void*)&b);
}
q += (INT64)__ASH((__MASK(b, -64) - __ASHL(__ASHR(b, 6), 6)), s);
- __ASSERT(x__len <= 8, 0);
+ Files_Assert(x__len <= 8);
__MOVE((ADDRESS)&q, (ADDRESS)x, x__len);
}
@@ -931,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);
}
@@ -950,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);
}
@@ -972,11 +996,11 @@ void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x)
Files_WriteBytes(&*R, R__typ, (void*)b, 8, 8);
}
-void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
+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);
@@ -985,17 +1009,38 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT 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, LONGINT name__len)
+void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len)
{
__COPY(f->workName, name, name__len);
}
+static void Files_CloseOSFile (Files_File f)
+{
+ Files_File prev = NIL;
+ INT16 error;
+ if (Files_files == (void *) f) {
+ Files_files = f->next;
+ } else {
+ prev = (Files_File)Files_files;
+ while ((prev != NIL && prev->next != (void *) f)) {
+ prev = (Files_File)prev->next;
+ }
+ if (prev->next != NIL) {
+ prev->next = f->next;
+ }
+ }
+ error = Platform_Close(f->fd);
+ f->fd = -1;
+ f->state = 1;
+ Heap_FileCount -= 1;
+}
+
static void Files_Finalize (SYSTEM_PTR o)
{
Files_File f = NIL;
@@ -1004,12 +1049,12 @@ 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);
}
}
}
-void Files_SetSearchPath (CHAR *path, LONGINT path__len)
+void Files_SetSearchPath (CHAR *path, ADDRESS path__len)
{
__DUP(path, path__len, CHAR);
if (Strings_Length(path, path__len) != 0) {
@@ -1023,11 +1068,10 @@ void Files_SetSearchPath (CHAR *path, LONGINT path__len)
static void EnumPtrs(void (*P)(void*))
{
- P(Files_files);
P(Files_SearchPath);
}
-__TDESC(Files_FileDesc, 1, 5) = {__TDFLDS("FileDesc", 280), {232, 240, 248, 256, 272, -48}};
+__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}};
@@ -1047,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 855c5f7c..676f434c 100644
--- a/bootstrap/unix-88/Files.h
+++ b/bootstrap/unix-88/Files.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,9 +11,7 @@ typedef
typedef
struct Files_FileDesc {
INT64 _prvt0;
- char _prvt1[208];
- INT32 fd;
- char _prvt2[60];
+ char _prvt1[584];
} Files_FileDesc;
typedef
@@ -25,46 +23,48 @@ typedef
} Files_Rider;
+import INT16 Files_MaxPathLength, Files_MaxNameLength;
import ADDRESS *Files_FileDesc__typ;
import ADDRESS *Files_Rider__typ;
import Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
-import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
+import void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res);
import void Files_Close (Files_File f);
-import void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res);
+import void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res);
import void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
-import void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
+import void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len);
import INT32 Files_Length (Files_File f);
-import Files_File Files_New (CHAR *name, LONGINT name__len);
-import Files_File Files_Old (CHAR *name, LONGINT name__len);
+import Files_File Files_New (CHAR *name, ADDRESS name__len);
+import Files_File Files_Old (CHAR *name, ADDRESS name__len);
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_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+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);
import void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
-import void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
-import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
+import void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
+import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
import void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
import void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
-import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
import void Files_Register (Files_File f);
-import void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res);
+import void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res);
import void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos);
-import void Files_SetSearchPath (CHAR *path, LONGINT path__len);
+import void Files_SetSearchPath (CHAR *path, ADDRESS path__len);
import void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
import void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
-import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
import void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
import void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
import void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
import void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
import void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
import void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
-import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
import void *Files__init(void);
diff --git a/bootstrap/unix-88/Heap.c b/bootstrap/unix-88/Heap.c
index a2bb8f2f..7b004b60 100644
--- a/bootstrap/unix-88/Heap.c
+++ b/bootstrap/unix-88/Heap.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,8 +68,10 @@ static INT64 Heap_freeList[10];
static INT64 Heap_bigBlocks;
export INT64 Heap_allocated;
static BOOLEAN Heap_firstTry;
-static INT64 Heap_heap, Heap_heapend;
-export INT64 Heap_heapsize;
+static INT16 Heap_ldUnit;
+export INT64 Heap_heap;
+static INT64 Heap_heapMin, Heap_heapMax;
+export INT64 Heap_heapsize, Heap_heapMinExpand;
static Heap_FinNode Heap_fin;
static INT16 Heap_lockdepth;
static BOOLEAN Heap_interrupted;
@@ -84,15 +86,16 @@ static void Heap_CheckFin (void);
static void Heap_ExtendHeap (INT64 blksz);
export void Heap_FINALL (void);
static void Heap_Finalize (void);
+export INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len);
export void Heap_GC (BOOLEAN markStack);
-static void Heap_HeapSort (INT64 n, INT64 *a, LONGINT a__len);
+static void Heap_HeapSort (INT32 n, INT64 *a, ADDRESS a__len);
export void Heap_INCREF (Heap_Module m);
export void Heap_InitHeap (void);
export void Heap_Lock (void);
static void Heap_Mark (INT64 q);
-static void Heap_MarkCandidates (INT64 n, INT64 *cand, LONGINT cand__len);
+static void Heap_MarkCandidates (INT32 n, INT64 *cand, ADDRESS cand__len);
static void Heap_MarkP (SYSTEM_PTR p);
-static void Heap_MarkStack (INT64 n, INT64 *cand, LONGINT cand__len);
+static void Heap_MarkStack (INT64 n, INT64 *cand, ADDRESS cand__len);
export SYSTEM_PTR Heap_NEWBLK (INT64 size);
export SYSTEM_PTR Heap_NEWREC (INT64 tag);
static INT64 Heap_NewChunk (INT64 blksz);
@@ -101,16 +104,18 @@ export SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs);
export void Heap_REGTYP (Heap_Module m, INT64 typ);
export void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize);
static void Heap_Scan (void);
-static void Heap_Sift (INT64 l, INT64 r, INT64 *a, LONGINT a__len);
+static void Heap_Sift (INT32 l, INT32 r, INT64 *a, ADDRESS a__len);
export void Heap_Unlock (void);
extern void *Heap__init();
-extern ADDRESS Platform_MainStackFrame;
+extern ADDRESS Modules_MainStackFrame;
extern ADDRESS Platform_OSAllocate(ADDRESS size);
#define Heap_HeapModuleInit() Heap__init()
#define Heap_ModulesHalt(code) Modules_Halt(code)
+#define Heap_ModulesMainStackFrame() Modules_MainStackFrame
#define Heap_OSAllocate(size) Platform_OSAllocate(size)
-#define Heap_PlatformMainStackFrame() Platform_MainStackFrame
+#define Heap_uLE(x, y) ((size_t)x <= (size_t)y)
+#define Heap_uLT(x, y) ((size_t)x < (size_t)y)
void Heap_Lock (void)
{
@@ -143,6 +148,35 @@ SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
return (void*)m;
}
+INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len)
+{
+ Heap_Module m, p;
+ __DUP(name, name__len, CHAR);
+ m = (Heap_Module)(ADDRESS)Heap_modules;
+ while ((m != NIL && __STRCMP(m->name, name) != 0)) {
+ p = m;
+ m = m->next;
+ }
+ if ((m != NIL && m->refcnt == 0)) {
+ if (m == (Heap_Module)(ADDRESS)Heap_modules) {
+ Heap_modules = (SYSTEM_PTR)m->next;
+ } else {
+ p->next = m->next;
+ }
+ __DEL(name);
+ return 0;
+ } else {
+ if (m == NIL) {
+ __DEL(name);
+ return -1;
+ } else {
+ __DEL(name);
+ return m->refcnt;
+ }
+ }
+ __RETCHK;
+}
+
void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd)
{
Heap_Cmd c;
@@ -170,16 +204,24 @@ void Heap_INCREF (Heap_Module m)
static INT64 Heap_NewChunk (INT64 blksz)
{
- INT64 chnk;
+ INT64 chnk, blk, end;
chnk = Heap_OSAllocate(blksz + 24);
if (chnk != 0) {
- __PUT(chnk + 8, chnk + (24 + blksz), INT64);
- __PUT(chnk + 24, chnk + 32, INT64);
- __PUT(chnk + 32, blksz, INT64);
- __PUT(chnk + 40, -8, INT64);
- __PUT(chnk + 48, Heap_bigBlocks, INT64);
- Heap_bigBlocks = chnk + 24;
+ blk = chnk + 24;
+ end = blk + blksz;
+ __PUT(chnk + 8, end, INT64);
+ __PUT(blk, blk + 8, INT64);
+ __PUT(blk + 8, blksz, INT64);
+ __PUT(blk + 16, -8, INT64);
+ __PUT(blk + 24, Heap_bigBlocks, INT64);
+ Heap_bigBlocks = blk;
Heap_heapsize += blksz;
+ if (Heap_uLT(blk + 8, Heap_heapMin)) {
+ Heap_heapMin = blk + 8;
+ }
+ if (Heap_uLT(Heap_heapMax, end)) {
+ Heap_heapMax = end;
+ }
}
return chnk;
}
@@ -187,29 +229,28 @@ static INT64 Heap_NewChunk (INT64 blksz)
static void Heap_ExtendHeap (INT64 blksz)
{
INT64 size, chnk, j, next;
- if (blksz > 320000) {
+ if (Heap_uLT(Heap_heapMinExpand, blksz)) {
size = blksz;
} else {
- size = 320000;
+ size = Heap_heapMinExpand;
}
chnk = Heap_NewChunk(size);
if (chnk != 0) {
- if (chnk < Heap_heap) {
+ if (Heap_uLT(chnk, Heap_heap)) {
__PUT(chnk, Heap_heap, INT64);
Heap_heap = chnk;
} else {
j = Heap_heap;
__GET(j, next, INT64);
- while ((next != 0 && chnk > next)) {
+ while ((next != 0 && Heap_uLT(next, chnk))) {
j = next;
__GET(j, next, INT64);
}
__PUT(chnk, next, INT64);
__PUT(j, chnk, INT64);
}
- if (next == 0) {
- __GET(chnk + 8, Heap_heapend, INT64);
- }
+ } else if (!Heap_firstTry) {
+ Heap_heapMinExpand = 32;
}
}
@@ -219,7 +260,7 @@ 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 (i < 9) {
adr = Heap_freeList[i];
@@ -251,16 +292,17 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
if (Heap_firstTry) {
Heap_GC(1);
blksz += 32;
- if (__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2) < Heap_heapsize) {
- Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 96), 7) - Heap_heapsize);
+ 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 {
@@ -269,7 +311,7 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
}
}
__GET(adr + 8, t, INT64);
- if (t >= blksz) {
+ if (Heap_uLE(blksz, t)) {
break;
}
prev = adr;
@@ -280,7 +322,7 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
__PUT(end + 8, blksz, INT64);
__PUT(end + 16, -8, INT64);
__PUT(end, end + 8, INT64);
- if (restsize > 288) {
+ if (Heap_uLT(288, restsize)) {
__PUT(adr + 8, restsize, INT64);
} else {
__GET(adr + 24, next, INT64);
@@ -289,7 +331,7 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
} else {
__PUT(prev + 24, next, INT64);
}
- if (restsize > 0) {
+ if (restsize != 0) {
di = __ASHR(restsize, 5);
__PUT(adr + 8, restsize, INT64);
__PUT(adr + 24, Heap_freeList[di], INT64);
@@ -300,7 +342,7 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
}
i = adr + 32;
end = adr + blksz;
- while (i < end) {
+ while (Heap_uLT(i, end)) {
__PUT(i, 0, INT64);
__PUT(i + 8, 0, INT64);
__PUT(i + 16, 0, INT64);
@@ -397,17 +439,17 @@ static void Heap_Scan (void)
while (chnk != 0) {
adr = chnk + 24;
__GET(chnk + 8, end, INT64);
- while (adr < end) {
+ while (Heap_uLT(adr, end)) {
__GET(adr, tag, INT64);
if (__ODD(tag)) {
- if (freesize > 0) {
+ if (freesize != 0) {
start = adr - freesize;
__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 (i < 9) {
+ if (Heap_uLT(i, 9)) {
__PUT(start + 24, Heap_freeList[i], INT64);
Heap_freeList[i] = start;
} else {
@@ -426,14 +468,14 @@ static void Heap_Scan (void)
adr += size;
}
}
- if (freesize > 0) {
+ if (freesize != 0) {
start = adr - freesize;
__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 (i < 9) {
+ if (Heap_uLT(i, 9)) {
__PUT(start + 24, Heap_freeList[i], INT64);
Heap_freeList[i] = start;
} else {
@@ -445,18 +487,19 @@ static void Heap_Scan (void)
}
}
-static void Heap_Sift (INT64 l, INT64 r, INT64 *a, LONGINT a__len)
+static void Heap_Sift (INT32 l, INT32 r, INT64 *a, ADDRESS a__len)
{
- INT64 i, j, x;
+ INT32 i, j;
+ INT64 x;
j = l;
x = a[j];
for (;;) {
i = j;
j = __ASHL(j, 1) + 1;
- if ((j < r && a[j] < a[j + 1])) {
+ if ((j < r && Heap_uLT(a[j], a[j + 1]))) {
j += 1;
}
- if (j > r || a[j] <= x) {
+ if (j > r || Heap_uLE(a[j], x)) {
break;
}
a[i] = a[j];
@@ -464,9 +507,10 @@ static void Heap_Sift (INT64 l, INT64 r, INT64 *a, LONGINT a__len)
a[i] = x;
}
-static void Heap_HeapSort (INT64 n, INT64 *a, LONGINT a__len)
+static void Heap_HeapSort (INT32 n, INT64 *a, ADDRESS a__len)
{
- INT64 l, r, x;
+ INT32 l, r;
+ INT64 x;
l = __ASHR(n, 1);
r = n - 1;
while (l > 0) {
@@ -482,37 +526,42 @@ static void Heap_HeapSort (INT64 n, INT64 *a, LONGINT a__len)
}
}
-static void Heap_MarkCandidates (INT64 n, INT64 *cand, LONGINT cand__len)
+static void Heap_MarkCandidates (INT32 n, INT64 *cand, ADDRESS cand__len)
{
- INT64 chnk, adr, tag, next, lim, lim1, i, ptr, size;
- chnk = Heap_heap;
+ INT64 chnk, end, adr, tag, next, i, ptr, size;
+ chnk = Heap_heap;
i = 0;
- lim = cand[n - 1];
- while ((chnk != 0 && chnk < lim)) {
+ while (chnk != 0) {
+ __GET(chnk + 8, end, INT64);
adr = chnk + 24;
- __GET(chnk + 8, lim1, INT64);
- if (lim < lim1) {
- lim1 = lim;
- }
- while (adr < lim1) {
+ while (Heap_uLT(adr, end)) {
__GET(adr, tag, INT64);
if (__ODD(tag)) {
__GET(tag - 1, size, INT64);
adr += size;
+ ptr = adr + 8;
+ while (Heap_uLT(cand[i], ptr)) {
+ i += 1;
+ if (i == (INT64)n) {
+ return;
+ }
+ }
} else {
__GET(tag, size, INT64);
ptr = adr + 8;
- while (cand[i] < ptr) {
+ adr += size;
+ while (Heap_uLT(cand[i], ptr)) {
i += 1;
+ if (i == (INT64)n) {
+ return;
+ }
}
- if (i == n) {
- return;
- }
- next = adr + size;
- if (cand[i] < next) {
+ if (Heap_uLT(cand[i], adr)) {
Heap_Mark(ptr);
}
- adr = next;
+ }
+ if (Heap_uLE(end, cand[i])) {
+ adr = end;
}
}
__GET(chnk, chnk, INT64);
@@ -571,10 +620,11 @@ void Heap_FINALL (void)
}
}
-static void Heap_MarkStack (INT64 n, INT64 *cand, LONGINT cand__len)
+static void Heap_MarkStack (INT64 n, INT64 *cand, ADDRESS cand__len)
{
SYSTEM_PTR frame;
- INT64 inc, nofcand, sp, p, stack0;
+ INT32 nofcand;
+ INT64 inc, sp, p, stack0;
struct Heap__1 align;
if (n > 0) {
Heap_MarkStack(n - 1, cand, cand__len);
@@ -585,15 +635,15 @@ static void Heap_MarkStack (INT64 n, INT64 *cand, LONGINT cand__len)
if (n == 0) {
nofcand = 0;
sp = (ADDRESS)&frame;
- stack0 = Heap_PlatformMainStackFrame();
+ stack0 = Heap_ModulesMainStackFrame();
inc = (ADDRESS)&align.p - (ADDRESS)&align;
- if (sp > stack0) {
+ if (Heap_uLT(stack0, sp)) {
inc = -inc;
}
while (sp != stack0) {
__GET(sp, p, INT64);
- if ((p > Heap_heap && p < Heap_heapend)) {
- if (nofcand == (INT64)cand__len) {
+ if ((Heap_uLE(Heap_heapMin, p) && Heap_uLT(p, Heap_heapMax))) {
+ if (nofcand == cand__len) {
Heap_HeapSort(nofcand, (void*)cand, cand__len);
Heap_MarkCandidates(nofcand, (void*)cand, cand__len);
nofcand = 0;
@@ -615,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)
@@ -703,17 +751,21 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
void Heap_InitHeap (void)
{
- Heap_heap = Heap_NewChunk(256000);
- __GET(Heap_heap + 8, Heap_heapend, INT64);
- __PUT(Heap_heap, 0, INT64);
+ Heap_heap = 0;
+ Heap_heapsize = 0;
Heap_allocated = 0;
+ Heap_lockdepth = 0;
+ 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;
Heap_freeList[9] = 1;
- Heap_lockdepth = 0;
Heap_FileCount = 0;
Heap_modules = NIL;
- Heap_heapsize = 0;
- Heap_bigBlocks = 0;
Heap_fin = NIL;
Heap_interrupted = 0;
Heap_HeapModuleInit();
diff --git a/bootstrap/unix-88/Heap.h b/bootstrap/unix-88/Heap.h
index 163cad8c..45a9c6d2 100644
--- a/bootstrap/unix-88/Heap.h
+++ b/bootstrap/unix-88/Heap.h
@@ -1,16 +1,26 @@
-/* voc 1.95 [2016/11/24]. 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
#include "SYSTEM.h"
+typedef
+ struct Heap_CmdDesc *Heap_Cmd;
+
typedef
CHAR Heap_CmdName[24];
typedef
void (*Heap_Command)(void);
+typedef
+ struct Heap_CmdDesc {
+ Heap_Cmd next;
+ Heap_CmdName name;
+ Heap_Command cmd;
+ } Heap_CmdDesc;
+
typedef
void (*Heap_EnumProc)(void(*)(SYSTEM_PTR));
@@ -21,22 +31,31 @@ typedef
struct Heap_ModuleDesc *Heap_Module;
typedef
- struct Heap_ModuleDesc {
- INT64 _prvt0;
- char _prvt1[56];
- } Heap_ModuleDesc;
+ CHAR Heap_ModuleName[20];
typedef
- CHAR Heap_ModuleName[20];
+ struct Heap_ModuleDesc {
+ Heap_Module next;
+ Heap_ModuleName name;
+ INT32 refcnt;
+ Heap_Cmd cmds;
+ INT64 types;
+ Heap_EnumProc enumPtrs;
+ char _prvt0[8];
+ } Heap_ModuleDesc;
import SYSTEM_PTR Heap_modules;
-import INT64 Heap_allocated, Heap_heapsize;
+import INT64 Heap_allocated;
+import INT64 Heap_heap;
+import INT64 Heap_heapsize, Heap_heapMinExpand;
import INT16 Heap_FileCount;
import ADDRESS *Heap_ModuleDesc__typ;
+import ADDRESS *Heap_CmdDesc__typ;
import void Heap_FINALL (void);
+import INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len);
import void Heap_GC (BOOLEAN markStack);
import void Heap_INCREF (Heap_Module m);
import void Heap_InitHeap (void);
diff --git a/bootstrap/unix-88/Modules.c b/bootstrap/unix-88/Modules.c
index 4e4d62e7..a5b989e5 100644
--- a/bootstrap/unix-88/Modules.c
+++ b/bootstrap/unix-88/Modules.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -9,81 +9,303 @@
#include "Heap.h"
#include "Platform.h"
-typedef
- struct Modules_CmdDesc *Modules_Cmd;
-
-typedef
- void (*Modules_Command)(void);
-
-typedef
- struct Modules_CmdDesc {
- Modules_Cmd next;
- CHAR name[24];
- Modules_Command cmd;
- } Modules_CmdDesc;
-
-typedef
- struct Modules_ModuleDesc *Modules_Module;
-
-typedef
- CHAR Modules_ModuleName[20];
-
-typedef
- struct Modules_ModuleDesc {
- Modules_Module next;
- Modules_ModuleName name;
- INT32 refcnt;
- Modules_Cmd cmds;
- INT32 types;
- void (*enumPtrs)(void(*)(INT32));
- INT32 reserved1, reserved2;
- } Modules_ModuleDesc;
-
export INT16 Modules_res;
export CHAR Modules_resMsg[256];
-export Modules_ModuleName Modules_imported, Modules_importing;
+export Heap_ModuleName Modules_imported, Modules_importing;
+export INT64 Modules_MainStackFrame;
+export INT16 Modules_ArgCount;
+export INT64 Modules_ArgVector;
+export CHAR Modules_BinaryDir[1024];
-export ADDRESS *Modules_ModuleDesc__typ;
-export ADDRESS *Modules_CmdDesc__typ;
-static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len);
+static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
+static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
+export INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len);
export void Modules_AssertFail (INT32 code);
+static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
+static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len);
static void Modules_DisplayHaltCode (INT32 code);
-export void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
+static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len);
+static void Modules_FindBinaryDir (CHAR *binarydir, ADDRESS binarydir__len);
+export void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all);
+export void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len);
+export void Modules_GetIntArg (INT16 n, INT32 *val);
export void Modules_Halt (INT32 code);
-export Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
-export Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
+export void Modules_Init (INT32 argc, INT64 argvadr);
+static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len);
+static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len);
+static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len);
+export Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len);
+export Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len);
+static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
static void Modules_errch (CHAR c);
static void Modules_errint (INT32 l);
-static void Modules_errstring (CHAR *s, LONGINT s__len);
+static void Modules_errstring (CHAR *s, ADDRESS s__len);
-#define Modules_modules() (Modules_Module)Heap_modules
-#define Modules_setmodules(m) Heap_modules = m
+extern void Heap_InitHeap();
+extern void *Modules__init(void);
+#define Modules_InitHeap() Heap_InitHeap()
+#define Modules_ModulesInit() Modules__init()
+#define Modules_modules() (Heap_Module)Heap_modules
-static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len)
+void Modules_Init (INT32 argc, INT64 argvadr)
{
- INT16 i, j;
- __DUP(b, b__len, CHAR);
+ Modules_MainStackFrame = argvadr;
+ Modules_ArgCount = __VAL(INT16, argc);
+ __GET(argvadr, Modules_ArgVector, INT64);
+ Modules_InitHeap();
+ Modules_ModulesInit();
+}
+
+typedef
+ CHAR (*argptr__15)[1024];
+
+void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len)
+{
+ argptr__15 arg = NIL;
+ if (n < Modules_ArgCount) {
+ __GET(Modules_ArgVector + (INT64)__ASHL(n, 3), arg, argptr__15);
+ __COPY(*arg, val, val__len);
+ }
+}
+
+void Modules_GetIntArg (INT16 n, INT32 *val)
+{
+ CHAR s[64];
+ INT32 k, d, i;
+ s[0] = 0x00;
+ Modules_GetArg(n, (void*)s, 64);
i = 0;
- while (a[__X(i, a__len)] != 0x00) {
+ if (s[0] == '-') {
+ i = 1;
+ }
+ k = 0;
+ d = (INT16)s[__X(i, 64)] - 48;
+ while ((d >= 0 && d <= 9)) {
+ k = k * 10 + d;
+ i += 1;
+ d = (INT16)s[__X(i, 64)] - 48;
+ }
+ if (s[0] == '-') {
+ k = -k;
+ i -= 1;
+ }
+ if (i > 0) {
+ *val = k;
+ }
+}
+
+INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len)
+{
+ INT16 i;
+ CHAR arg[256];
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ Modules_GetArg(i, (void*)arg, 256);
+ while ((i < Modules_ArgCount && __STRCMP(s, arg) != 0)) {
+ i += 1;
+ Modules_GetArg(i, (void*)arg, 256);
+ }
+ __DEL(s);
+ return i;
+}
+
+static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len)
+{
+ INT16 i;
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
i += 1;
}
- j = 0;
- while (b[__X(j, b__len)] != 0x00) {
- a[__X(i, a__len)] = b[__X(j, b__len)];
+ __DEL(s);
+ return i;
+}
+
+static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
+{
+ INT16 i, j;
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ j = Modules_CharCount(d, d__len);
+ while (s[__X(i, s__len)] != 0x00) {
+ d[__X(j, d__len)] = s[__X(i, s__len)];
i += 1;
j += 1;
}
- a[__X(i, a__len)] = 0x00;
- __DEL(b);
+ d[__X(j, d__len)] = 0x00;
+ __DEL(s);
}
-Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
+static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{
- Modules_Module m = NIL;
+ INT16 i, j;
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ j = Modules_CharCount(d, d__len);
+ if ((j > 0 && d[__X(j - 1, d__len)] != c)) {
+ d[__X(j, d__len)] = c;
+ j += 1;
+ }
+ while (s[__X(i, s__len)] != 0x00) {
+ d[__X(j, d__len)] = s[__X(i, s__len)];
+ i += 1;
+ j += 1;
+ }
+ d[__X(j, d__len)] = 0x00;
+ __DEL(s);
+}
+
+static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len)
+{
+ INT16 i;
+ __DUP(s, s__len, CHAR);
+ if (c == 0x00) {
+ __DEL(s);
+ return 0;
+ }
+ i = 0;
+ while ((s[__X(i, s__len)] != c && s[__X(i, s__len)] != 0x00)) {
+ i += 1;
+ }
+ __DEL(s);
+ return s[__X(i, s__len)] == c;
+}
+
+static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len)
+{
+ __DUP(d, d__len, CHAR);
+ if (d[0] == 0x00) {
+ __DEL(d);
+ return 0;
+ }
+ if (Modules_IsOneOf(d[0], (CHAR*)"/\\", 3)) {
+ __DEL(d);
+ return 1;
+ }
+ if (d[__X(1, d__len)] == ':') {
+ __DEL(d);
+ return 1;
+ }
+ __DEL(d);
+ return 0;
+}
+
+static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
+{
+ __DUP(s, s__len, CHAR);
+ if (Modules_IsAbsolute(s, s__len)) {
+ __COPY(s, d, d__len);
+ } else {
+ __COPY(Platform_CWD, d, d__len);
+ Modules_AppendPart('/', s, s__len, (void*)d, d__len);
+ }
+ __DEL(s);
+}
+
+static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len)
+{
+ Platform_FileIdentity identity;
+ __DUP(s, s__len, CHAR);
+ __DEL(s);
+ return Platform_IdentifyByName(s, s__len, &identity, Platform_FileIdentity__typ) == 0;
+}
+
+static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len)
+{
+ INT16 j;
+ __DUP(s, s__len, CHAR);
+ __DUP(p, p__len, CHAR);
+ j = 0;
+ while ((s[__X(*i, s__len)] != 0x00 && !Modules_IsOneOf(s[__X(*i, s__len)], p, p__len))) {
+ d[__X(j, d__len)] = s[__X(*i, s__len)];
+ *i += 1;
+ j += 1;
+ }
+ d[__X(j, d__len)] = 0x00;
+ while (Modules_IsOneOf(s[__X(*i, s__len)], p, p__len)) {
+ *i += 1;
+ }
+ __DEL(s);
+ __DEL(p);
+}
+
+static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
+{
+ INT16 i, j;
+ CHAR part[1024];
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ j = 0;
+ while ((i < 2 && Modules_IsOneOf(s[__X(i, s__len)], (CHAR*)"/\\", 3))) {
+ i += 1;
+ d[__X(j, d__len)] = '/';
+ j += 1;
+ }
+ d[__X(j, d__len)] = 0x00;
+ while (s[__X(i, s__len)] != 0x00) {
+ Modules_ExtractPart(s, s__len, &i, (CHAR*)"/\\", 3, (void*)part, 1024);
+ if ((part[0] != 0x00 && __STRCMP(part, ".") != 0)) {
+ Modules_AppendPart('/', part, 1024, (void*)d, d__len);
+ }
+ }
+ __DEL(s);
+}
+
+typedef
+ CHAR pathstring__12[4096];
+
+static void Modules_FindBinaryDir (CHAR *binarydir, ADDRESS binarydir__len)
+{
+ pathstring__12 arg0, pathlist, pathdir, tempstr;
+ INT16 i, j, k;
+ BOOLEAN present;
+ if (Modules_ArgCount < 1) {
+ binarydir[0] = 0x00;
+ return;
+ }
+ Modules_GetArg(0, (void*)arg0, 4096);
+ i = 0;
+ while ((((arg0[__X(i, 4096)] != 0x00 && arg0[__X(i, 4096)] != '/')) && arg0[__X(i, 4096)] != '\\')) {
+ i += 1;
+ }
+ if (arg0[__X(i, 4096)] == '/' || arg0[__X(i, 4096)] == '\\') {
+ Modules_Trim(arg0, 4096, (void*)tempstr, 4096);
+ Modules_Canonify(tempstr, 4096, (void*)binarydir, binarydir__len);
+ present = Modules_IsFilePresent(binarydir, binarydir__len);
+ } else {
+ Platform_GetEnv((CHAR*)"PATH", 5, (void*)pathlist, 4096);
+ i = 0;
+ present = 0;
+ while ((!present && pathlist[__X(i, 4096)] != 0x00)) {
+ Modules_ExtractPart(pathlist, 4096, &i, (CHAR*)":;", 3, (void*)pathdir, 4096);
+ Modules_AppendPart('/', arg0, 4096, (void*)pathdir, 4096);
+ Modules_Trim(pathdir, 4096, (void*)tempstr, 4096);
+ Modules_Canonify(tempstr, 4096, (void*)binarydir, binarydir__len);
+ present = Modules_IsFilePresent(binarydir, binarydir__len);
+ }
+ }
+ if (present) {
+ k = Modules_CharCount(binarydir, binarydir__len);
+ while ((k > 0 && !Modules_IsOneOf(binarydir[__X(k - 1, binarydir__len)], (CHAR*)"/\\", 3))) {
+ k -= 1;
+ }
+ if (k == 0) {
+ binarydir[__X(k, binarydir__len)] = 0x00;
+ } else {
+ binarydir[__X(k - 1, binarydir__len)] = 0x00;
+ }
+ } else {
+ binarydir[0] = 0x00;
+ }
+}
+
+Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len)
+{
+ Heap_Module m = NIL;
CHAR bodyname[64];
- Modules_Command body;
+ Heap_Command body;
__DUP(name, name__len, CHAR);
m = Modules_modules();
while ((m != NIL && __STRCMP(m->name, name) != 0)) {
@@ -96,16 +318,16 @@ Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
Modules_res = 1;
__COPY(name, Modules_importing, 20);
__MOVE(" module \"", Modules_resMsg, 10);
- Modules_Append((void*)Modules_resMsg, 256, name, name__len);
- Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
+ Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
+ Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
}
__DEL(name);
return m;
}
-Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len)
+Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len)
{
- Modules_Cmd c = NIL;
+ Heap_Cmd c = NIL;
__DUP(name, name__len, CHAR);
c = mod->cmds;
while ((c != NIL && __STRCMP(c->name, name) != 0)) {
@@ -120,43 +342,36 @@ Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT nam
Modules_res = 2;
__MOVE(" command \"", Modules_resMsg, 11);
__COPY(name, Modules_importing, 20);
- Modules_Append((void*)Modules_resMsg, 256, mod->name, 20);
- Modules_Append((void*)Modules_resMsg, 256, (CHAR*)".", 2);
- Modules_Append((void*)Modules_resMsg, 256, name, name__len);
- Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
+ Modules_Append(mod->name, 20, (void*)Modules_resMsg, 256);
+ Modules_Append((CHAR*)".", 2, (void*)Modules_resMsg, 256);
+ Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
+ Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
__DEL(name);
return NIL;
}
__RETCHK;
}
-void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all)
+void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all)
{
- Modules_Module m = NIL, p = NIL;
+ Heap_Module m = NIL, p = NIL;
+ INT32 refcount;
__DUP(name, name__len, CHAR);
m = Modules_modules();
if (all) {
Modules_res = 1;
__MOVE("unloading \"all\" not yet supported", Modules_resMsg, 34);
} else {
- while ((m != NIL && __STRCMP(m->name, name) != 0)) {
- p = m;
- m = m->next;
- }
- if ((m != NIL && m->refcnt == 0)) {
- if (m == Modules_modules()) {
- Modules_setmodules(m->next);
- } else {
- p->next = m->next;
- }
+ refcount = Heap_FreeModule(name, name__len);
+ if (refcount == 0) {
Modules_res = 0;
} else {
- Modules_res = 1;
- if (m == NIL) {
+ if (refcount < 0) {
__MOVE("module not found", Modules_resMsg, 17);
} else {
__MOVE("clients of this module exist", Modules_resMsg, 29);
}
+ Modules_res = 1;
}
}
__DEL(name);
@@ -168,7 +383,7 @@ static void Modules_errch (CHAR c)
e = Platform_Write(1, (ADDRESS)&c, 1);
}
-static void Modules_errstring (CHAR *s, LONGINT s__len)
+static void Modules_errstring (CHAR *s, ADDRESS s__len)
{
INT32 i;
__DUP(s, s__len, CHAR);
@@ -189,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)
@@ -250,6 +465,7 @@ static void Modules_DisplayHaltCode (INT32 code)
void Modules_Halt (INT32 code)
{
+ Heap_FINALL();
Modules_errstring((CHAR*)"Terminated by Halt(", 20);
Modules_errint(code);
Modules_errstring((CHAR*)"). ", 4);
@@ -262,6 +478,7 @@ void Modules_Halt (INT32 code)
void Modules_AssertFail (INT32 code)
{
+ Heap_FINALL();
Modules_errstring((CHAR*)"Assertion failure.", 19);
if (code != 0) {
Modules_errstring((CHAR*)" ASSERT code ", 14);
@@ -269,11 +486,13 @@ void Modules_AssertFail (INT32 code)
Modules_errstring((CHAR*)".", 2);
}
Modules_errstring(Platform_NL, 3);
- Platform_Exit(code);
+ if (code > 0) {
+ Platform_Exit(code);
+ } else {
+ Platform_Exit(-1);
+ }
}
-__TDESC(Modules_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 64), {0, 32, -24}};
-__TDESC(Modules_CmdDesc, 1, 1) = {__TDFLDS("CmdDesc", 40), {0, -16}};
export void *Modules__init(void)
{
@@ -281,8 +500,7 @@ export void *Modules__init(void)
__MODULE_IMPORT(Heap);
__MODULE_IMPORT(Platform);
__REGMOD("Modules", 0);
- __INITYP(Modules_ModuleDesc, Modules_ModuleDesc, 0);
- __INITYP(Modules_CmdDesc, Modules_CmdDesc, 0);
/* BEGIN */
+ Modules_FindBinaryDir((void*)Modules_BinaryDir, 1024);
__ENDMOD;
}
diff --git a/bootstrap/unix-88/Modules.h b/bootstrap/unix-88/Modules.h
index 8bb89fe5..ee65a938 100644
--- a/bootstrap/unix-88/Modules.h
+++ b/bootstrap/unix-88/Modules.h
@@ -1,53 +1,30 @@
-/* voc 1.95 [2016/11/24]. 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
#include "SYSTEM.h"
-
-typedef
- struct Modules_CmdDesc *Modules_Cmd;
-
-typedef
- void (*Modules_Command)(void);
-
-typedef
- struct Modules_CmdDesc {
- Modules_Cmd next;
- CHAR name[24];
- Modules_Command cmd;
- } Modules_CmdDesc;
-
-typedef
- struct Modules_ModuleDesc *Modules_Module;
-
-typedef
- CHAR Modules_ModuleName[20];
-
-typedef
- struct Modules_ModuleDesc {
- Modules_Module next;
- Modules_ModuleName name;
- INT32 refcnt;
- Modules_Cmd cmds;
- INT32 types;
- void (*enumPtrs)(void(*)(INT32));
- char _prvt0[8];
- } Modules_ModuleDesc;
+#include "Heap.h"
import INT16 Modules_res;
import CHAR Modules_resMsg[256];
-import Modules_ModuleName Modules_imported, Modules_importing;
+import Heap_ModuleName Modules_imported, Modules_importing;
+import INT64 Modules_MainStackFrame;
+import INT16 Modules_ArgCount;
+import INT64 Modules_ArgVector;
+import CHAR Modules_BinaryDir[1024];
-import ADDRESS *Modules_ModuleDesc__typ;
-import ADDRESS *Modules_CmdDesc__typ;
+import INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len);
import void Modules_AssertFail (INT32 code);
-import void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
+import void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all);
+import void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len);
+import void Modules_GetIntArg (INT16 n, INT32 *val);
import void Modules_Halt (INT32 code);
-import Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
-import Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
+import void Modules_Init (INT32 argc, INT64 argvadr);
+import Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len);
+import Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len);
import void *Modules__init(void);
diff --git a/bootstrap/unix-88/OPB.c b/bootstrap/unix-88/OPB.c
index 3ef8e2f9..913fbf2d 100644
--- a/bootstrap/unix-88/OPB.c
+++ b/bootstrap/unix-88/OPB.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -253,7 +253,7 @@ OPT_Node OPB_NewString (OPS_String str, INT64 len)
x->conval->intval = -1;
x->conval->intval2 = OPM_Longint(len);
x->conval->ext = OPT_NewExt();
- __COPY(str, *x->conval->ext, 256);
+ __MOVE(str, *x->conval->ext, 256);
return x;
}
@@ -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;
@@ -550,7 +550,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
if (__IN(f, 0xf0, 32)) {
if (z->class == 7) {
if (f == 4) {
- if (z->conval->intval == (-9223372036854775807-1)) {
+ if (z->conval->intval == (-9223372036854775807LL-1)) {
OPB_err(203);
} else {
z->conval->intval = -z->conval->intval;
@@ -577,7 +577,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
if (__IN(f, 0x70, 32)) {
if (z->class == 7) {
if (f == 4) {
- if (z->conval->intval == (-9223372036854775807-1)) {
+ if (z->conval->intval == (-9223372036854775807LL-1)) {
OPB_err(203);
} else {
z->conval->intval = __ABS(z->conval->intval);
@@ -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);
@@ -920,7 +920,7 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
if (f == 4) {
xv = xval->intval;
yv = yval->intval;
- if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807-1))) && yv != (-9223372036854775807-1))) && -xv <= __DIV(9223372036854775807, -yv))) {
+ if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807LL, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807LL-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807LL-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807LL-1))) && yv != (-9223372036854775807LL-1))) && -xv <= __DIV(9223372036854775807LL, -yv))) {
xval->intval = xv * yv;
OPB_SetIntType(x);
} else {
@@ -999,8 +999,8 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
break;
case 6:
if (f == 4) {
- temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807 - yval->intval);
- if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807-1) - yval->intval)) {
+ temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807LL - yval->intval);
+ if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807LL-1) - yval->intval)) {
xval->intval += yval->intval;
OPB_SetIntType(x);
} else {
@@ -1023,7 +1023,7 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
break;
case 7:
if (f == 4) {
- if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807 + yval->intval)) {
+ if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807LL-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807LL + yval->intval)) {
xval->intval -= yval->intval;
OPB_SetIntType(x);
} else {
@@ -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);
}
}
@@ -1624,23 +1624,20 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
g = 8;
}
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) {
OPB_err(114);
}
- } else if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
} else {
OPB_err(113);
}
} else {
OPB_err(113);
}
- } else if ((x->comp == 3 && x->BaseTyp == OPT_chartyp)) {
- if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
- } else {
- OPB_err(113);
- }
} else if (x->comp == 4) {
if (x == y) {
} else if (y->comp == 4) {
@@ -2091,7 +2088,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
OPB_err(208);
p->conval->intval = 1;
} else if (x->conval->intval >= 0) {
- if (__ABS(p->conval->intval) <= __DIV(9223372036854775807, (INT64)__ASH(1, x->conval->intval))) {
+ if (__ABS(p->conval->intval) <= __DIV(9223372036854775807LL, (INT64)__ASH(1, x->conval->intval))) {
p->conval->intval = p->conval->intval * (INT64)__ASH(1, x->conval->intval);
} else {
OPB_err(208);
@@ -2536,7 +2533,6 @@ void OPB_Return (OPT_Node *x, OPT_Object proc)
void OPB_Assign (OPT_Node *x, OPT_Node y)
{
OPT_Node z = NIL;
- INT8 subcl;
if ((*x)->class >= 7) {
OPB_err(56);
}
@@ -2562,13 +2558,8 @@ void OPB_Assign (OPT_Node *x, OPT_Node y)
y->conval->intval = 0;
OPB_Index(&*x, OPB_NewIntConst(0));
}
- if ((((((__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp == OPT_chartyp)) && __IN(y->typ->comp, 0x0c, 32))) && y->typ->BaseTyp == OPT_chartyp)) {
- subcl = 18;
- } else {
- subcl = 0;
- }
OPB_BindNodes(19, OPT_notyp, &*x, y);
- (*x)->subcl = subcl;
+ (*x)->subcl = 0;
}
void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ)
@@ -2595,7 +2586,7 @@ export void *OPB__init(void)
__MODULE_IMPORT(OPT);
__REGMOD("OPB", 0);
/* BEGIN */
- OPB_maxExp = OPB_log(4611686018427387904);
+ OPB_maxExp = OPB_log(4611686018427387904LL);
OPB_maxExp = OPB_exp;
__ENDMOD;
}
diff --git a/bootstrap/unix-88/OPB.h b/bootstrap/unix-88/OPB.h
index 0be714e8..f66fcd66 100644
--- a/bootstrap/unix-88/OPB.h
+++ b/bootstrap/unix-88/OPB.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 ef4b429f..7b92ccc1 100644
--- a/bootstrap/unix-88/OPC.c
+++ b/bootstrap/unix-88/OPC.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -56,7 +56,7 @@ static void OPC_GenHeaderMsg (void);
export void OPC_Halt (INT32 n);
export void OPC_Ident (OPT_Object obj);
static void OPC_IdentList (OPT_Object obj, INT16 vis);
-static void OPC_Include (CHAR *name, LONGINT name__len);
+static void OPC_Include (CHAR *name, ADDRESS name__len);
static void OPC_IncludeImports (OPT_Object obj, INT16 vis);
export void OPC_Increment (BOOLEAN decrement);
export void OPC_Indent (INT16 count);
@@ -68,11 +68,11 @@ static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj);
export void OPC_IntLiteral (INT64 n, INT32 size);
export void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim);
static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName);
-static INT16 OPC_Length (CHAR *s, LONGINT s__len);
+static INT16 OPC_Length (CHAR *s, ADDRESS s__len);
export BOOLEAN OPC_NeedsRetval (OPT_Object proc);
export INT32 OPC_NofPtrs (OPT_Struct typ);
-static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len);
-static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len);
+static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len);
+static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len);
static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define);
static void OPC_ProcPredefs (OPT_Object obj, INT8 vis);
static void OPC_PutBase (OPT_Struct typ);
@@ -80,8 +80,8 @@ static void OPC_PutPtrOffsets (OPT_Struct typ, INT32 adr, INT32 *cnt);
static void OPC_RegCmds (OPT_Object obj);
export void OPC_SetInclude (BOOLEAN exclude);
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
-static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x);
-static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l);
+static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x);
+static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l);
export void OPC_TDescDecl (OPT_Struct typ);
export void OPC_TypeDefs (OPT_Object obj, INT16 vis);
export void OPC_TypeOf (OPT_Object ap);
@@ -137,7 +137,7 @@ void OPC_EndBlk0 (void)
OPM_Write('}');
}
-static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
+static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x)
{
CHAR ch;
INT16 i;
@@ -156,7 +156,7 @@ static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
__DEL(s);
}
-static INT16 OPC_Length (CHAR *s, LONGINT s__len)
+static INT16 OPC_Length (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@@ -166,7 +166,7 @@ static INT16 OPC_Length (CHAR *s, LONGINT s__len)
return i;
}
-static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len)
+static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len)
{
INT16 i, h;
i = 0;
@@ -364,7 +364,7 @@ static void OPC_DeclareBase (OPT_Object dcl)
OPM_WriteString((CHAR*)"struct ", 8);
OPC_BegBlk();
OPC_BegStat();
- OPC_Str1((CHAR*)"LONGINT len[#]", 15, nofdims);
+ OPC_Str1((CHAR*)"ADDRESS len[#]", 15, nofdims);
OPC_EndStat();
OPC_BegStat();
__NEW(obj, OPT_ObjDesc);
@@ -511,7 +511,7 @@ static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamNa
typ = par->typ->BaseTyp;
while (typ->comp == 3) {
if (ansiDefine) {
- OPM_WriteString((CHAR*)", LONGINT ", 11);
+ OPM_WriteString((CHAR*)", ADDRESS ", 11);
} else {
OPM_WriteString((CHAR*)", ", 3);
}
@@ -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,12 +721,19 @@ 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();
+ }
}
}
}
}
-static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len)
+static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len)
{
INT16 i;
__DUP(y, y__len, CHAR);
@@ -968,8 +981,8 @@ static void OPC_IdentList (OPT_Object obj, INT16 vis)
if (obj->typ->comp == 3) {
OPC_EndStat();
OPC_BegStat();
- base = OPT_linttyp;
- OPM_WriteString((CHAR*)"LONGINT ", 9);
+ base = OPT_adrtyp;
+ OPM_WriteString((CHAR*)"ADDRESS ", 9);
OPC_LenList(obj, 0, 1);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPC_EndStat();
@@ -1008,7 +1021,7 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
__COPY(name, obj->name, 256);
}
if (obj->typ->comp == 3) {
- OPM_WriteString((CHAR*)", LONGINT ", 11);
+ OPM_WriteString((CHAR*)", ADDRESS ", 11);
OPC_LenList(obj, 1, showParamNames);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPM_WriteString((CHAR*)", ADDRESS *", 12);
@@ -1062,7 +1075,7 @@ static void OPC_ProcPredefs (OPT_Object obj, INT8 vis)
}
}
-static void OPC_Include (CHAR *name, LONGINT name__len)
+static void OPC_Include (CHAR *name, ADDRESS name__len)
{
__DUP(name, name__len, CHAR);
OPM_WriteString((CHAR*)"#include ", 10);
@@ -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) {
@@ -1659,9 +1672,9 @@ void OPC_CompleteIdent (OPT_Object obj)
OPC_Ident(obj);
OPM_WriteString((CHAR*)"__", 3);
} else {
- OPM_WriteString((CHAR*)"((", 3);
+ OPM_WriteString((CHAR*)"(*(", 4);
OPC_Ident(obj->typ->strobj);
- OPM_Write(')');
+ OPM_WriteString((CHAR*)"*)&", 4);
OPC_Ident(obj);
OPM_Write(')');
}
@@ -1739,12 +1752,12 @@ 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('\'');
}
}
-static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l)
+static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
{
INT32 i;
INT16 c;
@@ -1755,16 +1768,16 @@ static void OPC_StringLiteral (CHAR *s, LONGINT 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);
}
}
@@ -1912,9 +1927,9 @@ static struct InitKeywords__46 {
struct InitKeywords__46 *lnk;
} *InitKeywords__46_s;
-static void Enter__47 (CHAR *s, LONGINT s__len);
+static void Enter__47 (CHAR *s, ADDRESS s__len);
-static void Enter__47 (CHAR *s, LONGINT s__len)
+static void Enter__47 (CHAR *s, ADDRESS s__len)
{
INT16 h;
__DUP(s, s__len, CHAR);
diff --git a/bootstrap/unix-88/OPC.h b/bootstrap/unix-88/OPC.h
index 842e7dec..3bfd88b8 100644
--- a/bootstrap/unix-88/OPC.h
+++ b/bootstrap/unix-88/OPC.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 60ab38c7..b486b3b9 100644
--- a/bootstrap/unix-88/OPM.c
+++ b/bootstrap/unix-88/OPM.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,6 +8,7 @@
#include "SYSTEM.h"
#include "Configuration.h"
#include "Files.h"
+#include "Modules.h"
#include "Out.h"
#include "Platform.h"
#include "Strings.h"
@@ -18,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];
@@ -26,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;
@@ -41,41 +44,48 @@ static Files_Rider OPM_oldSF, OPM_newSF;
static Files_Rider OPM_R[3];
static Files_File OPM_oldSFile, OPM_newSFile, OPM_HFile, OPM_BFile, OPM_HIFile;
static INT16 OPM_S;
+export CHAR OPM_InstallDir[1024];
export CHAR OPM_ResourceDir[1024];
static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F);
export void OPM_CloseFiles (void);
export void OPM_CloseOldSym (void);
-export void OPM_DeleteNewSym (void);
+export void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
+export void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
export void OPM_FPrint (INT32 *fp, INT64 val);
export void OPM_FPrintLReal (INT32 *fp, LONGREAL val);
export void OPM_FPrintReal (INT32 *fp, REAL val);
export void OPM_FPrintSet (INT32 *fp, UINT64 val);
+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, LONGINT bytes__len);
+static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len);
export void OPM_Get (CHAR *ch);
-export void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
+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);
+static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len);
+export void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len);
static void OPM_LogErrMsg (INT16 n);
-export void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
+export void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len);
export void OPM_LogW (CHAR ch);
export void OPM_LogWLn (void);
export void OPM_LogWNum (INT64 i, INT64 len);
-export void OPM_LogWStr (CHAR *s, LONGINT s__len);
+export void OPM_LogWStr (CHAR *s, ADDRESS s__len);
export INT32 OPM_Longint (INT64 n);
-static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len);
+static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len);
export void OPM_Mark (INT16 n, INT32 pos);
-export void OPM_NewSym (CHAR *modName, LONGINT modName__len);
-export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
-export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
+export void OPM_NewSym (CHAR *modName, ADDRESS modName__len);
+export void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done);
+export void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len);
export BOOLEAN OPM_OpenPar (void);
export void OPM_RegisterNewSym (void);
-static void OPM_ScanOptions (CHAR *s, LONGINT s__len);
+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);
@@ -87,14 +97,13 @@ export void OPM_SymWInt (INT64 i);
export void OPM_SymWLReal (LONGREAL lr);
export void OPM_SymWReal (REAL r);
export void OPM_SymWSet (UINT64 s);
-static void OPM_VerboseListSizes (void);
export void OPM_Write (CHAR ch);
export void OPM_WriteHex (INT64 i);
export void OPM_WriteInt (INT64 i);
export void OPM_WriteLn (void);
export void OPM_WriteReal (LONGREAL r, CHAR suffx);
-export void OPM_WriteString (CHAR *s, LONGINT s__len);
-export void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
+export void OPM_WriteString (CHAR *s, ADDRESS s__len);
+export void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
export BOOLEAN OPM_eofSF (void);
export void OPM_err (INT16 n);
@@ -105,7 +114,7 @@ void OPM_LogW (CHAR ch)
Out_Char(ch);
}
-void OPM_LogWStr (CHAR *s, LONGINT s__len)
+void OPM_LogWStr (CHAR *s, ADDRESS s__len)
{
__DUP(s, s__len, CHAR);
Out_String(s, s__len);
@@ -122,7 +131,7 @@ void OPM_LogWLn (void)
Out_Ln();
}
-void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
+void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len)
{
__DUP(vt100code, vt100code__len, CHAR);
if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) {
@@ -131,6 +140,57 @@ void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
__DEL(vt100code);
}
+void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len)
+{
+ __DUP(modname, modname__len, CHAR);
+ OPM_LogWStr((CHAR*)"Compiling ", 11);
+ OPM_LogWStr(modname, modname__len);
+ if (__IN(18, OPM_Options, 32)) {
+ OPM_LogWStr((CHAR*)", s:", 5);
+ OPM_LogWNum(__ASHL(OPM_ShortintSize, 3), 1);
+ OPM_LogWStr((CHAR*)" i:", 4);
+ OPM_LogWNum(__ASHL(OPM_IntegerSize, 3), 1);
+ OPM_LogWStr((CHAR*)" l:", 4);
+ OPM_LogWNum(__ASHL(OPM_LongintSize, 3), 1);
+ OPM_LogWStr((CHAR*)" adr:", 6);
+ OPM_LogWNum(__ASHL(OPM_AddressSize, 3), 1);
+ OPM_LogWStr((CHAR*)" algn:", 7);
+ OPM_LogWNum(__ASHL(OPM_Alignment, 3), 1);
+ }
+ OPM_LogW('.');
+ __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;
@@ -154,7 +214,7 @@ INT16 OPM_Integer (INT64 n)
return __VAL(INT16, n);
}
-static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
+static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
@@ -227,29 +287,6 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
i += 2;
}
break;
- case 'B':
- if (s[__X(i + 1, s__len)] != 0x00) {
- i += 1;
- OPM_IntegerSize = (INT16)s[__X(i, s__len)] - 48;
- }
- if (s[__X(i + 1, s__len)] != 0x00) {
- i += 1;
- OPM_AddressSize = (INT16)s[__X(i, s__len)] - 48;
- }
- if (s[__X(i + 1, s__len)] != 0x00) {
- i += 1;
- OPM_Alignment = (INT16)s[__X(i, s__len)] - 48;
- }
- __ASSERT(OPM_IntegerSize == 2 || OPM_IntegerSize == 4, 0);
- __ASSERT(OPM_AddressSize == 4 || OPM_AddressSize == 8, 0);
- __ASSERT(OPM_Alignment == 4 || OPM_Alignment == 8, 0);
- if (OPM_IntegerSize == 2) {
- OPM_LongintSize = 4;
- } else {
- OPM_LongintSize = 8;
- }
- Files_SetSearchPath((CHAR*)"", 1);
- break;
default:
OPM_LogWStr((CHAR*)" warning: option ", 19);
OPM_LogW('-');
@@ -266,16 +303,19 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
BOOLEAN OPM_OpenPar (void)
{
CHAR s[256];
- if (Platform_ArgCount == 1) {
+ 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);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Further development by Norayr Chilingarian, David Brown and others.", 68);
OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Loaded from ", 13);
+ OPM_LogWStr(Modules_BinaryDir, 1024);
+ OPM_LogWLn();
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Usage:", 7);
OPM_LogWLn();
@@ -332,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();
@@ -362,64 +402,38 @@ BOOLEAN OPM_OpenPar (void)
OPM_Options = 0xa9;
OPM_S = 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
}
OPM_GlobalAddressSize = OPM_AddressSize;
OPM_GlobalAlignment = OPM_Alignment;
- __COPY(OPM_Model, OPM_GlobalModel, 10);
+ __MOVE(OPM_Model, OPM_GlobalModel, 10);
OPM_GlobalOptions = OPM_Options;
return 1;
}
__RETCHK;
}
-static void OPM_VerboseListSizes (void)
-{
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Type Size", 15);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"SHORTINT ", 12);
- OPM_LogWNum(OPM_ShortintSize, 4);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"INTEGER ", 12);
- OPM_LogWNum(OPM_IntegerSize, 4);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"LONGINT ", 12);
- OPM_LogWNum(OPM_LongintSize, 4);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"SET ", 12);
- OPM_LogWNum(OPM_LongintSize, 4);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"ADDRESS ", 12);
- OPM_LogWNum(OPM_AddressSize, 4);
- OPM_LogWLn();
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Alignment: ", 12);
- OPM_LogWNum(OPM_Alignment, 4);
- OPM_LogWLn();
-}
-
void OPM_InitOptions (void)
{
CHAR s[256];
CHAR searchpath[1024], modules[1024];
CHAR MODULES[1024];
OPM_Options = OPM_GlobalOptions;
- __COPY(OPM_GlobalModel, OPM_Model, 10);
+ __MOVE(OPM_GlobalModel, OPM_Model, 10);
OPM_Alignment = OPM_GlobalAlignment;
OPM_AddressSize = OPM_GlobalAddressSize;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
}
if (__IN(15, OPM_Options, 32)) {
OPM_Options |= __SETOF(10,32);
@@ -430,29 +444,32 @@ 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;
}
- if (__IN(18, OPM_Options, 32)) {
- OPM_VerboseListSizes();
+ __MOVE(OPM_InstallDir, OPM_ResourceDir, 1024);
+ if (OPM_ResourceDir[0] != 0x00) {
+ Strings_Append((CHAR*)"/", 2, (void*)OPM_ResourceDir, 1024);
+ Strings_Append(OPM_Model, 10, (void*)OPM_ResourceDir, 1024);
}
- OPM_ResourceDir[0] = 0x00;
- Strings_Append((CHAR*)"/", 2, (void*)OPM_ResourceDir, 1024);
- Strings_Append(OPM_Model, 10, (void*)OPM_ResourceDir, 1024);
modules[0] = 0x00;
Platform_GetEnv((CHAR*)"MODULES", 8, (void*)modules, 1024);
__MOVE(".", searchpath, 2);
@@ -465,23 +482,22 @@ void OPM_InitOptions (void)
Files_SetSearchPath(searchpath, 1024);
}
-void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
+void OPM_Init (BOOLEAN *done)
{
Texts_Text T = NIL;
INT32 beg, end, time;
CHAR s[256];
*done = 0;
OPM_curpos = 0;
- if (OPM_S >= Platform_ArgCount) {
+ if (OPM_S >= Modules_ArgCount) {
return;
}
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
__NEW(T, Texts_TextDesc);
Texts_Open(T, s, 256);
OPM_LogWStr(s, 256);
OPM_LogWStr((CHAR*)" ", 3);
- __COPY(s, mname, mname__len);
__COPY(s, OPM_SourceFileName, 256);
if (T->len == 0) {
OPM_LogWStr(s, 256);
@@ -503,18 +519,14 @@ void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
void OPM_Get (CHAR *ch)
{
+ OPM_curpos = Texts_Pos(&OPM_inR, Texts_Reader__typ);
Texts_Read(&OPM_inR, Texts_Reader__typ, &*ch);
- if (*ch == 0x0d) {
- OPM_curpos = Texts_Pos(&OPM_inR, Texts_Reader__typ);
- } else {
- OPM_curpos += 1;
- }
if ((*ch < 0x09 && !OPM_inR.eot)) {
*ch = ' ';
}
}
-static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len)
+static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len)
{
INT16 i, j;
CHAR ch;
@@ -632,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;
@@ -640,7 +652,6 @@ static void OPM_ShowLine (INT64 pos)
OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogW('^');
OPM_LogVT100((CHAR*)"0m", 3);
- Files_Close(f);
}
void OPM_Mark (INT16 n, INT32 pos)
@@ -700,7 +711,7 @@ void OPM_err (INT16 n)
OPM_Mark(n, OPM_errpos);
}
-static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len)
+static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len)
{
INT16 i;
INT32 l;
@@ -772,10 +783,13 @@ void OPM_CloseOldSym (void)
Files_Close(Files_Base(&OPM_oldSF, Files_Rider__typ));
}
-void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done)
+void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done)
{
CHAR tag, ver;
OPM_FileName fileName;
+ INT16 res;
+ OPM_oldSFile = NIL;
+ *done = 0;
OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
OPM_oldSFile = Files_Old(fileName, 32);
*done = OPM_oldSFile != NIL;
@@ -783,8 +797,10 @@ void OPM_OldSym (CHAR *modName, LONGINT 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 != 0x82) {
- OPM_err(-306);
+ if (tag != 0xf7 || ver != 0x84) {
+ if (!__IN(4, OPM_Options, 32)) {
+ OPM_err(-306);
+ }
OPM_CloseOldSym();
*done = 0;
}
@@ -828,11 +844,23 @@ void OPM_RegisterNewSym (void)
}
}
-void OPM_DeleteNewSym (void)
+void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len)
{
+ OPM_FileName fn;
+ INT16 res;
+ OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".sym", 5);
+ Files_Delete(fn, 32, &res);
}
-void OPM_NewSym (CHAR *modName, LONGINT modName__len)
+void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len)
+{
+ OPM_FileName fn;
+ INT16 res;
+ OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".o", 3);
+ Files_Delete(fn, 32, &res);
+}
+
+void OPM_NewSym (CHAR *modName, ADDRESS modName__len)
{
OPM_FileName fileName;
OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
@@ -840,7 +868,7 @@ void OPM_NewSym (CHAR *modName, LONGINT 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, 0x82);
+ Files_Write(&OPM_newSF, Files_Rider__typ, 0x84);
} else {
OPM_err(153);
}
@@ -851,7 +879,7 @@ void OPM_Write (CHAR ch)
Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, ch);
}
-void OPM_WriteString (CHAR *s, LONGINT s__len)
+void OPM_WriteString (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@@ -861,7 +889,7 @@ void OPM_WriteString (CHAR *s, LONGINT s__len)
Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}
-void OPM_WriteStringVar (CHAR *s, LONGINT s__len)
+void OPM_WriteStringVar (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@@ -875,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);
@@ -893,7 +921,7 @@ void OPM_WriteHex (INT64 i)
void OPM_WriteInt (INT64 i)
{
- CHAR s[24];
+ CHAR s[26];
INT64 i1, k;
if ((i == OPM_SignedMinimum(2) || i == OPM_SignedMinimum(4)) || i == OPM_SignedMinimum(8)) {
OPM_Write('(');
@@ -901,21 +929,27 @@ void OPM_WriteInt (INT64 i)
OPM_WriteString((CHAR*)"-1)", 4);
} else {
i1 = __ABS(i);
- s[0] = (CHAR)(__MOD(i1, 10) + 48);
+ if (i1 <= 2147483647) {
+ k = 0;
+ } else {
+ __MOVE("LL", s, 3);
+ k = 2;
+ }
+ s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
- k = 1;
+ k += 1;
while (i1 > 0) {
- s[__X(k, 24)] = (CHAR)(__MOD(i1, 10) + 48);
+ s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k += 1;
}
if (i < 0) {
- s[__X(k, 24)] = '-';
+ s[__X(k, 26)] = '-';
k += 1;
}
while (k > 0) {
k -= 1;
- OPM_Write(s[__X(k, 24)]);
+ OPM_Write(s[__X(k, 26)]);
}
}
}
@@ -928,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') {
@@ -986,9 +1020,9 @@ static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F)
}
}
-void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
+void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len)
{
- CHAR FName[32];
+ OPM_FileName FName;
__COPY(moduleName, OPM_modName, 32);
OPM_HFile = Files_New((CHAR*)"", 1);
if (OPM_HFile != NIL) {
@@ -1014,7 +1048,7 @@ void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
void OPM_CloseFiles (void)
{
- CHAR FName[32];
+ OPM_FileName FName;
INT16 res;
if (OPM_noerr) {
OPM_LogWStr((CHAR*)" ", 3);
@@ -1050,6 +1084,59 @@ void OPM_CloseFiles (void)
Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, 0);
}
+static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len)
+{
+ CHAR testpath[4096];
+ Platform_FileIdentity identity;
+ __DUP(s, s__len, CHAR);
+ __COPY(OPM_InstallDir, testpath, 4096);
+ Strings_Append((CHAR*)"/lib/lib", 9, (void*)testpath, 4096);
+ Strings_Append((CHAR*)"voc", 4, (void*)testpath, 4096);
+ Strings_Append((CHAR*)"-O2.a", 6, (void*)testpath, 4096);
+ if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
+ __DEL(s);
+ return 0;
+ }
+ __COPY(OPM_InstallDir, testpath, 4096);
+ Strings_Append((CHAR*)"/2/include/Oberon.h", 20, (void*)testpath, 4096);
+ if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
+ __DEL(s);
+ return 0;
+ }
+ __COPY(OPM_InstallDir, testpath, 4096);
+ Strings_Append((CHAR*)"/2/sym/Files.sym", 17, (void*)testpath, 4096);
+ if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
+ __DEL(s);
+ return 0;
+ }
+ __DEL(s);
+ return 1;
+}
+
+static void OPM_FindInstallDir (void)
+{
+ INT16 i;
+ __COPY(Modules_BinaryDir, OPM_InstallDir, 1024);
+ Strings_Append((CHAR*)"/", 2, (void*)OPM_InstallDir, 1024);
+ Strings_Append((CHAR*)"voc", 4, (void*)OPM_InstallDir, 1024);
+ Strings_Append((CHAR*)".d", 3, (void*)OPM_InstallDir, 1024);
+ if (OPM_IsProbablyInstallDir(OPM_InstallDir, 1024)) {
+ return;
+ }
+ __COPY(Modules_BinaryDir, OPM_InstallDir, 1024);
+ i = Strings_Length(OPM_InstallDir, 1024);
+ while ((i > 0 && OPM_InstallDir[__X(i - 1, 1024)] != '/')) {
+ i -= 1;
+ }
+ if ((i > 0 && OPM_InstallDir[__X(i - 1, 1024)] == '/')) {
+ OPM_InstallDir[__X(i - 1, 1024)] = 0x00;
+ if (OPM_IsProbablyInstallDir(OPM_InstallDir, 1024)) {
+ return;
+ }
+ }
+ __COPY("", OPM_InstallDir, 1024);
+}
+
static void EnumPtrs(void (*P)(void*))
{
__ENUMR(&OPM_inR, Texts_Reader__typ, 72, 1, P);
@@ -1071,6 +1158,7 @@ export void *OPM__init(void)
__DEFMOD;
__MODULE_IMPORT(Configuration);
__MODULE_IMPORT(Files);
+ __MODULE_IMPORT(Modules);
__MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
@@ -1079,7 +1167,6 @@ export void *OPM__init(void)
__REGMOD("OPM", EnumPtrs);
__REGCMD("CloseFiles", OPM_CloseFiles);
__REGCMD("CloseOldSym", OPM_CloseOldSym);
- __REGCMD("DeleteNewSym", OPM_DeleteNewSym);
__REGCMD("InitOptions", OPM_InitOptions);
__REGCMD("LogWLn", OPM_LogWLn);
__REGCMD("RegisterNewSym", OPM_RegisterNewSym);
@@ -1089,5 +1176,8 @@ export void *OPM__init(void)
OPM_MaxLReal = 1.79769296342094e+308;
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 2d272feb..64c15a28 100644
--- a/bootstrap/unix-88/OPM.h
+++ b/bootstrap/unix-88/OPM.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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;
@@ -17,34 +17,39 @@ import INT32 OPM_curpos, OPM_errpos, OPM_breakpc;
import INT16 OPM_currFile, OPM_level, OPM_pc, OPM_entno;
import CHAR OPM_modName[32];
import CHAR OPM_objname[64];
+import CHAR OPM_InstallDir[1024];
import CHAR OPM_ResourceDir[1024];
import void OPM_CloseFiles (void);
import void OPM_CloseOldSym (void);
-import void OPM_DeleteNewSym (void);
+import void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
+import void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
import void OPM_FPrint (INT32 *fp, INT64 val);
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_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
+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);
-import void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
+import void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len);
+import void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len);
import void OPM_LogW (CHAR ch);
import void OPM_LogWLn (void);
import void OPM_LogWNum (INT64 i, INT64 len);
-import void OPM_LogWStr (CHAR *s, LONGINT s__len);
+import void OPM_LogWStr (CHAR *s, ADDRESS s__len);
import INT32 OPM_Longint (INT64 n);
import void OPM_Mark (INT16 n, INT32 pos);
-import void OPM_NewSym (CHAR *modName, LONGINT modName__len);
-import void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
-import void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
+import void OPM_NewSym (CHAR *modName, ADDRESS modName__len);
+import void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done);
+import void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len);
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);
@@ -61,8 +66,8 @@ import void OPM_WriteHex (INT64 i);
import void OPM_WriteInt (INT64 i);
import void OPM_WriteLn (void);
import void OPM_WriteReal (LONGREAL r, CHAR suffx);
-import void OPM_WriteString (CHAR *s, LONGINT s__len);
-import void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
+import void OPM_WriteString (CHAR *s, ADDRESS s__len);
+import void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
import BOOLEAN OPM_eofSF (void);
import void OPM_err (INT16 n);
import void *OPM__init(void);
diff --git a/bootstrap/unix-88/OPP.c b/bootstrap/unix-88/OPP.c
index df908a43..3fed2e31 100644
--- a/bootstrap/unix-88/OPP.c
+++ b/bootstrap/unix-88/OPP.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -527,7 +527,7 @@ static void OPP_selector (OPT_Node *x)
} else if (OPP_sym == 18) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
- __COPY(OPS_name, name, 256);
+ __MOVE(OPS_name, name, 256);
OPS_Get(&OPP_sym);
if ((*x)->typ != NIL) {
if ((*x)->typ->form == 11) {
@@ -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);
@@ -867,7 +867,7 @@ static void OPP_Receiver (INT8 *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct
} else {
*mode = 1;
}
- __COPY(OPS_name, name, 256);
+ __MOVE(OPS_name, name, 256);
OPP_CheckSym(38);
OPP_CheckSym(20);
if (OPP_sym == 38) {
@@ -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;
}
}
@@ -1030,7 +1030,7 @@ static void TProcDecl__23 (void)
}
OPP_Receiver(&objMode, objName, &objTyp, &recTyp);
if (OPP_sym == 38) {
- __COPY(OPS_name, *ProcedureDeclaration__16_s->name, 256);
+ __MOVE(OPS_name, *ProcedureDeclaration__16_s->name, 256);
OPP_CheckMark(&*ProcedureDeclaration__16_s->vis);
OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp, &*ProcedureDeclaration__16_s->fwd);
OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp->BaseTyp, &baseProc);
@@ -1129,7 +1129,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
TProcDecl__23();
} else if (OPP_sym == 38) {
OPT_Find(&fwd);
- __COPY(OPS_name, name, 256);
+ __MOVE(OPS_name, name, 256);
OPP_CheckMark(&vis);
if ((vis != 0 && mode == 6)) {
mode = 7;
@@ -1665,6 +1665,9 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
obj->typ = OPT_undftyp;
OPP_CheckMark(&obj->vis);
if (OPP_sym == 9) {
+ if (((((((((__STRCMP(obj->name, "SHORTINT") == 0 || __STRCMP(obj->name, "INTEGER") == 0) || __STRCMP(obj->name, "LONGINT") == 0) || __STRCMP(obj->name, "HUGEINT") == 0) || __STRCMP(obj->name, "REAL") == 0) || __STRCMP(obj->name, "LONGREAL") == 0) || __STRCMP(obj->name, "SET") == 0) || __STRCMP(obj->name, "CHAR") == 0) || __STRCMP(obj->name, "TRUE") == 0) || __STRCMP(obj->name, "FALSE") == 0) {
+ OPM_Mark(-310, OPM_curpos);
+ }
OPS_Get(&OPP_sym);
OPP_TypeDecl(&obj->typ, &obj->typ);
} else if (OPP_sym == 34 || OPP_sym == 20) {
@@ -1790,30 +1793,10 @@ void OPP_Module (OPT_Node *prog, UINT32 opt)
if (OPP_sym == 63) {
OPS_Get(&OPP_sym);
} else {
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Unexpected symbol found when MODULE expected:", 46);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" sym: ", 15);
- OPM_LogWNum(OPP_sym, 1);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.name: ", 15);
- OPM_LogWStr(OPS_name, 256);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.str: ", 15);
- OPM_LogWStr(OPS_str, 256);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.numtyp: ", 15);
- OPM_LogWNum(OPS_numtyp, 1);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.intval: ", 15);
- OPM_LogWNum(OPS_intval, 1);
- OPM_LogWLn();
OPP_err(16);
}
if (OPP_sym == 38) {
- OPM_LogWStr((CHAR*)"compiling ", 11);
- OPM_LogWStr(OPS_name, 256);
- OPM_LogW('.');
+ OPM_LogCompiling(OPS_name, 256);
OPT_Init(OPS_name, opt);
OPS_Get(&OPP_sym);
OPP_CheckSym(39);
diff --git a/bootstrap/unix-88/OPP.h b/bootstrap/unix-88/OPP.h
index 5a71eb39..3d8cefe8 100644
--- a/bootstrap/unix-88/OPP.h
+++ b/bootstrap/unix-88/OPP.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 6ee700e5..a25a2c12 100644
--- a/bootstrap/unix-88/OPS.c
+++ b/bootstrap/unix-88/OPS.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,9 +196,9 @@ 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(9223372036854775807 - (INT64)d, 10)) {
+ if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) {
OPS_intval = OPS_intval * 10 + (INT64)d;
} else {
OPS_err(203);
@@ -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 1f7a3e58..19e222ac 100644
--- a/bootstrap/unix-88/OPS.h
+++ b/bootstrap/unix-88/OPS.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 a8d42b40..c3999981 100644
--- a/bootstrap/unix-88/OPT.c
+++ b/bootstrap/unix-88/OPT.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -49,6 +49,15 @@ typedef
INT8 glbmno[64];
} OPT_ImpCtxt;
+typedef
+ struct OPT_LinkDesc *OPT_Link;
+
+typedef
+ struct OPT_LinkDesc {
+ OPS_Name name;
+ OPT_Link next;
+ } OPT_LinkDesc;
+
typedef
struct OPT_NodeDesc *OPT_Node;
@@ -74,6 +83,7 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
+ OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@@ -101,6 +111,7 @@ static OPT_ExpCtxt OPT_expCtxt;
static INT32 OPT_nofhdfld;
static BOOLEAN OPT_newsf, OPT_findpc, OPT_extsf, OPT_sfpresent, OPT_symExtended, OPT_symNew;
static INT32 OPT_recno;
+export OPT_Link OPT_Links;
export ADDRESS *OPT_ConstDesc__typ;
export ADDRESS *OPT_ObjDesc__typ;
@@ -108,6 +119,7 @@ export ADDRESS *OPT_StrDesc__typ;
export ADDRESS *OPT_NodeDesc__typ;
export ADDRESS *OPT_ImpCtxt__typ;
export ADDRESS *OPT_ExpCtxt__typ;
+export ADDRESS *OPT_LinkDesc__typ;
export void OPT_Align (INT32 *adr, INT32 base);
export INT32 OPT_BaseAlignment (OPT_Struct typ);
@@ -120,7 +132,7 @@ static void OPT_EnterTyp (OPS_Name name, INT8 form, INT16 size, OPT_Struct *res)
static void OPT_EnterTypeAlias (OPS_Name name, OPT_Object *res);
export void OPT_Export (BOOLEAN *ext, BOOLEAN *new);
export void OPT_FPrintErr (OPT_Object obj, INT16 errcode);
-static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len);
+static void OPT_FPrintName (INT32 *fp, CHAR *name, ADDRESS name__len);
export void OPT_FPrintObj (OPT_Object obj);
static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par);
export void OPT_FPrintStr (OPT_Struct typ);
@@ -131,8 +143,9 @@ export void OPT_IdFPrint (OPT_Struct typ);
export void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
static void OPT_InConstant (INT32 f, OPT_Const conval);
static OPT_Object OPT_InFld (void);
+static void OPT_InLinks (void);
static void OPT_InMod (INT8 *mno);
-static void OPT_InName (CHAR *name, LONGINT name__len);
+static void OPT_InName (CHAR *name, ADDRESS name__len);
static OPT_Object OPT_InObj (INT8 mno);
static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par);
static void OPT_InStruct (OPT_Struct *typ);
@@ -154,12 +167,14 @@ export void OPT_OpenScope (INT8 level, OPT_Object owner);
static void OPT_OutConstant (OPT_Object obj);
static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible);
static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr);
+static void OPT_OutLinks (void);
static void OPT_OutMod (INT16 mno);
-static void OPT_OutName (CHAR *name, LONGINT name__len);
+static void OPT_OutName (CHAR *name, ADDRESS name__len);
static void OPT_OutObj (OPT_Object obj);
static void OPT_OutSign (OPT_Struct result, OPT_Object par);
static void OPT_OutStr (OPT_Struct typ);
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj);
+static void OPT_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);
@@ -339,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;
@@ -375,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;
}
@@ -434,14 +453,16 @@ void OPT_Init (OPS_Name name, UINT32 opt)
OPT_topScope = OPT_universe;
OPT_OpenScope(0, NIL);
OPT_SYSimported = 0;
- __COPY(name, OPT_SelfName, 256);
- __COPY(name, OPT_topScope->name, 256);
+ __MOVE(name, OPT_SelfName, 256);
+ __MOVE(name, OPT_topScope->name, 256);
OPT_GlbMod[0] = OPT_topScope;
OPT_nofGmod = 1;
OPT_newsf = __IN(4, opt, 32);
OPT_findpc = __IN(8, opt, 32);
OPT_extsf = OPT_newsf || __IN(9, opt, 32);
OPT_sfpresent = 1;
+ __NEW(OPT_Links, OPT_LinkDesc);
+ __MOVE(name, OPT_Links->name, 256);
}
void OPT_Close (void)
@@ -539,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;
@@ -570,13 +593,23 @@ 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;
}
}
*obj = ob1;
}
-static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len)
+static void OPT_FPrintName (INT32 *fp, CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@@ -957,7 +990,7 @@ void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old)
}
}
-static void OPT_InName (CHAR *name, LONGINT name__len)
+static void OPT_InName (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@@ -1011,6 +1044,26 @@ static void OPT_InMod (INT8 *mno)
}
}
+static void OPT_InLinks (void)
+{
+ OPS_Name linkname;
+ OPT_Link l = NIL;
+ OPT_InName((void*)linkname, 256);
+ while (linkname[0] != 0x00) {
+ l = OPT_Links;
+ while ((l != NIL && __STRCMP(l->name, linkname) != 0)) {
+ l = l->next;
+ }
+ if (l == NIL) {
+ l = OPT_Links;
+ __NEW(OPT_Links, OPT_LinkDesc);
+ OPT_Links->next = l;
+ __MOVE(linkname, OPT_Links->name, 256);
+ }
+ OPT_InName((void*)linkname, 256);
+ }
+}
+
static void OPT_InConstant (INT32 f, OPT_Const conval)
{
CHAR ch;
@@ -1068,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) {
@@ -1186,7 +1246,7 @@ static void OPT_InStruct (OPT_Struct *typ)
}
*typ = OPT_NewStr(0, 1);
} else {
- __COPY(name, obj->name, 256);
+ __MOVE(name, obj->name, 256);
OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
if (old != NIL) {
OPT_FPrintObj(old);
@@ -1216,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) {
@@ -1346,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;
@@ -1362,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);
@@ -1377,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)]);
@@ -1389,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);
@@ -1458,9 +1565,15 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
OPT_impCtxt.nofm = 0;
OPT_impCtxt.self = __STRCMP(aliasName, "@self") == 0;
OPT_impCtxt.reffp = 0;
- OPM_OldSym((void*)name, 256, &*done);
+ if ((OPT_impCtxt.self && __IN(17, OPM_Options, 32))) {
+ OPM_DeleteSym((void*)name, 256);
+ *done = 0;
+ } else {
+ OPM_OldSym((void*)name, 256, &*done);
+ }
if (*done) {
OPT_InMod(&mno);
+ OPT_InLinks();
OPT_impCtxt.nextTag = OPM_SymRInt();
while (!OPM_eofSF()) {
obj = OPT_InObj(mno);
@@ -1483,7 +1596,7 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
}
}
-static void OPT_OutName (CHAR *name, LONGINT name__len)
+static void OPT_OutName (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@@ -1507,6 +1620,17 @@ static void OPT_OutMod (INT16 mno)
}
}
+static void OPT_OutLinks (void)
+{
+ OPT_Link l = NIL;
+ l = OPT_Links;
+ while (l != NIL) {
+ OPT_OutName((void*)l->name, 256);
+ l = l->next;
+ }
+ OPM_SymWCh(0x00);
+}
+
static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr)
{
INT32 i, j, n;
@@ -1700,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);
@@ -1728,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) {
@@ -1833,6 +1984,7 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
if (OPM_noerr) {
OPM_SymWInt(16);
OPT_OutName((void*)OPT_SelfName, 256);
+ OPT_OutLinks();
OPT_expCtxt.reffp = 0;
OPT_expCtxt.ref = 14;
OPT_expCtxt.nofm = 1;
@@ -1854,7 +2006,7 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
OPT_newsf = 0;
OPT_symNew = 0;
if (!OPM_noerr || OPT_findpc) {
- OPM_DeleteNewSym();
+ OPM_DeleteSym((void*)OPT_SelfName, 256);
}
}
}
@@ -1969,10 +2121,11 @@ static void EnumPtrs(void (*P)(void*))
P(OPT_universe);
P(OPT_syslink);
__ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 5184, 1, P);
+ P(OPT_Links);
}
__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,
@@ -2008,6 +2161,7 @@ __TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 5184), {16, 24, 32, 40, 48,
3856, 3864, 3872, 3880, 3888, 3896, 3904, 3912, 3920, 3928, 3936, 3944, 3952, 3960, 3968, 3976,
3984, 3992, 4000, 4008, 4016, 4024, 4032, 4040, 4048, 4056, 4064, 4072, 4080, 4088, -4088}};
__TDESC(OPT_ExpCtxt, 1, 0) = {__TDFLDS("ExpCtxt", 72), {-8}};
+__TDESC(OPT_LinkDesc, 1, 1) = {__TDFLDS("LinkDesc", 264), {256, -16}};
export void *OPT__init(void)
{
@@ -2024,6 +2178,7 @@ export void *OPT__init(void)
__INITYP(OPT_NodeDesc, OPT_NodeDesc, 0);
__INITYP(OPT_ImpCtxt, OPT_ImpCtxt, 0);
__INITYP(OPT_ExpCtxt, OPT_ExpCtxt, 0);
+ __INITYP(OPT_LinkDesc, OPT_LinkDesc, 0);
/* BEGIN */
OPT_topScope = NIL;
OPT_OpenScope(0, NIL);
diff --git a/bootstrap/unix-88/OPT.h b/bootstrap/unix-88/OPT.h
index 90fcacf5..cf456af5 100644
--- a/bootstrap/unix-88/OPT.h
+++ b/bootstrap/unix-88/OPT.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -21,6 +21,15 @@ typedef
LONGREAL realval;
} OPT_ConstDesc;
+typedef
+ struct OPT_LinkDesc *OPT_Link;
+
+typedef
+ struct OPT_LinkDesc {
+ OPS_Name name;
+ OPT_Link next;
+ } OPT_LinkDesc;
+
typedef
struct OPT_NodeDesc *OPT_Node;
@@ -52,6 +61,7 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
+ OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@@ -75,11 +85,13 @@ import INT8 OPT_nofGmod;
import OPT_Object OPT_GlbMod[64];
import OPS_Name OPT_SelfName;
import BOOLEAN OPT_SYSimported;
+import OPT_Link OPT_Links;
import ADDRESS *OPT_ConstDesc__typ;
import ADDRESS *OPT_ObjDesc__typ;
import ADDRESS *OPT_StrDesc__typ;
import ADDRESS *OPT_NodeDesc__typ;
+import ADDRESS *OPT_LinkDesc__typ;
import void OPT_Align (INT32 *adr, INT32 base);
import INT32 OPT_BaseAlignment (OPT_Struct typ);
diff --git a/bootstrap/unix-88/OPV.c b/bootstrap/unix-88/OPV.c
index 4bd6b3fb..26c1c715 100644
--- a/bootstrap/unix-88/OPV.c
+++ b/bootstrap/unix-88/OPV.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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));
@@ -163,7 +163,7 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
}
scope = obj->scope;
scope->leaf = 1;
- __COPY(obj->name, scope->name, 256);
+ __MOVE(obj->name, scope->name, 256);
OPV_Stamp(scope->name);
if (mode == 9) {
obj->adr = 1;
@@ -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);
@@ -1286,7 +1297,17 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPM_WriteString((CHAR*)", ", 3);
if (r->typ == OPT_stringtyp) {
OPM_WriteInt(r->conval->intval2);
+ } else if (r->typ->comp == 3) {
+ OPM_WriteString((CHAR*)"__X(", 5);
+ OPC_Len(r->obj, r->typ, 0);
+ OPM_WriteString((CHAR*)" * ", 4);
+ OPM_WriteInt(r->typ->BaseTyp->size);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteInt(l->typ->size + 1);
+ OPM_Write(')');
} else {
+ __ASSERT(r->typ->comp == 2, 0);
+ __ASSERT(r->typ->size <= l->typ->size, 0);
OPM_WriteInt(r->typ->size);
}
OPM_Write(')');
diff --git a/bootstrap/unix-88/OPV.h b/bootstrap/unix-88/OPV.h
index c4a61586..fbabd8f4 100644
--- a/bootstrap/unix-88/OPV.h
+++ b/bootstrap/unix-88/OPV.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 39f383cf..ce936589 100644
--- a/bootstrap/unix-88/Out.c
+++ b/bootstrap/unix-88/Out.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 "Heap.h"
#include "Platform.h"
@@ -16,17 +17,18 @@ static INT16 Out_in;
export void Out_Char (CHAR ch);
export void Out_Flush (void);
+export void Out_Hex (INT64 x, INT64 n);
export void Out_Int (INT64 x, INT64 n);
-static INT32 Out_Length (CHAR *s, LONGINT s__len);
+static INT32 Out_Length (CHAR *s, ADDRESS s__len);
export void Out_Ln (void);
export void Out_LongReal (LONGREAL x, INT16 n);
export void Out_Open (void);
export void Out_Real (REAL x, INT16 n);
static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_);
-export void Out_String (CHAR *str, LONGINT str__len);
+export void Out_String (CHAR *str, ADDRESS str__len);
export LONGREAL Out_Ten (INT16 e);
-static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i);
-static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i);
+static void Out_digit (INT64 n, CHAR *s, ADDRESS s__len, INT16 *i);
+static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i);
#define Out_Entier64(x) (INT64)(x)
@@ -55,7 +57,7 @@ void Out_Char (CHAR ch)
}
}
-static INT32 Out_Length (CHAR *s, LONGINT s__len)
+static INT32 Out_Length (CHAR *s, ADDRESS s__len)
{
INT32 l;
l = 0;
@@ -65,7 +67,7 @@ static INT32 Out_Length (CHAR *s, LONGINT s__len)
return l;
}
-void Out_String (CHAR *str, LONGINT str__len)
+void Out_String (CHAR *str, ADDRESS str__len)
{
INT32 l;
INT16 error;
@@ -78,7 +80,7 @@ void Out_String (CHAR *str, LONGINT 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);
}
@@ -89,18 +91,18 @@ void Out_Int (INT64 x, INT64 n)
INT16 i;
BOOLEAN negative;
negative = x < 0;
- if (x == (-9223372036854775807-1)) {
+ if (x == (-9223372036854775807LL-1)) {
__MOVE("8085774586302733229", s, 20);
i = 19;
} else {
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;
}
@@ -119,19 +121,43 @@ void Out_Int (INT64 x, INT64 n)
}
}
+void Out_Hex (INT64 x, INT64 n)
+{
+ if (n < 1) {
+ n = 1;
+ } else if (n > 16) {
+ n = 16;
+ }
+ if (x >= 0) {
+ while ((n < 16 && __LSH(x, -__ASHL(n, 2), 64) != 0)) {
+ n += 1;
+ }
+ }
+ x = __ROT(x, __ASHL(16 - n, 2), 64);
+ while (n > 0) {
+ x = __ROTL(x, 4, 64);
+ n -= 1;
+ if (__MASK(x, -16) < 10) {
+ Out_Char(__CHR(__MASK(x, -16) + 48));
+ } else {
+ Out_Char(__CHR((__MASK(x, -16) - 10) + 65));
+ }
+ }
+}
+
void Out_Ln (void)
{
Out_String(Platform_NL, 3);
Out_Flush();
}
-static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i)
+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, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i)
+static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i)
{
INT16 j;
INT32 l;
@@ -140,7 +166,7 @@ static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT 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)];
@@ -175,7 +201,7 @@ static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_)
INT64 m;
INT16 d, dr;
e = (INT16)__MASK(__ASHR((__VAL(INT64, x)), 52), -2048);
- f = __MASK((__VAL(INT64, x)), -4503599627370496);
+ f = __MASK((__VAL(INT64, x)), -4503599627370496LL);
nn = (__VAL(INT64, x) < 0 && !((e == 2047 && f != 0)));
if (nn) {
n -= 1;
@@ -222,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 {
@@ -306,6 +332,7 @@ void Out_LongReal (LONGREAL x, INT16 n)
export void *Out__init(void)
{
__DEFMOD;
+ __MODULE_IMPORT(Heap);
__MODULE_IMPORT(Platform);
__REGMOD("Out", 0);
__REGCMD("Flush", Out_Flush);
diff --git a/bootstrap/unix-88/Out.h b/bootstrap/unix-88/Out.h
index 0e66420d..a72547f4 100644
--- a/bootstrap/unix-88/Out.h
+++ b/bootstrap/unix-88/Out.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -11,12 +11,13 @@ import BOOLEAN Out_IsConsole;
import void Out_Char (CHAR ch);
import void Out_Flush (void);
+import void Out_Hex (INT64 x, INT64 n);
import void Out_Int (INT64 x, INT64 n);
import void Out_Ln (void);
import void Out_LongReal (LONGREAL x, INT16 n);
import void Out_Open (void);
import void Out_Real (REAL x, INT16 n);
-import void Out_String (CHAR *str, LONGINT str__len);
+import void Out_String (CHAR *str, ADDRESS str__len);
import LONGREAL Out_Ten (INT16 e);
import void *Out__init(void);
diff --git a/bootstrap/unix-88/Platform.c b/bootstrap/unix-88/Platform.c
index 46e18441..139181a0 100644
--- a/bootstrap/unix-88/Platform.c
+++ b/bootstrap/unix-88/Platform.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,37 +7,18 @@
#include "SYSTEM.h"
-typedef
- CHAR (*Platform_ArgPtr)[1024];
-
-typedef
- Platform_ArgPtr (*Platform_ArgVec)[1024];
-
-typedef
- INT64 (*Platform_ArgVecPtr)[1];
-
-typedef
- CHAR (*Platform_EnvPtr)[1024];
-
typedef
struct Platform_FileIdentity {
INT32 volume, index, mtime;
} Platform_FileIdentity;
-typedef
- void (*Platform_HaltProcedure)(INT32);
-
typedef
void (*Platform_SignalHandler)(INT32);
export BOOLEAN Platform_LittleEndian;
-export INT64 Platform_MainStackFrame;
export INT16 Platform_PID;
export CHAR Platform_CWD[256];
-export INT16 Platform_ArgCount;
-export INT64 Platform_ArgVector;
-static Platform_HaltProcedure Platform_HaltHandler;
static INT32 Platform_TimeStart;
export INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
export CHAR Platform_NL[3];
@@ -45,35 +26,33 @@ export CHAR Platform_NL[3];
export ADDRESS *Platform_FileIdentity__typ;
export BOOLEAN Platform_Absent (INT16 e);
-export INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
-export INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
+export INT16 Platform_Chdir (CHAR *n, ADDRESS n__len);
export INT16 Platform_Close (INT32 h);
export BOOLEAN Platform_ConnectionFailed (INT16 e);
export void Platform_Delay (INT32 ms);
export BOOLEAN Platform_DifferentFilesystems (INT16 e);
export INT16 Platform_Error (void);
export void Platform_Exit (INT32 code);
-export void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
export void Platform_GetClock (INT32 *t, INT32 *d);
-export void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
-export void Platform_GetIntArg (INT16 n, INT32 *val);
+export void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
export void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec);
export INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *identity__typ);
-export INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
+export INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
export BOOLEAN Platform_Inaccessible (INT16 e);
-export void Platform_Init (INT32 argc, INT64 argvadr);
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_New (CHAR *n, LONGINT n__len, INT32 *h);
+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);
export void Platform_OSFree (INT64 address);
-export INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h);
-export INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h);
+export INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h);
+export INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h);
export INT16 Platform_Read (INT32 h, INT64 p, INT32 l, INT32 *n);
-export INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n);
-export INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
+export INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n);
+export INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len);
export BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2);
export BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2);
export INT16 Platform_Seek (INT32 h, INT32 offset, INT16 whence);
@@ -83,16 +62,16 @@ export void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__t
export void Platform_SetQuitHandler (Platform_SignalHandler handler);
export INT16 Platform_Size (INT32 h, INT32 *l);
export INT16 Platform_Sync (INT32 h);
-export INT16 Platform_System (CHAR *cmd, LONGINT cmd__len);
+export INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len);
static void Platform_TestLittleEndian (void);
export INT32 Platform_Time (void);
export BOOLEAN Platform_TimedOut (INT16 e);
export BOOLEAN Platform_TooManyFiles (INT16 e);
export INT16 Platform_Truncate (INT32 h, INT32 l);
-export INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
+export INT16 Platform_Unlink (CHAR *n, ADDRESS n__len);
export INT16 Platform_Write (INT32 h, INT64 p, INT32 l);
static void Platform_YMDHMStoClock (INT32 ye, INT32 mo, INT32 da, INT32 ho, INT32 mi, INT32 se, INT32 *t, INT32 *d);
-export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
+export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
#include
#include
@@ -102,6 +81,7 @@ export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT
#include
#include
#include
+#include
#include
#include
#define Platform_EACCES() EACCES
@@ -117,8 +97,8 @@ export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT
#define Platform_EROFS() EROFS
#define Platform_ETIMEDOUT() ETIMEDOUT
#define Platform_EXDEV() EXDEV
-extern void Heap_InitHeap();
-#define Platform_HeapInitHeap() Heap_InitHeap()
+#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)
@@ -129,7 +109,7 @@ extern void Heap_InitHeap();
#define Platform_fsync(fd) fsync(fd)
#define Platform_ftruncate(fd, l) ftruncate(fd, l)
#define Platform_getcwd(cwd, cwd__len) getcwd((char*)cwd, cwd__len)
-#define Platform_getenv(var, var__len) (Platform_EnvPtr)getenv((char*)var)
+#define Platform_getenv(var, var__len) getenv((char*)var)
#define Platform_getpid() (INTEGER)getpid()
#define Platform_gettimeval() struct timeval tv; gettimeofday(&tv,0)
#define Platform_isatty(fd) isatty(fd)
@@ -203,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);
@@ -213,21 +203,14 @@ void Platform_OSFree (INT64 address)
Platform_free(address);
}
-void Platform_Init (INT32 argc, INT64 argvadr)
-{
- Platform_ArgVecPtr av = NIL;
- Platform_MainStackFrame = argvadr;
- Platform_ArgCount = __VAL(INT16, argc);
- av = (Platform_ArgVecPtr)(ADDRESS)argvadr;
- Platform_ArgVector = (*av)[0];
- Platform_HeapInitHeap();
-}
+typedef
+ CHAR (*EnvPtr__83)[1024];
-BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
+BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{
- Platform_EnvPtr p = NIL;
+ EnvPtr__83 p = NIL;
__DUP(var, var__len, CHAR);
- p = Platform_getenv(var, var__len);
+ p = (EnvPtr__83)(ADDRESS)Platform_getenv(var, var__len);
if (p != NIL) {
__COPY(*p, val, val__len);
}
@@ -235,7 +218,7 @@ BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__le
return p != NIL;
}
-void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
+void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{
__DUP(var, var__len, CHAR);
if (!Platform_getEnv(var, var__len, (void*)val, val__len)) {
@@ -244,56 +227,6 @@ void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
__DEL(var);
}
-void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len)
-{
- Platform_ArgVec av = NIL;
- if (n < Platform_ArgCount) {
- av = (Platform_ArgVec)(ADDRESS)Platform_ArgVector;
- __COPY(*(*av)[__X(n, 1024)], val, val__len);
- }
-}
-
-void Platform_GetIntArg (INT16 n, INT32 *val)
-{
- CHAR s[64];
- INT32 k, d, i;
- s[0] = 0x00;
- Platform_GetArg(n, (void*)s, 64);
- i = 0;
- if (s[0] == '-') {
- i = 1;
- }
- k = 0;
- d = (INT16)s[__X(i, 64)] - 48;
- while ((d >= 0 && d <= 9)) {
- k = k * 10 + d;
- i += 1;
- d = (INT16)s[__X(i, 64)] - 48;
- }
- if (s[0] == '-') {
- k = -k;
- i -= 1;
- }
- if (i > 0) {
- *val = k;
- }
-}
-
-INT16 Platform_ArgPos (CHAR *s, LONGINT s__len)
-{
- INT16 i;
- CHAR arg[256];
- __DUP(s, s__len, CHAR);
- i = 0;
- Platform_GetArg(i, (void*)arg, 256);
- while ((i < Platform_ArgCount && __STRCMP(s, arg) != 0)) {
- i += 1;
- Platform_GetArg(i, (void*)arg, 256);
- }
- __DEL(s);
- return i;
-}
-
void Platform_SetInterruptHandler (Platform_SignalHandler handler)
{
Platform_sethandler(2, handler);
@@ -345,7 +278,7 @@ void Platform_Delay (INT32 ms)
Platform_nanosleep(s, ns);
}
-INT16 Platform_System (CHAR *cmd, LONGINT cmd__len)
+INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len)
{
__DUP(cmd, cmd__len, CHAR);
__DEL(cmd);
@@ -357,7 +290,7 @@ INT16 Platform_Error (void)
return Platform_err();
}
-INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h)
+INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h)
{
INT16 fd;
fd = Platform_openro(n, n__len);
@@ -370,7 +303,7 @@ INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h)
__RETCHK;
}
-INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h)
+INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h)
{
INT16 fd;
fd = Platform_openrw(n, n__len);
@@ -383,7 +316,7 @@ INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h)
__RETCHK;
}
-INT16 Platform_New (CHAR *n, LONGINT n__len, INT32 *h)
+INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h)
{
INT16 fd;
fd = Platform_opennew(n, n__len);
@@ -423,7 +356,7 @@ INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *iden
return 0;
}
-INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
+INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{
__DUP(n, n__len, CHAR);
Platform_structstats();
@@ -481,7 +414,7 @@ INT16 Platform_Read (INT32 h, INT64 p, INT32 l, INT32 *n)
__RETCHK;
}
-INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n)
+INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n)
{
*n = Platform_readfile(h, (ADDRESS)b, b__len);
if (*n < 0) {
@@ -535,7 +468,7 @@ INT16 Platform_Truncate (INT32 h, INT32 l)
__RETCHK;
}
-INT16 Platform_Unlink (CHAR *n, LONGINT n__len)
+INT16 Platform_Unlink (CHAR *n, ADDRESS n__len)
{
if (Platform_unlink(n, n__len) < 0) {
return Platform_err();
@@ -545,7 +478,7 @@ INT16 Platform_Unlink (CHAR *n, LONGINT n__len)
__RETCHK;
}
-INT16 Platform_Chdir (CHAR *n, LONGINT n__len)
+INT16 Platform_Chdir (CHAR *n, ADDRESS n__len)
{
INT16 r;
if ((Platform_chdir(n, n__len) >= 0 && Platform_getcwd((void*)Platform_CWD, 256) != NIL)) {
@@ -556,7 +489,7 @@ INT16 Platform_Chdir (CHAR *n, LONGINT n__len)
__RETCHK;
}
-INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len)
+INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len)
{
if (Platform_rename(o, o__len, n, n__len) < 0) {
return Platform_err();
@@ -587,7 +520,6 @@ export void *Platform__init(void)
__INITYP(Platform_FileIdentity, Platform_FileIdentity, 0);
/* BEGIN */
Platform_TestLittleEndian();
- Platform_HaltHandler = NIL;
Platform_TimeStart = 0;
Platform_TimeStart = Platform_Time();
Platform_PID = Platform_getpid();
diff --git a/bootstrap/unix-88/Platform.h b/bootstrap/unix-88/Platform.h
index 80307386..e827b641 100644
--- a/bootstrap/unix-88/Platform.h
+++ b/bootstrap/unix-88/Platform.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -16,46 +16,41 @@ typedef
import BOOLEAN Platform_LittleEndian;
-import INT64 Platform_MainStackFrame;
import INT16 Platform_PID;
import CHAR Platform_CWD[256];
-import INT16 Platform_ArgCount;
-import INT64 Platform_ArgVector;
import INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
import CHAR Platform_NL[3];
import ADDRESS *Platform_FileIdentity__typ;
import BOOLEAN Platform_Absent (INT16 e);
-import INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
-import INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
+import INT16 Platform_Chdir (CHAR *n, ADDRESS n__len);
import INT16 Platform_Close (INT32 h);
import BOOLEAN Platform_ConnectionFailed (INT16 e);
import void Platform_Delay (INT32 ms);
import BOOLEAN Platform_DifferentFilesystems (INT16 e);
import INT16 Platform_Error (void);
import void Platform_Exit (INT32 code);
-import void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
import void Platform_GetClock (INT32 *t, INT32 *d);
-import void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
-import void Platform_GetIntArg (INT16 n, INT32 *val);
+import void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
import void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec);
import INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *identity__typ);
-import INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
+import INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
import BOOLEAN Platform_Inaccessible (INT16 e);
-import void Platform_Init (INT32 argc, INT64 argvadr);
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_New (CHAR *n, LONGINT n__len, INT32 *h);
+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);
import void Platform_OSFree (INT64 address);
-import INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h);
-import INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h);
+import INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h);
+import INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h);
import INT16 Platform_Read (INT32 h, INT64 p, INT32 l, INT32 *n);
-import INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n);
-import INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
+import INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n);
+import INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len);
import BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2);
import BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2);
import INT16 Platform_Seek (INT32 h, INT32 offset, INT16 whence);
@@ -65,14 +60,14 @@ import void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__t
import void Platform_SetQuitHandler (Platform_SignalHandler handler);
import INT16 Platform_Size (INT32 h, INT32 *l);
import INT16 Platform_Sync (INT32 h);
-import INT16 Platform_System (CHAR *cmd, LONGINT cmd__len);
+import INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len);
import INT32 Platform_Time (void);
import BOOLEAN Platform_TimedOut (INT16 e);
import BOOLEAN Platform_TooManyFiles (INT16 e);
import INT16 Platform_Truncate (INT32 h, INT32 l);
-import INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
+import INT16 Platform_Unlink (CHAR *n, ADDRESS n__len);
import INT16 Platform_Write (INT32 h, INT64 p, INT32 l);
-import BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
+import BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
import void *Platform__init(void);
diff --git a/bootstrap/unix-88/Reals.c b/bootstrap/unix-88/Reals.c
index cd4c3c61..512ec2c4 100644
--- a/bootstrap/unix-88/Reals.c
+++ b/bootstrap/unix-88/Reals.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -10,11 +10,11 @@
-static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len);
-export void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len);
-export void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len);
-export void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len);
-export void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len);
+static void Reals_BytesToHex (SYSTEM_BYTE *b, ADDRESS b__len, SYSTEM_BYTE *d, ADDRESS d__len);
+export void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len);
+export void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len);
+export void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len);
+export void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len);
export INT16 Reals_Expo (REAL x);
export INT16 Reals_ExpoL (LONGREAL x);
export void Reals_SetExpo (REAL *x, INT16 ex);
@@ -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)
@@ -79,7 +79,7 @@ INT16 Reals_ExpoL (LONGREAL x)
return __MASK(__ASHR(i, 4), -2048);
}
-void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len)
+void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len)
{
INT32 i, j, k;
if (x < (LONGREAL)0) {
@@ -87,27 +87,27 @@ void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT 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;
}
}
-void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len)
+void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len)
{
Reals_ConvertL(x, n, (void*)d, d__len);
}
@@ -115,14 +115,14 @@ void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT 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;
}
-static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len)
+static void Reals_BytesToHex (SYSTEM_BYTE *b, ADDRESS b__len, SYSTEM_BYTE *d, ADDRESS d__len)
{
INT16 i;
INT32 l;
@@ -137,12 +137,12 @@ static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LO
}
}
-void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len)
+void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len)
{
Reals_BytesToHex((void*)&y, 4, (void*)d, d__len * 1);
}
-void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len)
+void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len)
{
Reals_BytesToHex((void*)&x, 8, (void*)d, d__len * 1);
}
diff --git a/bootstrap/unix-88/Reals.h b/bootstrap/unix-88/Reals.h
index f0c84ab1..93e7fa75 100644
--- a/bootstrap/unix-88/Reals.h
+++ b/bootstrap/unix-88/Reals.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -8,10 +8,10 @@
-import void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len);
-import void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len);
-import void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len);
-import void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len);
+import void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len);
+import void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len);
+import void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len);
+import void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len);
import INT16 Reals_Expo (REAL x);
import INT16 Reals_ExpoL (LONGREAL x);
import void Reals_SetExpo (REAL *x, INT16 ex);
diff --git a/bootstrap/unix-88/Strings.c b/bootstrap/unix-88/Strings.c
index b5707327..4b18812f 100644
--- a/bootstrap/unix-88/Strings.c
+++ b/bootstrap/unix-88/Strings.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,22 +6,25 @@
#define SET UINT32
#include "SYSTEM.h"
+#include "Reals.h"
-export void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
-export void Strings_Cap (CHAR *s, LONGINT s__len);
-export void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n);
-export void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len);
-export void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
-export INT16 Strings_Length (CHAR *s, LONGINT s__len);
-export BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len);
-export INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos);
-export void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
+export void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len);
+export void Strings_Cap (CHAR *s, ADDRESS s__len);
+export void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n);
+export void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len);
+export void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len);
+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, LONGINT s__len)
+INT16 Strings_Length (CHAR *s, ADDRESS s__len)
{
INT32 i;
__DUP(s, s__len, CHAR);
@@ -31,7 +34,7 @@ INT16 Strings_Length (CHAR *s, LONGINT s__len)
}
if (i <= 32767) {
__DEL(s);
- return (INT16)i;
+ return __SHORT(i, 32768);
} else {
__DEL(s);
return 32767;
@@ -39,7 +42,7 @@ INT16 Strings_Length (CHAR *s, LONGINT s__len)
__RETCHK;
}
-void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len)
+void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len)
{
INT16 n1, n2, i;
__DUP(extra, extra__len, CHAR);
@@ -56,7 +59,7 @@ void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__
__DEL(extra);
}
-void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
+void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
{
INT16 n1, n2, i;
__DUP(source, source__len, CHAR);
@@ -87,7 +90,7 @@ void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, L
__DEL(source);
}
-void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n)
+void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n)
{
INT16 len, i;
len = Strings_Length(s, s__len);
@@ -110,7 +113,7 @@ void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n)
}
}
-void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
+void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
{
__DUP(source, source__len, CHAR);
Strings_Delete((void*)dest, dest__len, pos, pos + Strings_Length(source, source__len));
@@ -118,12 +121,12 @@ void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest,
__DEL(source);
}
-void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len)
+void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len)
{
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;
}
@@ -143,7 +146,7 @@ void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHA
__DEL(source);
}
-INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos)
+INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos)
{
INT16 n1, n2, i, j;
__DUP(pattern, pattern__len, CHAR);
@@ -175,7 +178,7 @@ INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len,
return -1;
}
-void Strings_Cap (CHAR *s, LONGINT s__len)
+void Strings_Cap (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@@ -191,9 +194,9 @@ static struct Match__7 {
struct Match__7 *lnk;
} *Match__7_s;
-static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m);
+static BOOLEAN M__8 (CHAR *name, ADDRESS name__len, CHAR *mask, ADDRESS mask__len, INT16 n, INT16 m);
-static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m)
+static BOOLEAN M__8 (CHAR *name, ADDRESS name__len, CHAR *mask, ADDRESS mask__len, INT16 n, INT16 m)
{
while ((((n >= 0 && m >= 0)) && mask[__X(m, mask__len)] != '*')) {
if (name[__X(n, name__len)] != mask[__X(m, mask__len)]) {
@@ -220,7 +223,7 @@ static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__le
return 0;
}
-BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len)
+BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len)
{
struct Match__7 _s;
BOOLEAN __retval;
@@ -236,10 +239,135 @@ BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT
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 c987af8d..f0e3ae34 100644
--- a/bootstrap/unix-88/Strings.h
+++ b/bootstrap/unix-88/Strings.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -8,15 +8,17 @@
-import void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
-import void Strings_Cap (CHAR *s, LONGINT s__len);
-import void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n);
-import void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len);
-import void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
-import INT16 Strings_Length (CHAR *s, LONGINT s__len);
-import BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len);
-import INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos);
-import void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
+import void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len);
+import void Strings_Cap (CHAR *s, ADDRESS s__len);
+import void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n);
+import void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len);
+import void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len);
+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 ae12961b..77dc1bac 100644
--- a/bootstrap/unix-88/Texts.c
+++ b/bootstrap/unix-88/Texts.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -187,20 +187,20 @@ export void Texts_Append (Texts_Text T, Texts_Buffer B);
export void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
static Texts_Elem Texts_CloneElem (Texts_Elem e);
static Texts_Piece Texts_ClonePiece (Texts_Piece p);
-export void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
+export void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len);
export void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
export void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
export void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
export Texts_Text Texts_ElemBase (Texts_Elem E);
export INT32 Texts_ElemPos (Texts_Elem E);
static void Texts_Find (Texts_Text T, INT32 *pos, Texts_Run *u, INT32 *org, INT32 *off);
-static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len);
+static Texts_FontsFont Texts_FontsThis (CHAR *name, ADDRESS name__len);
static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__typ);
export void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
export void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
static void Texts_Load0 (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v);
-export void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
+export void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len);
export void Texts_OpenBuf (Texts_Buffer B);
export void Texts_OpenReader (Texts_Reader *R, ADDRESS *R__typ, Texts_Text T, INT32 pos);
export void Texts_OpenScanner (Texts_Scanner *S, ADDRESS *S__typ, Texts_Text T, INT32 pos);
@@ -229,10 +229,10 @@ export void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x
export void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
export void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
export void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
-export void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
+export void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len);
-static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len)
+static Texts_FontsFont Texts_FontsThis (CHAR *name, ADDRESS name__len)
{
Texts_FontsFont F = NIL;
__NEW(F, Texts_FontDesc);
@@ -390,27 +390,27 @@ static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__t
if (__IS(msg__typ, Texts_CopyMsg, 1)) {
Texts_CopyMsg *msg__ = (void*)msg;
__NEW(e, Texts__1);
- Texts_CopyElem((void*)((Texts_Alien)E), (void*)e);
- e->file = ((Texts_Alien)E)->file;
- e->org = ((Texts_Alien)E)->org;
- e->span = ((Texts_Alien)E)->span;
- __COPY(((Texts_Alien)E)->mod, e->mod, 32);
- __COPY(((Texts_Alien)E)->proc, e->proc, 32);
+ Texts_CopyElem((void*)(*(Texts_Alien*)&E), (void*)e);
+ e->file = (*(Texts_Alien*)&E)->file;
+ e->org = (*(Texts_Alien*)&E)->org;
+ e->span = (*(Texts_Alien*)&E)->span;
+ __MOVE((*(Texts_Alien*)&E)->mod, e->mod, 32);
+ __MOVE((*(Texts_Alien*)&E)->proc, e->proc, 32);
(*msg__).e = (Texts_Elem)e;
} else __WITHCHK;
} else if (__IS(msg__typ, Texts_IdentifyMsg, 1)) {
if (__IS(msg__typ, Texts_IdentifyMsg, 1)) {
Texts_IdentifyMsg *msg__ = (void*)msg;
- __COPY(((Texts_Alien)E)->mod, (*msg__).mod, 32);
- __COPY(((Texts_Alien)E)->proc, (*msg__).proc, 32);
+ __COPY((*(Texts_Alien*)&E)->mod, (*msg__).mod, 32);
+ __COPY((*(Texts_Alien*)&E)->proc, (*msg__).proc, 32);
(*msg__).mod[31] = 0x01;
} else __WITHCHK;
} else if (__IS(msg__typ, Texts_FileMsg, 1)) {
if (__IS(msg__typ, Texts_FileMsg, 1)) {
Texts_FileMsg *msg__ = (void*)msg;
if ((*msg__).id == 1) {
- Files_Set(&r, Files_Rider__typ, ((Texts_Alien)E)->file, ((Texts_Alien)E)->org);
- i = ((Texts_Alien)E)->span;
+ Files_Set(&r, Files_Rider__typ, (*(Texts_Alien*)&E)->file, (*(Texts_Alien*)&E)->org);
+ i = (*(Texts_Alien*)&E)->span;
while (i > 0) {
Files_Read(&r, Files_Rider__typ, (void*)&ch);
Files_Write(&(*msg__).r, Files_Rider__typ, ch);
@@ -646,7 +646,7 @@ void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch)
u = u->next;
if (__ISP(u, Texts_PieceDesc, 1)) {
if (__ISP(u, Texts_PieceDesc, 1)) {
- Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
+ Files_Set(&(*R).rider, Files_Rider__typ, (*(Texts_Piece*)&u)->file, (*(Texts_Piece*)&u)->org);
} else __WITHCHK;
}
(*R).run = u;
@@ -673,7 +673,7 @@ void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ)
(*R).elem = __GUARDP(u, Texts_ElemDesc, 1);
if (__ISP(un, Texts_PieceDesc, 1)) {
if (__ISP(un, Texts_PieceDesc, 1)) {
- Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)un)->file, ((Texts_Piece)un)->org);
+ Files_Set(&(*R).rider, Files_Rider__typ, (*(Texts_Piece*)&un)->file, (*(Texts_Piece*)&un)->org);
} else __WITHCHK;
}
} else {
@@ -812,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;
}
@@ -1027,7 +1027,7 @@ void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ)
Texts_Write(&*W, W__typ, 0x0d);
}
-void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len)
+void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
@@ -1046,7 +1046,7 @@ void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n)
CHAR a[24];
i = 0;
if (x < 0) {
- if (x == (-9223372036854775807-1)) {
+ if (x == (-9223372036854775807LL-1)) {
Texts_WriteString(&*W, W__typ, (CHAR*)" -9223372036854775808", 22);
return;
} else {
@@ -1057,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));
@@ -1084,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;
@@ -1162,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));
}
}
@@ -1313,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 {
@@ -1344,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));
}
}
@@ -1374,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)
@@ -1406,8 +1406,8 @@ static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span
static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span, Texts_Elem *e)
{
- Modules_Module M = NIL;
- Modules_Command Cmd;
+ Heap_Module M = NIL;
+ Heap_Command Cmd;
Texts_Alien a = NIL;
INT32 org, ew, eh;
INT8 eno;
@@ -1539,7 +1539,7 @@ void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
Texts_Load0(&*r, r__typ, T);
}
-void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len)
+void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
Files_Rider r;
@@ -1715,9 +1715,9 @@ void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
while (u != T->head) {
if (__ISP(u, Texts_PieceDesc, 1)) {
if (__ISP(u, Texts_PieceDesc, 1)) {
- if (((Texts_Piece)u)->ascii) {
- Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
- delta = ((Texts_Piece)u)->len;
+ if ((*(Texts_Piece*)&u)->ascii) {
+ Files_Set(&r1, Files_Rider__typ, (*(Texts_Piece*)&u)->file, (*(Texts_Piece*)&u)->org);
+ delta = (*(Texts_Piece*)&u)->len;
while (delta > 0) {
Files_Read(&r1, Files_Rider__typ, (void*)&ch);
delta -= 1;
@@ -1728,8 +1728,8 @@ void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
}
}
} else {
- Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
- delta = ((Texts_Piece)u)->len;
+ Files_Set(&r1, Files_Rider__typ, (*(Texts_Piece*)&u)->file, (*(Texts_Piece*)&u)->org);
+ delta = (*(Texts_Piece*)&u)->len;
while (delta > 1024) {
Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, 1024, 1024);
Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, 1024, 1024);
@@ -1755,7 +1755,7 @@ void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
Store__39_s = _s.lnk;
}
-void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len)
+void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
Files_Rider r;
diff --git a/bootstrap/unix-88/Texts.h b/bootstrap/unix-88/Texts.h
index 61a97dda..081eec2c 100644
--- a/bootstrap/unix-88/Texts.h
+++ b/bootstrap/unix-88/Texts.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -131,7 +131,7 @@ import ADDRESS *Texts_Writer__typ;
import void Texts_Append (Texts_Text T, Texts_Buffer B);
import void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
-import void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
+import void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len);
import void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
import void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
import void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
@@ -139,7 +139,7 @@ import Texts_Text Texts_ElemBase (Texts_Elem E);
import INT32 Texts_ElemPos (Texts_Elem E);
import void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
import void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
-import void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
+import void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len);
import void Texts_OpenBuf (Texts_Buffer B);
import void Texts_OpenReader (Texts_Reader *R, ADDRESS *R__typ, Texts_Text T, INT32 pos);
import void Texts_OpenScanner (Texts_Scanner *S, ADDRESS *S__typ, Texts_Text T, INT32 pos);
@@ -166,7 +166,7 @@ import void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x
import void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
import void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
import void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
-import void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
+import void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len);
import void *Texts__init(void);
diff --git a/bootstrap/unix-88/VT100.c b/bootstrap/unix-88/VT100.c
index f69fd90e..346fb37b 100644
--- a/bootstrap/unix-88/VT100.c
+++ b/bootstrap/unix-88/VT100.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -27,23 +27,24 @@ export void VT100_DECTCEMl (void);
export void VT100_DSR (INT16 n);
export void VT100_ED (INT16 n);
export void VT100_EL (INT16 n);
-static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len);
-static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len);
-static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len);
-static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len);
+static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len);
+static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len);
+static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len);
+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, LONGINT str__len);
+export void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len);
export void VT100_RCP (void);
-static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end);
+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);
export void VT100_SGR (INT16 n);
export void VT100_SGR2 (INT16 n, INT16 m);
export void VT100_SU (INT16 n);
-export void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
+export void VT100_SetAttr (CHAR *attr, ADDRESS attr__len);
-static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end)
+static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end)
{
CHAR h;
while (start < end) {
@@ -55,7 +56,7 @@ static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end)
}
}
-void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
+void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len)
{
CHAR b[21];
INT16 s, e;
@@ -74,7 +75,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT 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));
@@ -84,7 +85,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
__COPY(b, str, str__len);
}
-static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len)
+static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len)
{
CHAR cmd[9];
__DUP(letter, letter__len, CHAR);
@@ -94,7 +95,7 @@ static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len)
__DEL(letter);
}
-static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len)
+static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len)
{
CHAR nstr[2];
CHAR cmd[7];
@@ -107,7 +108,7 @@ static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len)
__DEL(letter);
}
-static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len)
+static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len)
{
CHAR nstr[2];
CHAR cmd[7];
@@ -120,7 +121,7 @@ static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len)
__DEL(letter);
}
-static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len)
+static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len)
{
CHAR nstr[5], mstr[5];
CHAR cmd[12];
@@ -136,6 +137,15 @@ static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT 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);
@@ -236,7 +246,7 @@ void VT100_DECTCEMh (void)
VT100_EscSeq0((CHAR*)"\?25h", 5);
}
-void VT100_SetAttr (CHAR *attr, LONGINT attr__len)
+void VT100_SetAttr (CHAR *attr, ADDRESS attr__len)
{
CHAR tmpstr[16];
__DUP(attr, attr__len, CHAR);
@@ -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 d99406ec..4e708647 100644
--- a/bootstrap/unix-88/VT100.h
+++ b/bootstrap/unix-88/VT100.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -23,14 +23,15 @@ import void VT100_DSR (INT16 n);
import void VT100_ED (INT16 n);
import void VT100_EL (INT16 n);
import void VT100_HVP (INT16 n, INT16 m);
-import void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len);
+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);
import void VT100_SGR2 (INT16 n, INT16 m);
import void VT100_SU (INT16 n);
-import void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
+import void VT100_SetAttr (CHAR *attr, ADDRESS attr__len);
import void *VT100__init(void);
diff --git a/bootstrap/unix-88/extTools.c b/bootstrap/unix-88/extTools.c
index 37630d23..ce2fc413 100644
--- a/bootstrap/unix-88/extTools.c
+++ b/bootstrap/unix-88/extTools.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,33 +7,40 @@
#include "SYSTEM.h"
#include "Configuration.h"
+#include "Heap.h"
#include "Modules.h"
#include "OPM.h"
#include "Out.h"
#include "Platform.h"
#include "Strings.h"
-
-static CHAR extTools_CFLAGS[1023];
+typedef
+ CHAR extTools_CommandString[4096];
-export void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len);
-static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT s__len);
-export void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len);
-static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len);
+static extTools_CommandString extTools_CFLAGS;
-static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len)
+export void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__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);
+
+
+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, LONGINT title__len, CHAR *cmd, LONGIN
__DEL(cmd);
}
-static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT 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, LONGINT moduleName__len)
+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*)"Assemble: ", 11, 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, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len)
+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", 8, (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((CHAR*)"", 1, (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*)"Assemble and link: ", 20, 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 63e5df15..686f0b4e 100644
--- a/bootstrap/unix-88/extTools.h
+++ b/bootstrap/unix-88/extTools.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -8,8 +8,8 @@
-import void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len);
-import void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len);
+import void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len);
+import void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len);
import void *extTools__init(void);
diff --git a/bootstrap/windows-48/Compiler.c b/bootstrap/windows-48/Compiler.c
index dc4bb660..4460479d 100644
--- a/bootstrap/windows-48/Compiler.c
+++ b/bootstrap/windows-48/Compiler.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -20,9 +20,9 @@
#include "extTools.h"
-static CHAR Compiler_mname[256];
+static void Compiler_FindLocalObjectFiles (CHAR *objectnames, ADDRESS objectnames__len);
export void Compiler_Module (BOOLEAN *done);
static void Compiler_PropagateElementaryTypeSizes (void);
export void Compiler_Translate (void);
@@ -41,11 +41,12 @@ void Compiler_Module (BOOLEAN *done)
OPT_Export(&ext, &new);
if (OPM_noerr) {
OPM_OpenFiles((void*)OPT_SelfName, 256);
+ OPM_DeleteObj((void*)OPT_SelfName, 256);
OPC_Init();
OPV_Module(p);
if (OPM_noerr) {
if ((__IN(10, OPM_Options, 32) && __STRCMP(OPM_modName, "SYSTEM") != 0)) {
- OPM_DeleteNewSym();
+ OPM_DeleteSym((void*)OPT_SelfName, 256);
OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogWStr((CHAR*)" Main program.", 16);
OPM_LogVT100((CHAR*)"0m", 3);
@@ -61,7 +62,7 @@ void Compiler_Module (BOOLEAN *done)
}
}
} else {
- OPM_DeleteNewSym();
+ OPM_DeleteSym((void*)OPT_SelfName, 256);
}
}
}
@@ -88,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;
@@ -104,14 +105,44 @@ static void Compiler_PropagateElementaryTypeSizes (void)
}
}
+static void Compiler_FindLocalObjectFiles (CHAR *objectnames, ADDRESS objectnames__len)
+{
+ OPT_Link l = NIL;
+ CHAR fn[64];
+ Platform_FileIdentity id;
+ objectnames[0] = 0x00;
+ l = OPT_Links;
+ while (l != NIL) {
+ __COPY(l->name, fn, 64);
+ Strings_Append((CHAR*)".sym", 5, (void*)fn, 64);
+ if (Platform_IdentifyByName(fn, 64, &id, Platform_FileIdentity__typ) == 0) {
+ __COPY(l->name, fn, 64);
+ Strings_Append((CHAR*)".o", 3, (void*)fn, 64);
+ if (Platform_IdentifyByName(fn, 64, &id, Platform_FileIdentity__typ) == 0) {
+ Strings_Append((CHAR*)" ", 2, (void*)objectnames, objectnames__len);
+ Strings_Append(fn, 64, (void*)objectnames, objectnames__len);
+ } else {
+ OPM_LogVT100((CHAR*)"91m", 4);
+ OPM_LogWStr((CHAR*)"Link warning: a local symbol file is present for module ", 57);
+ OPM_LogWStr(l->name, 256);
+ OPM_LogWStr((CHAR*)", but local object file '", 26);
+ OPM_LogWStr(fn, 64);
+ OPM_LogWStr((CHAR*)"' is missing.", 14);
+ OPM_LogVT100((CHAR*)"0m", 3);
+ OPM_LogWLn();
+ }
+ }
+ l = l->next;
+ }
+}
+
void Compiler_Translate (void)
{
BOOLEAN done;
- CHAR modulesobj[2048];
- modulesobj[0] = 0x00;
+ CHAR linkfiles[2048];
if (OPM_OpenPar()) {
for (;;) {
- OPM_Init(&done, (void*)Compiler_mname, 256);
+ OPM_Init(&done);
if (!done) {
return;
}
@@ -131,11 +162,9 @@ void Compiler_Translate (void)
} else {
if (!__IN(10, OPM_Options, 32)) {
extTools_Assemble(OPM_modName, 32);
- Strings_Append((CHAR*)" ", 2, (void*)modulesobj, 2048);
- Strings_Append(OPM_modName, 32, (void*)modulesobj, 2048);
- Strings_Append((CHAR*)".o", 3, (void*)modulesobj, 2048);
} else {
- extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), modulesobj, 2048);
+ Compiler_FindLocalObjectFiles((void*)linkfiles, 2048);
+ extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), linkfiles, 2048);
}
}
}
diff --git a/bootstrap/windows-48/Configuration.c b/bootstrap/windows-48/Configuration.c
index 2d0061df..fa87c9de 100644
--- a/bootstrap/windows-48/Configuration.c
+++ b/bootstrap/windows-48/Configuration.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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("1.95 [2016/11/24]. 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 b28e0caa..c3c54eed 100644
--- a/bootstrap/windows-48/Configuration.h
+++ b/bootstrap/windows-48/Configuration.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 5326fe10..553bb49a 100644
--- a/bootstrap/windows-48/Files.c
+++ b/bootstrap/windows-48/Files.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 {
@@ -36,7 +36,7 @@ typedef
INT32 fd, len, pos;
Files_Buffer bufs[4];
INT16 swapper, state;
- Files_File next;
+ struct Files_FileDesc *next;
} Files_FileDesc;
typedef
@@ -48,11 +48,12 @@ typedef
} Files_Rider;
-static Files_File Files_files;
+export INT16 Files_MaxPathLength, Files_MaxNameLength;
+static Files_FileDesc *Files_files;
static INT16 Files_tempno;
static CHAR Files_HOME[1024];
static struct {
- LONGINT len[1];
+ ADDRESS len[1];
CHAR data[1];
} *Files_SearchPath;
@@ -60,58 +61,68 @@ export ADDRESS *Files_FileDesc__typ;
export ADDRESS *Files_BufDesc__typ;
export ADDRESS *Files_Rider__typ;
+static void Files_Assert (BOOLEAN truth);
export Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
static Files_File Files_CacheEntry (Platform_FileIdentity identity);
-export void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
+export void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res);
export void Files_Close (Files_File f);
static void Files_CloseOSFile (Files_File f);
static void Files_Create (Files_File f);
-export void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res);
-static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode);
+export void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res);
+static void Files_Deregister (CHAR *name, ADDRESS name__len);
+static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode);
static void Files_Finalize (SYSTEM_PTR o);
-static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len);
+static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len);
static void Files_Flush (Files_Buffer buf);
export void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
-export void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
-static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len);
-static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len);
+export void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len);
+static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len);
+static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len);
export INT32 Files_Length (Files_File f);
-static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len);
-export Files_File Files_New (CHAR *name, LONGINT name__len);
-export Files_File Files_Old (CHAR *name, LONGINT name__len);
+static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len);
+export Files_File Files_New (CHAR *name, ADDRESS name__len);
+export Files_File Files_Old (CHAR *name, ADDRESS name__len);
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_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+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);
export void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
-export void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
-export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
+export void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
+export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
export void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
export void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
-export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
export void Files_Register (Files_File f);
-export void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res);
-static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len);
+export void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res);
+static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len);
export void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos);
-export void Files_SetSearchPath (CHAR *path, LONGINT path__len);
+export void Files_SetSearchPath (CHAR *path, ADDRESS path__len);
export void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
export void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
-export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
export void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
export void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
export void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
export void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
export void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
export void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
-export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
#define Files_IdxTrap() __HALT(-1)
-#define Files_ToAdr(x) (ADDRESS)x
-static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
+static void Files_Assert (BOOLEAN truth)
+{
+ if (!truth) {
+ Out_Ln();
+ __ASSERT(truth, 0);
+ }
+}
+
+static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
{
__DUP(s, s__len, CHAR);
Out_Ln();
@@ -120,17 +131,17 @@ static void Files_Err (CHAR *s, LONGINT 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();
@@ -138,98 +149,125 @@ static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
__DEL(s);
}
-static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len)
+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, LONGINT finalName__len, CHAR *name, LONGINT name__len)
+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);
}
+static void Files_Deregister (CHAR *name, ADDRESS name__len)
+{
+ Platform_FileIdentity identity;
+ Files_File osfile = NIL;
+ INT16 error;
+ __DUP(name, name__len, CHAR);
+ if (Platform_IdentifyByName(name, name__len, &identity, Platform_FileIdentity__typ) == 0) {
+ osfile = (Files_File)Files_files;
+ while ((osfile != NIL && !Platform_SameFile(osfile->identity, identity))) {
+ osfile = (Files_File)osfile->next;
+ }
+ if (osfile != NIL) {
+ __ASSERT(!osfile->tempFile, 0);
+ __ASSERT(osfile->fd >= 0, 0);
+ __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, 256, (void*)osfile->workName, 256);
+ if (error != 0) {
+ Files_Err((CHAR*)"Couldn't rename previous version of file being registered", 58, osfile, error);
+ }
+ }
+ }
+ __DEL(name);
+}
+
static void Files_Create (Files_File f)
{
- Platform_FileIdentity identity;
BOOLEAN done;
INT16 error;
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 if (f->state == 2) {
- __COPY(f->registerName, f->workName, 101);
+ } else {
+ __ASSERT(f->state == 2, 0);
+ 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;
@@ -275,27 +313,6 @@ static void Files_Flush (Files_Buffer buf)
}
}
-static void Files_CloseOSFile (Files_File f)
-{
- Files_File prev = NIL;
- INT16 error;
- if (Files_files == f) {
- Files_files = f->next;
- } else {
- prev = Files_files;
- while ((prev != NIL && prev->next != f)) {
- prev = prev->next;
- }
- if (prev->next != NIL) {
- prev->next = f->next;
- }
- }
- error = Platform_Close(f->fd);
- f->fd = -1;
- f->state = 1;
- Heap_FileCount -= 1;
-}
-
void Files_Close (Files_File f)
{
INT32 i;
@@ -303,11 +320,10 @@ 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;
}
- Files_CloseOSFile(f);
}
}
@@ -316,13 +332,13 @@ INT32 Files_Length (Files_File f)
return f->len;
}
-Files_File Files_New (CHAR *name, LONGINT name__len)
+Files_File Files_New (CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
__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;
@@ -332,7 +348,7 @@ Files_File Files_New (CHAR *name, LONGINT name__len)
return f;
}
-static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len)
+static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len)
{
INT16 i;
CHAR ch;
@@ -344,38 +360,38 @@ static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT 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, LONGINT name__len)
+static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@@ -383,7 +399,7 @@ static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
ch = name[0];
while ((ch != 0x00 && ch != '/')) {
i += 1;
- ch = name[i];
+ ch = name[__X(i, name__len)];
}
return ch == '/';
}
@@ -392,15 +408,15 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
{
Files_File f = NIL;
INT16 i, error;
- f = Files_files;
+ f = (Files_File)Files_files;
while (f != NIL) {
if (Platform_SameFile(identity, f->identity)) {
if (!Platform_SameFileTime(identity, f->identity)) {
i = 0;
while (i < 4) {
- if (f->bufs[i] != NIL) {
- f->bufs[i]->org = -1;
- f->bufs[i] = NIL;
+ if (f->bufs[__X(i, 4)] != NIL) {
+ f->bufs[__X(i, 4)]->org = -1;
+ f->bufs[__X(i, 4)] = NIL;
}
i += 1;
}
@@ -410,12 +426,12 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
}
return f;
}
- f = f->next;
+ f = (Files_File)f->next;
}
return NIL;
}
-Files_File Files_Old (CHAR *name, LONGINT name__len)
+Files_File Files_Old (CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
INT32 fd;
@@ -456,6 +472,7 @@ Files_File Files_Old (CHAR *name, LONGINT name__len)
error = Platform_Identify(fd, &identity, Platform_FileIdentity__typ);
f = Files_CacheEntry(identity);
if (f != NIL) {
+ error = Platform_Close(fd);
__DEL(name);
return f;
} else {
@@ -466,7 +483,7 @@ Files_File Files_Old (CHAR *name, LONGINT 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;
@@ -498,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;
}
@@ -526,7 +543,7 @@ void Files_GetDate (Files_File f, INT32 *t, INT32 *d)
INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ)
{
- __ASSERT((*r).offset <= 4096, 0);
+ Files_Assert((*r).offset <= 4096);
return (*r).org + (*r).offset;
}
@@ -544,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) {
@@ -585,7 +602,7 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
org = 0;
offset = 0;
}
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
(*r).buf = buf;
(*r).org = org;
(*r).offset = offset;
@@ -604,9 +621,9 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
buf = (*r).buf;
offset = (*r).offset;
}
- __ASSERT(offset <= buf->size, 0);
+ 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);
@@ -618,7 +635,12 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
}
}
-void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
+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;
Files_Buffer buf = NIL;
@@ -644,12 +666,12 @@ void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x
} else {
min = n;
}
- __MOVE((ADDRESS)buf->data + Files_ToAdr(offset), (ADDRESS)x + Files_ToAdr(xpos), min);
+ __MOVE((ADDRESS)&buf->data[__X(offset, 4096)], (ADDRESS)&x[__X(xpos, x__len)], min);
offset += min;
(*r).offset = offset;
xpos += min;
n -= min;
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
}
(*r).res = 0;
(*r).eof = 0;
@@ -666,14 +688,14 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
INT32 offset;
buf = (*r).buf;
offset = (*r).offset;
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
- __ASSERT(offset < 4096, 0);
- buf->data[offset] = x;
+ Files_Assert(offset < 4096);
+ buf->data[__X(offset, 4096)] = x;
buf->chg = 1;
if (offset == buf->size) {
buf->size += 1;
@@ -683,7 +705,7 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
(*r).res = 0;
}
-void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
+void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n)
{
INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
@@ -694,23 +716,23 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT
buf = (*r).buf;
offset = (*r).offset;
while (n > 0) {
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
restInBuf = 4096 - offset;
if (n > restInBuf) {
min = restInBuf;
} else {
min = n;
}
- __MOVE((ADDRESS)x + Files_ToAdr(xpos), (ADDRESS)buf->data + Files_ToAdr(offset), min);
+ __MOVE((ADDRESS)&x[__X(xpos, x__len)], (ADDRESS)&buf->data[__X(offset, 4096)], min);
offset += min;
(*r).offset = offset;
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
if (offset > buf->size) {
buf->f->len += offset - buf->size;
buf->size = offset;
@@ -722,14 +744,15 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT
(*r).res = 0;
}
-void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res)
+void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res)
{
__DUP(name, name__len, CHAR);
+ Files_Deregister(name, name__len);
*res = Platform_Unlink((void*)name, name__len);
__DEL(name);
}
-void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res)
+void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res)
{
INT32 fdold, fdnew, n;
INT16 error, ignore;
@@ -795,31 +818,30 @@ void Files_Register (Files_File f)
{
INT16 idx, errcode;
Files_File f1 = NIL;
- CHAR file[104];
if ((f->state == 1 && f->registerName[0] != 0x00)) {
f->state = 2;
}
Files_Close(f);
if (f->registerName[0] != 0x00) {
- Files_Rename(f->workName, 101, f->registerName, 101, &errcode);
+ Files_Deregister(f->registerName, 256);
+ Files_Rename(f->workName, 256, f->registerName, 256, &errcode);
if (errcode != 0) {
- __COPY(f->registerName, file, 104);
- __HALT(99);
+ Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode);
}
- __COPY(f->registerName, f->workName, 101);
+ __MOVE(f->registerName, f->workName, 256);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
}
-void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res)
+void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res)
{
__DUP(path, path__len, CHAR);
*res = Platform_Chdir((void*)path, path__len);
__DEL(path);
}
-static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len)
+static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len)
{
INT32 i, j;
if (!Platform_LittleEndian) {
@@ -827,7 +849,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT 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 {
@@ -877,36 +899,36 @@ void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x)
Files_FlipBytes((void*)b, 8, (void*)&*x, 8);
}
-void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
+void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
{
INT16 i;
CHAR ch;
i = 0;
do {
Files_Read(&*R, R__typ, (void*)&ch);
- x[i] = ch;
+ x[__X(i, x__len)] = ch;
i += 1;
} while (!(ch == 0x00));
}
-void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
+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, LONGINT x__len)
+void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len)
{
INT8 s, b;
INT64 q;
@@ -919,7 +941,7 @@ void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__
Files_Read(&*R, R__typ, (void*)&b);
}
q += (INT64)__ASH((__MASK(b, -64) - __ASHL(__ASHR(b, 6), 6)), s);
- __ASSERT(x__len <= 8, 0);
+ Files_Assert(x__len <= 8);
__MOVE((ADDRESS)&q, (ADDRESS)x, x__len);
}
@@ -931,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);
}
@@ -950,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);
}
@@ -972,11 +996,11 @@ void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x)
Files_WriteBytes(&*R, R__typ, (void*)b, 8, 8);
}
-void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
+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);
@@ -985,17 +1009,38 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT 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, LONGINT name__len)
+void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len)
{
__COPY(f->workName, name, name__len);
}
+static void Files_CloseOSFile (Files_File f)
+{
+ Files_File prev = NIL;
+ INT16 error;
+ if (Files_files == (void *) f) {
+ Files_files = f->next;
+ } else {
+ prev = (Files_File)Files_files;
+ while ((prev != NIL && prev->next != (void *) f)) {
+ prev = (Files_File)prev->next;
+ }
+ if (prev->next != NIL) {
+ prev->next = f->next;
+ }
+ }
+ error = Platform_Close(f->fd);
+ f->fd = -1;
+ f->state = 1;
+ Heap_FileCount -= 1;
+}
+
static void Files_Finalize (SYSTEM_PTR o)
{
Files_File f = NIL;
@@ -1004,12 +1049,12 @@ 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);
}
}
}
-void Files_SetSearchPath (CHAR *path, LONGINT path__len)
+void Files_SetSearchPath (CHAR *path, ADDRESS path__len)
{
__DUP(path, path__len, CHAR);
if (Strings_Length(path, path__len) != 0) {
@@ -1023,11 +1068,10 @@ void Files_SetSearchPath (CHAR *path, LONGINT path__len)
static void EnumPtrs(void (*P)(void*))
{
- P(Files_files);
P(Files_SearchPath);
}
-__TDESC(Files_FileDesc, 1, 5) = {__TDFLDS("FileDesc", 260), {236, 240, 244, 248, 256, -24}};
+__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}};
@@ -1047,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 62df86fc..dadf1ace 100644
--- a/bootstrap/windows-48/Files.h
+++ b/bootstrap/windows-48/Files.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -10,9 +10,8 @@ typedef
typedef
struct Files_FileDesc {
- char _prvt0[224];
- INT32 fd;
- char _prvt1[32];
+ INT32 _prvt0;
+ char _prvt1[568];
} Files_FileDesc;
typedef
@@ -23,46 +22,48 @@ typedef
} Files_Rider;
+import INT16 Files_MaxPathLength, Files_MaxNameLength;
import ADDRESS *Files_FileDesc__typ;
import ADDRESS *Files_Rider__typ;
import Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
-import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
+import void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res);
import void Files_Close (Files_File f);
-import void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res);
+import void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res);
import void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
-import void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
+import void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len);
import INT32 Files_Length (Files_File f);
-import Files_File Files_New (CHAR *name, LONGINT name__len);
-import Files_File Files_Old (CHAR *name, LONGINT name__len);
+import Files_File Files_New (CHAR *name, ADDRESS name__len);
+import Files_File Files_Old (CHAR *name, ADDRESS name__len);
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_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+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);
import void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
-import void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
-import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
+import void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
+import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
import void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
import void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
-import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
import void Files_Register (Files_File f);
-import void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res);
+import void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res);
import void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos);
-import void Files_SetSearchPath (CHAR *path, LONGINT path__len);
+import void Files_SetSearchPath (CHAR *path, ADDRESS path__len);
import void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
import void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
-import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
import void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
import void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
import void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
import void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
import void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
import void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
-import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
import void *Files__init(void);
diff --git a/bootstrap/windows-48/Heap.c b/bootstrap/windows-48/Heap.c
index 72677604..42552415 100644
--- a/bootstrap/windows-48/Heap.c
+++ b/bootstrap/windows-48/Heap.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,8 +68,10 @@ static INT32 Heap_freeList[10];
static INT32 Heap_bigBlocks;
export INT32 Heap_allocated;
static BOOLEAN Heap_firstTry;
-static INT32 Heap_heap, Heap_heapend;
-export INT32 Heap_heapsize;
+static INT16 Heap_ldUnit;
+export INT32 Heap_heap;
+static INT32 Heap_heapMin, Heap_heapMax;
+export INT32 Heap_heapsize, Heap_heapMinExpand;
static Heap_FinNode Heap_fin;
static INT16 Heap_lockdepth;
static BOOLEAN Heap_interrupted;
@@ -84,15 +86,16 @@ static void Heap_CheckFin (void);
static void Heap_ExtendHeap (INT32 blksz);
export void Heap_FINALL (void);
static void Heap_Finalize (void);
+export INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len);
export void Heap_GC (BOOLEAN markStack);
-static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len);
+static void Heap_HeapSort (INT32 n, INT32 *a, ADDRESS a__len);
export void Heap_INCREF (Heap_Module m);
export void Heap_InitHeap (void);
export void Heap_Lock (void);
static void Heap_Mark (INT32 q);
-static void Heap_MarkCandidates (INT32 n, INT32 *cand, LONGINT cand__len);
+static void Heap_MarkCandidates (INT32 n, INT32 *cand, ADDRESS cand__len);
static void Heap_MarkP (SYSTEM_PTR p);
-static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len);
+static void Heap_MarkStack (INT32 n, INT32 *cand, ADDRESS cand__len);
export SYSTEM_PTR Heap_NEWBLK (INT32 size);
export SYSTEM_PTR Heap_NEWREC (INT32 tag);
static INT32 Heap_NewChunk (INT32 blksz);
@@ -101,16 +104,18 @@ export SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs);
export void Heap_REGTYP (Heap_Module m, INT32 typ);
export void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize);
static void Heap_Scan (void);
-static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len);
+static void Heap_Sift (INT32 l, INT32 r, INT32 *a, ADDRESS a__len);
export void Heap_Unlock (void);
extern void *Heap__init();
-extern ADDRESS Platform_MainStackFrame;
+extern ADDRESS Modules_MainStackFrame;
extern ADDRESS Platform_OSAllocate(ADDRESS size);
#define Heap_HeapModuleInit() Heap__init()
#define Heap_ModulesHalt(code) Modules_Halt(code)
+#define Heap_ModulesMainStackFrame() Modules_MainStackFrame
#define Heap_OSAllocate(size) Platform_OSAllocate(size)
-#define Heap_PlatformMainStackFrame() Platform_MainStackFrame
+#define Heap_uLE(x, y) ((size_t)x <= (size_t)y)
+#define Heap_uLT(x, y) ((size_t)x < (size_t)y)
void Heap_Lock (void)
{
@@ -143,6 +148,35 @@ SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
return (void*)m;
}
+INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len)
+{
+ Heap_Module m, p;
+ __DUP(name, name__len, CHAR);
+ m = (Heap_Module)(ADDRESS)Heap_modules;
+ while ((m != NIL && __STRCMP(m->name, name) != 0)) {
+ p = m;
+ m = m->next;
+ }
+ if ((m != NIL && m->refcnt == 0)) {
+ if (m == (Heap_Module)(ADDRESS)Heap_modules) {
+ Heap_modules = (SYSTEM_PTR)m->next;
+ } else {
+ p->next = m->next;
+ }
+ __DEL(name);
+ return 0;
+ } else {
+ if (m == NIL) {
+ __DEL(name);
+ return -1;
+ } else {
+ __DEL(name);
+ return m->refcnt;
+ }
+ }
+ __RETCHK;
+}
+
void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd)
{
Heap_Cmd c;
@@ -170,16 +204,24 @@ void Heap_INCREF (Heap_Module m)
static INT32 Heap_NewChunk (INT32 blksz)
{
- INT32 chnk;
+ INT32 chnk, blk, end;
chnk = Heap_OSAllocate(blksz + 12);
if (chnk != 0) {
- __PUT(chnk + 4, chnk + (12 + blksz), INT32);
- __PUT(chnk + 12, chnk + 16, INT32);
- __PUT(chnk + 16, blksz, INT32);
- __PUT(chnk + 20, -4, INT32);
- __PUT(chnk + 24, Heap_bigBlocks, INT32);
- Heap_bigBlocks = chnk + 12;
+ blk = chnk + 12;
+ end = blk + blksz;
+ __PUT(chnk + 4, end, INT32);
+ __PUT(blk, blk + 4, INT32);
+ __PUT(blk + 4, blksz, INT32);
+ __PUT(blk + 8, -4, INT32);
+ __PUT(blk + 12, Heap_bigBlocks, INT32);
+ Heap_bigBlocks = blk;
Heap_heapsize += blksz;
+ if (Heap_uLT(blk + 4, Heap_heapMin)) {
+ Heap_heapMin = blk + 4;
+ }
+ if (Heap_uLT(Heap_heapMax, end)) {
+ Heap_heapMax = end;
+ }
}
return chnk;
}
@@ -187,29 +229,28 @@ static INT32 Heap_NewChunk (INT32 blksz)
static void Heap_ExtendHeap (INT32 blksz)
{
INT32 size, chnk, j, next;
- if (blksz > 160000) {
+ if (Heap_uLT(Heap_heapMinExpand, blksz)) {
size = blksz;
} else {
- size = 160000;
+ size = Heap_heapMinExpand;
}
chnk = Heap_NewChunk(size);
if (chnk != 0) {
- if (chnk < Heap_heap) {
+ if (Heap_uLT(chnk, Heap_heap)) {
__PUT(chnk, Heap_heap, INT32);
Heap_heap = chnk;
} else {
j = Heap_heap;
__GET(j, next, INT32);
- while ((next != 0 && chnk > next)) {
+ while ((next != 0 && Heap_uLT(next, chnk))) {
j = next;
__GET(j, next, INT32);
}
__PUT(chnk, next, INT32);
__PUT(j, chnk, INT32);
}
- if (next == 0) {
- __GET(chnk + 4, Heap_heapend, INT32);
- }
+ } else if (!Heap_firstTry) {
+ Heap_heapMinExpand = 16;
}
}
@@ -219,7 +260,7 @@ 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 (i < 9) {
adr = Heap_freeList[i];
@@ -251,16 +292,17 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
if (Heap_firstTry) {
Heap_GC(1);
blksz += 16;
- if (__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2) < Heap_heapsize) {
- Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize);
+ 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 {
@@ -269,7 +311,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
}
}
__GET(adr + 4, t, INT32);
- if (t >= blksz) {
+ if (Heap_uLE(blksz, t)) {
break;
}
prev = adr;
@@ -280,7 +322,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
__PUT(end + 4, blksz, INT32);
__PUT(end + 8, -4, INT32);
__PUT(end, end + 4, INT32);
- if (restsize > 144) {
+ if (Heap_uLT(144, restsize)) {
__PUT(adr + 4, restsize, INT32);
} else {
__GET(adr + 12, next, INT32);
@@ -289,7 +331,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
} else {
__PUT(prev + 12, next, INT32);
}
- if (restsize > 0) {
+ if (restsize != 0) {
di = __ASHR(restsize, 4);
__PUT(adr + 4, restsize, INT32);
__PUT(adr + 12, Heap_freeList[di], INT32);
@@ -300,7 +342,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
}
i = adr + 16;
end = adr + blksz;
- while (i < end) {
+ while (Heap_uLT(i, end)) {
__PUT(i, 0, INT32);
__PUT(i + 4, 0, INT32);
__PUT(i + 8, 0, INT32);
@@ -397,17 +439,17 @@ static void Heap_Scan (void)
while (chnk != 0) {
adr = chnk + 12;
__GET(chnk + 4, end, INT32);
- while (adr < end) {
+ while (Heap_uLT(adr, end)) {
__GET(adr, tag, INT32);
if (__ODD(tag)) {
- if (freesize > 0) {
+ if (freesize != 0) {
start = adr - freesize;
__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 (i < 9) {
+ if (Heap_uLT(i, 9)) {
__PUT(start + 12, Heap_freeList[i], INT32);
Heap_freeList[i] = start;
} else {
@@ -426,14 +468,14 @@ static void Heap_Scan (void)
adr += size;
}
}
- if (freesize > 0) {
+ if (freesize != 0) {
start = adr - freesize;
__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 (i < 9) {
+ if (Heap_uLT(i, 9)) {
__PUT(start + 12, Heap_freeList[i], INT32);
Heap_freeList[i] = start;
} else {
@@ -445,18 +487,19 @@ static void Heap_Scan (void)
}
}
-static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len)
+static void Heap_Sift (INT32 l, INT32 r, INT32 *a, ADDRESS a__len)
{
- INT32 i, j, x;
+ INT32 i, j;
+ INT32 x;
j = l;
x = a[j];
for (;;) {
i = j;
j = __ASHL(j, 1) + 1;
- if ((j < r && a[j] < a[j + 1])) {
+ if ((j < r && Heap_uLT(a[j], a[j + 1]))) {
j += 1;
}
- if (j > r || a[j] <= x) {
+ if (j > r || Heap_uLE(a[j], x)) {
break;
}
a[i] = a[j];
@@ -464,9 +507,10 @@ static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len)
a[i] = x;
}
-static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len)
+static void Heap_HeapSort (INT32 n, INT32 *a, ADDRESS a__len)
{
- INT32 l, r, x;
+ INT32 l, r;
+ INT32 x;
l = __ASHR(n, 1);
r = n - 1;
while (l > 0) {
@@ -482,37 +526,42 @@ static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len)
}
}
-static void Heap_MarkCandidates (INT32 n, INT32 *cand, LONGINT cand__len)
+static void Heap_MarkCandidates (INT32 n, INT32 *cand, ADDRESS cand__len)
{
- INT32 chnk, adr, tag, next, lim, lim1, i, ptr, size;
- chnk = Heap_heap;
+ INT32 chnk, end, adr, tag, next, i, ptr, size;
+ chnk = Heap_heap;
i = 0;
- lim = cand[n - 1];
- while ((chnk != 0 && chnk < lim)) {
+ while (chnk != 0) {
+ __GET(chnk + 4, end, INT32);
adr = chnk + 12;
- __GET(chnk + 4, lim1, INT32);
- if (lim < lim1) {
- lim1 = lim;
- }
- while (adr < lim1) {
+ while (Heap_uLT(adr, end)) {
__GET(adr, tag, INT32);
if (__ODD(tag)) {
__GET(tag - 1, size, INT32);
adr += size;
+ ptr = adr + 4;
+ while (Heap_uLT(cand[i], ptr)) {
+ i += 1;
+ if (i == n) {
+ return;
+ }
+ }
} else {
__GET(tag, size, INT32);
ptr = adr + 4;
- while (cand[i] < ptr) {
+ adr += size;
+ while (Heap_uLT(cand[i], ptr)) {
i += 1;
+ if (i == n) {
+ return;
+ }
}
- if (i == n) {
- return;
- }
- next = adr + size;
- if (cand[i] < next) {
+ if (Heap_uLT(cand[i], adr)) {
Heap_Mark(ptr);
}
- adr = next;
+ }
+ if (Heap_uLE(end, cand[i])) {
+ adr = end;
}
}
__GET(chnk, chnk, INT32);
@@ -571,10 +620,11 @@ void Heap_FINALL (void)
}
}
-static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len)
+static void Heap_MarkStack (INT32 n, INT32 *cand, ADDRESS cand__len)
{
SYSTEM_PTR frame;
- INT32 inc, nofcand, sp, p, stack0;
+ INT32 nofcand;
+ INT32 inc, sp, p, stack0;
struct Heap__1 align;
if (n > 0) {
Heap_MarkStack(n - 1, cand, cand__len);
@@ -585,14 +635,14 @@ static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len)
if (n == 0) {
nofcand = 0;
sp = (ADDRESS)&frame;
- stack0 = Heap_PlatformMainStackFrame();
+ stack0 = Heap_ModulesMainStackFrame();
inc = (ADDRESS)&align.p - (ADDRESS)&align;
- if (sp > stack0) {
+ if (Heap_uLT(stack0, sp)) {
inc = -inc;
}
while (sp != stack0) {
__GET(sp, p, INT32);
- if ((p > Heap_heap && p < Heap_heapend)) {
+ if ((Heap_uLE(Heap_heapMin, p) && Heap_uLT(p, Heap_heapMax))) {
if (nofcand == cand__len) {
Heap_HeapSort(nofcand, (void*)cand, cand__len);
Heap_MarkCandidates(nofcand, (void*)cand, cand__len);
@@ -615,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)
@@ -703,17 +751,21 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
void Heap_InitHeap (void)
{
- Heap_heap = Heap_NewChunk(128000);
- __GET(Heap_heap + 4, Heap_heapend, INT32);
- __PUT(Heap_heap, 0, INT32);
+ Heap_heap = 0;
+ Heap_heapsize = 0;
Heap_allocated = 0;
+ Heap_lockdepth = 0;
+ 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;
Heap_freeList[9] = 1;
- Heap_lockdepth = 0;
Heap_FileCount = 0;
Heap_modules = NIL;
- Heap_heapsize = 0;
- Heap_bigBlocks = 0;
Heap_fin = NIL;
Heap_interrupted = 0;
Heap_HeapModuleInit();
diff --git a/bootstrap/windows-48/Heap.h b/bootstrap/windows-48/Heap.h
index 0aa0a18b..3cde1c3b 100644
--- a/bootstrap/windows-48/Heap.h
+++ b/bootstrap/windows-48/Heap.h
@@ -1,16 +1,26 @@
-/* voc 1.95 [2016/11/24]. 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
#include "SYSTEM.h"
+typedef
+ struct Heap_CmdDesc *Heap_Cmd;
+
typedef
CHAR Heap_CmdName[24];
typedef
void (*Heap_Command)(void);
+typedef
+ struct Heap_CmdDesc {
+ Heap_Cmd next;
+ Heap_CmdName name;
+ Heap_Command cmd;
+ } Heap_CmdDesc;
+
typedef
void (*Heap_EnumProc)(void(*)(SYSTEM_PTR));
@@ -21,22 +31,31 @@ typedef
struct Heap_ModuleDesc *Heap_Module;
typedef
- struct Heap_ModuleDesc {
- INT32 _prvt0;
- char _prvt1[44];
- } Heap_ModuleDesc;
+ CHAR Heap_ModuleName[20];
typedef
- CHAR Heap_ModuleName[20];
+ struct Heap_ModuleDesc {
+ Heap_Module next;
+ Heap_ModuleName name;
+ INT32 refcnt;
+ Heap_Cmd cmds;
+ INT32 types;
+ Heap_EnumProc enumPtrs;
+ char _prvt0[8];
+ } Heap_ModuleDesc;
import SYSTEM_PTR Heap_modules;
-import INT32 Heap_allocated, Heap_heapsize;
+import INT32 Heap_allocated;
+import INT32 Heap_heap;
+import INT32 Heap_heapsize, Heap_heapMinExpand;
import INT16 Heap_FileCount;
import ADDRESS *Heap_ModuleDesc__typ;
+import ADDRESS *Heap_CmdDesc__typ;
import void Heap_FINALL (void);
+import INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len);
import void Heap_GC (BOOLEAN markStack);
import void Heap_INCREF (Heap_Module m);
import void Heap_InitHeap (void);
diff --git a/bootstrap/windows-48/Modules.c b/bootstrap/windows-48/Modules.c
index a5e72ba3..bdad4713 100644
--- a/bootstrap/windows-48/Modules.c
+++ b/bootstrap/windows-48/Modules.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -9,81 +9,303 @@
#include "Heap.h"
#include "Platform.h"
-typedef
- struct Modules_CmdDesc *Modules_Cmd;
-
-typedef
- void (*Modules_Command)(void);
-
-typedef
- struct Modules_CmdDesc {
- Modules_Cmd next;
- CHAR name[24];
- Modules_Command cmd;
- } Modules_CmdDesc;
-
-typedef
- struct Modules_ModuleDesc *Modules_Module;
-
-typedef
- CHAR Modules_ModuleName[20];
-
-typedef
- struct Modules_ModuleDesc {
- Modules_Module next;
- Modules_ModuleName name;
- INT32 refcnt;
- Modules_Cmd cmds;
- INT32 types;
- void (*enumPtrs)(void(*)(INT32));
- INT32 reserved1, reserved2;
- } Modules_ModuleDesc;
-
export INT16 Modules_res;
export CHAR Modules_resMsg[256];
-export Modules_ModuleName Modules_imported, Modules_importing;
+export Heap_ModuleName Modules_imported, Modules_importing;
+export INT32 Modules_MainStackFrame;
+export INT16 Modules_ArgCount;
+export INT32 Modules_ArgVector;
+export CHAR Modules_BinaryDir[1024];
-export ADDRESS *Modules_ModuleDesc__typ;
-export ADDRESS *Modules_CmdDesc__typ;
-static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len);
+static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
+static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
+export INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len);
export void Modules_AssertFail (INT32 code);
+static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
+static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len);
static void Modules_DisplayHaltCode (INT32 code);
-export void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
+static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len);
+static void Modules_FindBinaryDir (CHAR *binarydir, ADDRESS binarydir__len);
+export void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all);
+export void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len);
+export void Modules_GetIntArg (INT16 n, INT32 *val);
export void Modules_Halt (INT32 code);
-export Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
-export Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
+export void Modules_Init (INT32 argc, INT32 argvadr);
+static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len);
+static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len);
+static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len);
+export Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len);
+export Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len);
+static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
static void Modules_errch (CHAR c);
static void Modules_errint (INT32 l);
-static void Modules_errstring (CHAR *s, LONGINT s__len);
+static void Modules_errstring (CHAR *s, ADDRESS s__len);
-#define Modules_modules() (Modules_Module)Heap_modules
-#define Modules_setmodules(m) Heap_modules = m
+extern void Heap_InitHeap();
+extern void *Modules__init(void);
+#define Modules_InitHeap() Heap_InitHeap()
+#define Modules_ModulesInit() Modules__init()
+#define Modules_modules() (Heap_Module)Heap_modules
-static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len)
+void Modules_Init (INT32 argc, INT32 argvadr)
{
- INT16 i, j;
- __DUP(b, b__len, CHAR);
+ Modules_MainStackFrame = argvadr;
+ Modules_ArgCount = __VAL(INT16, argc);
+ __GET(argvadr, Modules_ArgVector, INT32);
+ Modules_InitHeap();
+ Modules_ModulesInit();
+}
+
+typedef
+ CHAR (*argptr__15)[1024];
+
+void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len)
+{
+ argptr__15 arg = NIL;
+ if (n < Modules_ArgCount) {
+ __GET(Modules_ArgVector + __ASHL(n, 2), arg, argptr__15);
+ __COPY(*arg, val, val__len);
+ }
+}
+
+void Modules_GetIntArg (INT16 n, INT32 *val)
+{
+ CHAR s[64];
+ INT32 k, d, i;
+ s[0] = 0x00;
+ Modules_GetArg(n, (void*)s, 64);
i = 0;
- while (a[__X(i, a__len)] != 0x00) {
+ if (s[0] == '-') {
+ i = 1;
+ }
+ k = 0;
+ d = (INT16)s[__X(i, 64)] - 48;
+ while ((d >= 0 && d <= 9)) {
+ k = k * 10 + d;
+ i += 1;
+ d = (INT16)s[__X(i, 64)] - 48;
+ }
+ if (s[0] == '-') {
+ k = -k;
+ i -= 1;
+ }
+ if (i > 0) {
+ *val = k;
+ }
+}
+
+INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len)
+{
+ INT16 i;
+ CHAR arg[256];
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ Modules_GetArg(i, (void*)arg, 256);
+ while ((i < Modules_ArgCount && __STRCMP(s, arg) != 0)) {
+ i += 1;
+ Modules_GetArg(i, (void*)arg, 256);
+ }
+ __DEL(s);
+ return i;
+}
+
+static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len)
+{
+ INT16 i;
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
i += 1;
}
- j = 0;
- while (b[__X(j, b__len)] != 0x00) {
- a[__X(i, a__len)] = b[__X(j, b__len)];
+ __DEL(s);
+ return i;
+}
+
+static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
+{
+ INT16 i, j;
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ j = Modules_CharCount(d, d__len);
+ while (s[__X(i, s__len)] != 0x00) {
+ d[__X(j, d__len)] = s[__X(i, s__len)];
i += 1;
j += 1;
}
- a[__X(i, a__len)] = 0x00;
- __DEL(b);
+ d[__X(j, d__len)] = 0x00;
+ __DEL(s);
}
-Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
+static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{
- Modules_Module m = NIL;
+ INT16 i, j;
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ j = Modules_CharCount(d, d__len);
+ if ((j > 0 && d[__X(j - 1, d__len)] != c)) {
+ d[__X(j, d__len)] = c;
+ j += 1;
+ }
+ while (s[__X(i, s__len)] != 0x00) {
+ d[__X(j, d__len)] = s[__X(i, s__len)];
+ i += 1;
+ j += 1;
+ }
+ d[__X(j, d__len)] = 0x00;
+ __DEL(s);
+}
+
+static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len)
+{
+ INT16 i;
+ __DUP(s, s__len, CHAR);
+ if (c == 0x00) {
+ __DEL(s);
+ return 0;
+ }
+ i = 0;
+ while ((s[__X(i, s__len)] != c && s[__X(i, s__len)] != 0x00)) {
+ i += 1;
+ }
+ __DEL(s);
+ return s[__X(i, s__len)] == c;
+}
+
+static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len)
+{
+ __DUP(d, d__len, CHAR);
+ if (d[0] == 0x00) {
+ __DEL(d);
+ return 0;
+ }
+ if (Modules_IsOneOf(d[0], (CHAR*)"/\\", 3)) {
+ __DEL(d);
+ return 1;
+ }
+ if (d[__X(1, d__len)] == ':') {
+ __DEL(d);
+ return 1;
+ }
+ __DEL(d);
+ return 0;
+}
+
+static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
+{
+ __DUP(s, s__len, CHAR);
+ if (Modules_IsAbsolute(s, s__len)) {
+ __COPY(s, d, d__len);
+ } else {
+ __COPY(Platform_CWD, d, d__len);
+ Modules_AppendPart('/', s, s__len, (void*)d, d__len);
+ }
+ __DEL(s);
+}
+
+static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len)
+{
+ Platform_FileIdentity identity;
+ __DUP(s, s__len, CHAR);
+ __DEL(s);
+ return Platform_IdentifyByName(s, s__len, &identity, Platform_FileIdentity__typ) == 0;
+}
+
+static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len)
+{
+ INT16 j;
+ __DUP(s, s__len, CHAR);
+ __DUP(p, p__len, CHAR);
+ j = 0;
+ while ((s[__X(*i, s__len)] != 0x00 && !Modules_IsOneOf(s[__X(*i, s__len)], p, p__len))) {
+ d[__X(j, d__len)] = s[__X(*i, s__len)];
+ *i += 1;
+ j += 1;
+ }
+ d[__X(j, d__len)] = 0x00;
+ while (Modules_IsOneOf(s[__X(*i, s__len)], p, p__len)) {
+ *i += 1;
+ }
+ __DEL(s);
+ __DEL(p);
+}
+
+static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
+{
+ INT16 i, j;
+ CHAR part[1024];
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ j = 0;
+ while ((i < 2 && Modules_IsOneOf(s[__X(i, s__len)], (CHAR*)"/\\", 3))) {
+ i += 1;
+ d[__X(j, d__len)] = '/';
+ j += 1;
+ }
+ d[__X(j, d__len)] = 0x00;
+ while (s[__X(i, s__len)] != 0x00) {
+ Modules_ExtractPart(s, s__len, &i, (CHAR*)"/\\", 3, (void*)part, 1024);
+ if ((part[0] != 0x00 && __STRCMP(part, ".") != 0)) {
+ Modules_AppendPart('/', part, 1024, (void*)d, d__len);
+ }
+ }
+ __DEL(s);
+}
+
+typedef
+ CHAR pathstring__12[4096];
+
+static void Modules_FindBinaryDir (CHAR *binarydir, ADDRESS binarydir__len)
+{
+ pathstring__12 arg0, pathlist, pathdir, tempstr;
+ INT16 i, j, k;
+ BOOLEAN present;
+ if (Modules_ArgCount < 1) {
+ binarydir[0] = 0x00;
+ return;
+ }
+ Modules_GetArg(0, (void*)arg0, 4096);
+ i = 0;
+ while ((((arg0[__X(i, 4096)] != 0x00 && arg0[__X(i, 4096)] != '/')) && arg0[__X(i, 4096)] != '\\')) {
+ i += 1;
+ }
+ if (arg0[__X(i, 4096)] == '/' || arg0[__X(i, 4096)] == '\\') {
+ Modules_Trim(arg0, 4096, (void*)tempstr, 4096);
+ Modules_Canonify(tempstr, 4096, (void*)binarydir, binarydir__len);
+ present = Modules_IsFilePresent(binarydir, binarydir__len);
+ } else {
+ Platform_GetEnv((CHAR*)"PATH", 5, (void*)pathlist, 4096);
+ i = 0;
+ present = 0;
+ while ((!present && pathlist[__X(i, 4096)] != 0x00)) {
+ Modules_ExtractPart(pathlist, 4096, &i, (CHAR*)":;", 3, (void*)pathdir, 4096);
+ Modules_AppendPart('/', arg0, 4096, (void*)pathdir, 4096);
+ Modules_Trim(pathdir, 4096, (void*)tempstr, 4096);
+ Modules_Canonify(tempstr, 4096, (void*)binarydir, binarydir__len);
+ present = Modules_IsFilePresent(binarydir, binarydir__len);
+ }
+ }
+ if (present) {
+ k = Modules_CharCount(binarydir, binarydir__len);
+ while ((k > 0 && !Modules_IsOneOf(binarydir[__X(k - 1, binarydir__len)], (CHAR*)"/\\", 3))) {
+ k -= 1;
+ }
+ if (k == 0) {
+ binarydir[__X(k, binarydir__len)] = 0x00;
+ } else {
+ binarydir[__X(k - 1, binarydir__len)] = 0x00;
+ }
+ } else {
+ binarydir[0] = 0x00;
+ }
+}
+
+Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len)
+{
+ Heap_Module m = NIL;
CHAR bodyname[64];
- Modules_Command body;
+ Heap_Command body;
__DUP(name, name__len, CHAR);
m = Modules_modules();
while ((m != NIL && __STRCMP(m->name, name) != 0)) {
@@ -96,16 +318,16 @@ Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
Modules_res = 1;
__COPY(name, Modules_importing, 20);
__MOVE(" module \"", Modules_resMsg, 10);
- Modules_Append((void*)Modules_resMsg, 256, name, name__len);
- Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
+ Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
+ Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
}
__DEL(name);
return m;
}
-Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len)
+Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len)
{
- Modules_Cmd c = NIL;
+ Heap_Cmd c = NIL;
__DUP(name, name__len, CHAR);
c = mod->cmds;
while ((c != NIL && __STRCMP(c->name, name) != 0)) {
@@ -120,43 +342,36 @@ Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT nam
Modules_res = 2;
__MOVE(" command \"", Modules_resMsg, 11);
__COPY(name, Modules_importing, 20);
- Modules_Append((void*)Modules_resMsg, 256, mod->name, 20);
- Modules_Append((void*)Modules_resMsg, 256, (CHAR*)".", 2);
- Modules_Append((void*)Modules_resMsg, 256, name, name__len);
- Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
+ Modules_Append(mod->name, 20, (void*)Modules_resMsg, 256);
+ Modules_Append((CHAR*)".", 2, (void*)Modules_resMsg, 256);
+ Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
+ Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
__DEL(name);
return NIL;
}
__RETCHK;
}
-void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all)
+void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all)
{
- Modules_Module m = NIL, p = NIL;
+ Heap_Module m = NIL, p = NIL;
+ INT32 refcount;
__DUP(name, name__len, CHAR);
m = Modules_modules();
if (all) {
Modules_res = 1;
__MOVE("unloading \"all\" not yet supported", Modules_resMsg, 34);
} else {
- while ((m != NIL && __STRCMP(m->name, name) != 0)) {
- p = m;
- m = m->next;
- }
- if ((m != NIL && m->refcnt == 0)) {
- if (m == Modules_modules()) {
- Modules_setmodules(m->next);
- } else {
- p->next = m->next;
- }
+ refcount = Heap_FreeModule(name, name__len);
+ if (refcount == 0) {
Modules_res = 0;
} else {
- Modules_res = 1;
- if (m == NIL) {
+ if (refcount < 0) {
__MOVE("module not found", Modules_resMsg, 17);
} else {
__MOVE("clients of this module exist", Modules_resMsg, 29);
}
+ Modules_res = 1;
}
}
__DEL(name);
@@ -165,10 +380,10 @@ void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all)
static void Modules_errch (CHAR c)
{
INT16 e;
- e = Platform_Write(1, (ADDRESS)&c, 1);
+ e = Platform_Write(Platform_StdOut, (ADDRESS)&c, 1);
}
-static void Modules_errstring (CHAR *s, LONGINT s__len)
+static void Modules_errstring (CHAR *s, ADDRESS s__len)
{
INT32 i;
__DUP(s, s__len, CHAR);
@@ -189,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)
@@ -250,6 +465,7 @@ static void Modules_DisplayHaltCode (INT32 code)
void Modules_Halt (INT32 code)
{
+ Heap_FINALL();
Modules_errstring((CHAR*)"Terminated by Halt(", 20);
Modules_errint(code);
Modules_errstring((CHAR*)"). ", 4);
@@ -262,6 +478,7 @@ void Modules_Halt (INT32 code)
void Modules_AssertFail (INT32 code)
{
+ Heap_FINALL();
Modules_errstring((CHAR*)"Assertion failure.", 19);
if (code != 0) {
Modules_errstring((CHAR*)" ASSERT code ", 14);
@@ -269,11 +486,13 @@ void Modules_AssertFail (INT32 code)
Modules_errstring((CHAR*)".", 2);
}
Modules_errstring(Platform_NL, 3);
- Platform_Exit(code);
+ if (code > 0) {
+ Platform_Exit(code);
+ } else {
+ Platform_Exit(-1);
+ }
}
-__TDESC(Modules_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 48), {0, 28, -12}};
-__TDESC(Modules_CmdDesc, 1, 1) = {__TDFLDS("CmdDesc", 32), {0, -8}};
export void *Modules__init(void)
{
@@ -281,8 +500,7 @@ export void *Modules__init(void)
__MODULE_IMPORT(Heap);
__MODULE_IMPORT(Platform);
__REGMOD("Modules", 0);
- __INITYP(Modules_ModuleDesc, Modules_ModuleDesc, 0);
- __INITYP(Modules_CmdDesc, Modules_CmdDesc, 0);
/* BEGIN */
+ Modules_FindBinaryDir((void*)Modules_BinaryDir, 1024);
__ENDMOD;
}
diff --git a/bootstrap/windows-48/Modules.h b/bootstrap/windows-48/Modules.h
index 8bb89fe5..26d86b38 100644
--- a/bootstrap/windows-48/Modules.h
+++ b/bootstrap/windows-48/Modules.h
@@ -1,53 +1,30 @@
-/* voc 1.95 [2016/11/24]. 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
#include "SYSTEM.h"
-
-typedef
- struct Modules_CmdDesc *Modules_Cmd;
-
-typedef
- void (*Modules_Command)(void);
-
-typedef
- struct Modules_CmdDesc {
- Modules_Cmd next;
- CHAR name[24];
- Modules_Command cmd;
- } Modules_CmdDesc;
-
-typedef
- struct Modules_ModuleDesc *Modules_Module;
-
-typedef
- CHAR Modules_ModuleName[20];
-
-typedef
- struct Modules_ModuleDesc {
- Modules_Module next;
- Modules_ModuleName name;
- INT32 refcnt;
- Modules_Cmd cmds;
- INT32 types;
- void (*enumPtrs)(void(*)(INT32));
- char _prvt0[8];
- } Modules_ModuleDesc;
+#include "Heap.h"
import INT16 Modules_res;
import CHAR Modules_resMsg[256];
-import Modules_ModuleName Modules_imported, Modules_importing;
+import Heap_ModuleName Modules_imported, Modules_importing;
+import INT32 Modules_MainStackFrame;
+import INT16 Modules_ArgCount;
+import INT32 Modules_ArgVector;
+import CHAR Modules_BinaryDir[1024];
-import ADDRESS *Modules_ModuleDesc__typ;
-import ADDRESS *Modules_CmdDesc__typ;
+import INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len);
import void Modules_AssertFail (INT32 code);
-import void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
+import void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all);
+import void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len);
+import void Modules_GetIntArg (INT16 n, INT32 *val);
import void Modules_Halt (INT32 code);
-import Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
-import Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
+import void Modules_Init (INT32 argc, INT32 argvadr);
+import Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len);
+import Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len);
import void *Modules__init(void);
diff --git a/bootstrap/windows-48/OPB.c b/bootstrap/windows-48/OPB.c
index 3ef8e2f9..913fbf2d 100644
--- a/bootstrap/windows-48/OPB.c
+++ b/bootstrap/windows-48/OPB.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -253,7 +253,7 @@ OPT_Node OPB_NewString (OPS_String str, INT64 len)
x->conval->intval = -1;
x->conval->intval2 = OPM_Longint(len);
x->conval->ext = OPT_NewExt();
- __COPY(str, *x->conval->ext, 256);
+ __MOVE(str, *x->conval->ext, 256);
return x;
}
@@ -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;
@@ -550,7 +550,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
if (__IN(f, 0xf0, 32)) {
if (z->class == 7) {
if (f == 4) {
- if (z->conval->intval == (-9223372036854775807-1)) {
+ if (z->conval->intval == (-9223372036854775807LL-1)) {
OPB_err(203);
} else {
z->conval->intval = -z->conval->intval;
@@ -577,7 +577,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
if (__IN(f, 0x70, 32)) {
if (z->class == 7) {
if (f == 4) {
- if (z->conval->intval == (-9223372036854775807-1)) {
+ if (z->conval->intval == (-9223372036854775807LL-1)) {
OPB_err(203);
} else {
z->conval->intval = __ABS(z->conval->intval);
@@ -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);
@@ -920,7 +920,7 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
if (f == 4) {
xv = xval->intval;
yv = yval->intval;
- if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807-1))) && yv != (-9223372036854775807-1))) && -xv <= __DIV(9223372036854775807, -yv))) {
+ if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807LL, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807LL-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807LL-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807LL-1))) && yv != (-9223372036854775807LL-1))) && -xv <= __DIV(9223372036854775807LL, -yv))) {
xval->intval = xv * yv;
OPB_SetIntType(x);
} else {
@@ -999,8 +999,8 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
break;
case 6:
if (f == 4) {
- temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807 - yval->intval);
- if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807-1) - yval->intval)) {
+ temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807LL - yval->intval);
+ if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807LL-1) - yval->intval)) {
xval->intval += yval->intval;
OPB_SetIntType(x);
} else {
@@ -1023,7 +1023,7 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
break;
case 7:
if (f == 4) {
- if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807 + yval->intval)) {
+ if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807LL-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807LL + yval->intval)) {
xval->intval -= yval->intval;
OPB_SetIntType(x);
} else {
@@ -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);
}
}
@@ -1624,23 +1624,20 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
g = 8;
}
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) {
OPB_err(114);
}
- } else if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
} else {
OPB_err(113);
}
} else {
OPB_err(113);
}
- } else if ((x->comp == 3 && x->BaseTyp == OPT_chartyp)) {
- if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
- } else {
- OPB_err(113);
- }
} else if (x->comp == 4) {
if (x == y) {
} else if (y->comp == 4) {
@@ -2091,7 +2088,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
OPB_err(208);
p->conval->intval = 1;
} else if (x->conval->intval >= 0) {
- if (__ABS(p->conval->intval) <= __DIV(9223372036854775807, (INT64)__ASH(1, x->conval->intval))) {
+ if (__ABS(p->conval->intval) <= __DIV(9223372036854775807LL, (INT64)__ASH(1, x->conval->intval))) {
p->conval->intval = p->conval->intval * (INT64)__ASH(1, x->conval->intval);
} else {
OPB_err(208);
@@ -2536,7 +2533,6 @@ void OPB_Return (OPT_Node *x, OPT_Object proc)
void OPB_Assign (OPT_Node *x, OPT_Node y)
{
OPT_Node z = NIL;
- INT8 subcl;
if ((*x)->class >= 7) {
OPB_err(56);
}
@@ -2562,13 +2558,8 @@ void OPB_Assign (OPT_Node *x, OPT_Node y)
y->conval->intval = 0;
OPB_Index(&*x, OPB_NewIntConst(0));
}
- if ((((((__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp == OPT_chartyp)) && __IN(y->typ->comp, 0x0c, 32))) && y->typ->BaseTyp == OPT_chartyp)) {
- subcl = 18;
- } else {
- subcl = 0;
- }
OPB_BindNodes(19, OPT_notyp, &*x, y);
- (*x)->subcl = subcl;
+ (*x)->subcl = 0;
}
void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ)
@@ -2595,7 +2586,7 @@ export void *OPB__init(void)
__MODULE_IMPORT(OPT);
__REGMOD("OPB", 0);
/* BEGIN */
- OPB_maxExp = OPB_log(4611686018427387904);
+ OPB_maxExp = OPB_log(4611686018427387904LL);
OPB_maxExp = OPB_exp;
__ENDMOD;
}
diff --git a/bootstrap/windows-48/OPB.h b/bootstrap/windows-48/OPB.h
index 0be714e8..f66fcd66 100644
--- a/bootstrap/windows-48/OPB.h
+++ b/bootstrap/windows-48/OPB.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 ef4b429f..7b92ccc1 100644
--- a/bootstrap/windows-48/OPC.c
+++ b/bootstrap/windows-48/OPC.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -56,7 +56,7 @@ static void OPC_GenHeaderMsg (void);
export void OPC_Halt (INT32 n);
export void OPC_Ident (OPT_Object obj);
static void OPC_IdentList (OPT_Object obj, INT16 vis);
-static void OPC_Include (CHAR *name, LONGINT name__len);
+static void OPC_Include (CHAR *name, ADDRESS name__len);
static void OPC_IncludeImports (OPT_Object obj, INT16 vis);
export void OPC_Increment (BOOLEAN decrement);
export void OPC_Indent (INT16 count);
@@ -68,11 +68,11 @@ static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj);
export void OPC_IntLiteral (INT64 n, INT32 size);
export void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim);
static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName);
-static INT16 OPC_Length (CHAR *s, LONGINT s__len);
+static INT16 OPC_Length (CHAR *s, ADDRESS s__len);
export BOOLEAN OPC_NeedsRetval (OPT_Object proc);
export INT32 OPC_NofPtrs (OPT_Struct typ);
-static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len);
-static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len);
+static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len);
+static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len);
static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define);
static void OPC_ProcPredefs (OPT_Object obj, INT8 vis);
static void OPC_PutBase (OPT_Struct typ);
@@ -80,8 +80,8 @@ static void OPC_PutPtrOffsets (OPT_Struct typ, INT32 adr, INT32 *cnt);
static void OPC_RegCmds (OPT_Object obj);
export void OPC_SetInclude (BOOLEAN exclude);
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
-static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x);
-static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l);
+static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x);
+static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l);
export void OPC_TDescDecl (OPT_Struct typ);
export void OPC_TypeDefs (OPT_Object obj, INT16 vis);
export void OPC_TypeOf (OPT_Object ap);
@@ -137,7 +137,7 @@ void OPC_EndBlk0 (void)
OPM_Write('}');
}
-static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
+static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x)
{
CHAR ch;
INT16 i;
@@ -156,7 +156,7 @@ static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
__DEL(s);
}
-static INT16 OPC_Length (CHAR *s, LONGINT s__len)
+static INT16 OPC_Length (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@@ -166,7 +166,7 @@ static INT16 OPC_Length (CHAR *s, LONGINT s__len)
return i;
}
-static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len)
+static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len)
{
INT16 i, h;
i = 0;
@@ -364,7 +364,7 @@ static void OPC_DeclareBase (OPT_Object dcl)
OPM_WriteString((CHAR*)"struct ", 8);
OPC_BegBlk();
OPC_BegStat();
- OPC_Str1((CHAR*)"LONGINT len[#]", 15, nofdims);
+ OPC_Str1((CHAR*)"ADDRESS len[#]", 15, nofdims);
OPC_EndStat();
OPC_BegStat();
__NEW(obj, OPT_ObjDesc);
@@ -511,7 +511,7 @@ static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamNa
typ = par->typ->BaseTyp;
while (typ->comp == 3) {
if (ansiDefine) {
- OPM_WriteString((CHAR*)", LONGINT ", 11);
+ OPM_WriteString((CHAR*)", ADDRESS ", 11);
} else {
OPM_WriteString((CHAR*)", ", 3);
}
@@ -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,12 +721,19 @@ 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();
+ }
}
}
}
}
-static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len)
+static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len)
{
INT16 i;
__DUP(y, y__len, CHAR);
@@ -968,8 +981,8 @@ static void OPC_IdentList (OPT_Object obj, INT16 vis)
if (obj->typ->comp == 3) {
OPC_EndStat();
OPC_BegStat();
- base = OPT_linttyp;
- OPM_WriteString((CHAR*)"LONGINT ", 9);
+ base = OPT_adrtyp;
+ OPM_WriteString((CHAR*)"ADDRESS ", 9);
OPC_LenList(obj, 0, 1);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPC_EndStat();
@@ -1008,7 +1021,7 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
__COPY(name, obj->name, 256);
}
if (obj->typ->comp == 3) {
- OPM_WriteString((CHAR*)", LONGINT ", 11);
+ OPM_WriteString((CHAR*)", ADDRESS ", 11);
OPC_LenList(obj, 1, showParamNames);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPM_WriteString((CHAR*)", ADDRESS *", 12);
@@ -1062,7 +1075,7 @@ static void OPC_ProcPredefs (OPT_Object obj, INT8 vis)
}
}
-static void OPC_Include (CHAR *name, LONGINT name__len)
+static void OPC_Include (CHAR *name, ADDRESS name__len)
{
__DUP(name, name__len, CHAR);
OPM_WriteString((CHAR*)"#include ", 10);
@@ -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) {
@@ -1659,9 +1672,9 @@ void OPC_CompleteIdent (OPT_Object obj)
OPC_Ident(obj);
OPM_WriteString((CHAR*)"__", 3);
} else {
- OPM_WriteString((CHAR*)"((", 3);
+ OPM_WriteString((CHAR*)"(*(", 4);
OPC_Ident(obj->typ->strobj);
- OPM_Write(')');
+ OPM_WriteString((CHAR*)"*)&", 4);
OPC_Ident(obj);
OPM_Write(')');
}
@@ -1739,12 +1752,12 @@ 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('\'');
}
}
-static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l)
+static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
{
INT32 i;
INT16 c;
@@ -1755,16 +1768,16 @@ static void OPC_StringLiteral (CHAR *s, LONGINT 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);
}
}
@@ -1912,9 +1927,9 @@ static struct InitKeywords__46 {
struct InitKeywords__46 *lnk;
} *InitKeywords__46_s;
-static void Enter__47 (CHAR *s, LONGINT s__len);
+static void Enter__47 (CHAR *s, ADDRESS s__len);
-static void Enter__47 (CHAR *s, LONGINT s__len)
+static void Enter__47 (CHAR *s, ADDRESS s__len)
{
INT16 h;
__DUP(s, s__len, CHAR);
diff --git a/bootstrap/windows-48/OPC.h b/bootstrap/windows-48/OPC.h
index 842e7dec..3bfd88b8 100644
--- a/bootstrap/windows-48/OPC.h
+++ b/bootstrap/windows-48/OPC.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 e76d763e..bcb39247 100644
--- a/bootstrap/windows-48/OPM.c
+++ b/bootstrap/windows-48/OPM.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,6 +8,7 @@
#include "SYSTEM.h"
#include "Configuration.h"
#include "Files.h"
+#include "Modules.h"
#include "Out.h"
#include "Platform.h"
#include "Strings.h"
@@ -18,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];
@@ -26,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;
@@ -41,41 +44,48 @@ static Files_Rider OPM_oldSF, OPM_newSF;
static Files_Rider OPM_R[3];
static Files_File OPM_oldSFile, OPM_newSFile, OPM_HFile, OPM_BFile, OPM_HIFile;
static INT16 OPM_S;
+export CHAR OPM_InstallDir[1024];
export CHAR OPM_ResourceDir[1024];
static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F);
export void OPM_CloseFiles (void);
export void OPM_CloseOldSym (void);
-export void OPM_DeleteNewSym (void);
+export void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
+export void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
export void OPM_FPrint (INT32 *fp, INT64 val);
export void OPM_FPrintLReal (INT32 *fp, LONGREAL val);
export void OPM_FPrintReal (INT32 *fp, REAL val);
export void OPM_FPrintSet (INT32 *fp, UINT64 val);
+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, LONGINT bytes__len);
+static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len);
export void OPM_Get (CHAR *ch);
-export void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
+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);
+static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len);
+export void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len);
static void OPM_LogErrMsg (INT16 n);
-export void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
+export void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len);
export void OPM_LogW (CHAR ch);
export void OPM_LogWLn (void);
export void OPM_LogWNum (INT64 i, INT64 len);
-export void OPM_LogWStr (CHAR *s, LONGINT s__len);
+export void OPM_LogWStr (CHAR *s, ADDRESS s__len);
export INT32 OPM_Longint (INT64 n);
-static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len);
+static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len);
export void OPM_Mark (INT16 n, INT32 pos);
-export void OPM_NewSym (CHAR *modName, LONGINT modName__len);
-export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
-export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
+export void OPM_NewSym (CHAR *modName, ADDRESS modName__len);
+export void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done);
+export void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len);
export BOOLEAN OPM_OpenPar (void);
export void OPM_RegisterNewSym (void);
-static void OPM_ScanOptions (CHAR *s, LONGINT s__len);
+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);
@@ -87,14 +97,13 @@ export void OPM_SymWInt (INT64 i);
export void OPM_SymWLReal (LONGREAL lr);
export void OPM_SymWReal (REAL r);
export void OPM_SymWSet (UINT64 s);
-static void OPM_VerboseListSizes (void);
export void OPM_Write (CHAR ch);
export void OPM_WriteHex (INT64 i);
export void OPM_WriteInt (INT64 i);
export void OPM_WriteLn (void);
export void OPM_WriteReal (LONGREAL r, CHAR suffx);
-export void OPM_WriteString (CHAR *s, LONGINT s__len);
-export void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
+export void OPM_WriteString (CHAR *s, ADDRESS s__len);
+export void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
export BOOLEAN OPM_eofSF (void);
export void OPM_err (INT16 n);
@@ -105,7 +114,7 @@ void OPM_LogW (CHAR ch)
Out_Char(ch);
}
-void OPM_LogWStr (CHAR *s, LONGINT s__len)
+void OPM_LogWStr (CHAR *s, ADDRESS s__len)
{
__DUP(s, s__len, CHAR);
Out_String(s, s__len);
@@ -122,7 +131,7 @@ void OPM_LogWLn (void)
Out_Ln();
}
-void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
+void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len)
{
__DUP(vt100code, vt100code__len, CHAR);
if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) {
@@ -131,6 +140,57 @@ void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
__DEL(vt100code);
}
+void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len)
+{
+ __DUP(modname, modname__len, CHAR);
+ OPM_LogWStr((CHAR*)"Compiling ", 11);
+ OPM_LogWStr(modname, modname__len);
+ if (__IN(18, OPM_Options, 32)) {
+ OPM_LogWStr((CHAR*)", s:", 5);
+ OPM_LogWNum(__ASHL(OPM_ShortintSize, 3), 1);
+ OPM_LogWStr((CHAR*)" i:", 4);
+ OPM_LogWNum(__ASHL(OPM_IntegerSize, 3), 1);
+ OPM_LogWStr((CHAR*)" l:", 4);
+ OPM_LogWNum(__ASHL(OPM_LongintSize, 3), 1);
+ OPM_LogWStr((CHAR*)" adr:", 6);
+ OPM_LogWNum(__ASHL(OPM_AddressSize, 3), 1);
+ OPM_LogWStr((CHAR*)" algn:", 7);
+ OPM_LogWNum(__ASHL(OPM_Alignment, 3), 1);
+ }
+ OPM_LogW('.');
+ __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;
@@ -154,7 +214,7 @@ INT16 OPM_Integer (INT64 n)
return __VAL(INT16, n);
}
-static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
+static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
@@ -227,29 +287,6 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
i += 2;
}
break;
- case 'B':
- if (s[__X(i + 1, s__len)] != 0x00) {
- i += 1;
- OPM_IntegerSize = (INT16)s[__X(i, s__len)] - 48;
- }
- if (s[__X(i + 1, s__len)] != 0x00) {
- i += 1;
- OPM_AddressSize = (INT16)s[__X(i, s__len)] - 48;
- }
- if (s[__X(i + 1, s__len)] != 0x00) {
- i += 1;
- OPM_Alignment = (INT16)s[__X(i, s__len)] - 48;
- }
- __ASSERT(OPM_IntegerSize == 2 || OPM_IntegerSize == 4, 0);
- __ASSERT(OPM_AddressSize == 4 || OPM_AddressSize == 8, 0);
- __ASSERT(OPM_Alignment == 4 || OPM_Alignment == 8, 0);
- if (OPM_IntegerSize == 2) {
- OPM_LongintSize = 4;
- } else {
- OPM_LongintSize = 8;
- }
- Files_SetSearchPath((CHAR*)"", 1);
- break;
default:
OPM_LogWStr((CHAR*)" warning: option ", 19);
OPM_LogW('-');
@@ -266,16 +303,19 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
BOOLEAN OPM_OpenPar (void)
{
CHAR s[256];
- if (Platform_ArgCount == 1) {
+ 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);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Further development by Norayr Chilingarian, David Brown and others.", 68);
OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Loaded from ", 13);
+ OPM_LogWStr(Modules_BinaryDir, 1024);
+ OPM_LogWLn();
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Usage:", 7);
OPM_LogWLn();
@@ -332,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();
@@ -362,64 +402,38 @@ BOOLEAN OPM_OpenPar (void)
OPM_Options = 0xa9;
OPM_S = 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
}
OPM_GlobalAddressSize = OPM_AddressSize;
OPM_GlobalAlignment = OPM_Alignment;
- __COPY(OPM_Model, OPM_GlobalModel, 10);
+ __MOVE(OPM_Model, OPM_GlobalModel, 10);
OPM_GlobalOptions = OPM_Options;
return 1;
}
__RETCHK;
}
-static void OPM_VerboseListSizes (void)
-{
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Type Size", 15);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"SHORTINT ", 12);
- OPM_LogWNum(OPM_ShortintSize, 4);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"INTEGER ", 12);
- OPM_LogWNum(OPM_IntegerSize, 4);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"LONGINT ", 12);
- OPM_LogWNum(OPM_LongintSize, 4);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"SET ", 12);
- OPM_LogWNum(OPM_LongintSize, 4);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"ADDRESS ", 12);
- OPM_LogWNum(OPM_AddressSize, 4);
- OPM_LogWLn();
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Alignment: ", 12);
- OPM_LogWNum(OPM_Alignment, 4);
- OPM_LogWLn();
-}
-
void OPM_InitOptions (void)
{
CHAR s[256];
CHAR searchpath[1024], modules[1024];
CHAR MODULES[1024];
OPM_Options = OPM_GlobalOptions;
- __COPY(OPM_GlobalModel, OPM_Model, 10);
+ __MOVE(OPM_GlobalModel, OPM_Model, 10);
OPM_Alignment = OPM_GlobalAlignment;
OPM_AddressSize = OPM_GlobalAddressSize;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
}
if (__IN(15, OPM_Options, 32)) {
OPM_Options |= __SETOF(10,32);
@@ -430,29 +444,32 @@ 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;
}
- if (__IN(18, OPM_Options, 32)) {
- OPM_VerboseListSizes();
+ __MOVE(OPM_InstallDir, OPM_ResourceDir, 1024);
+ if (OPM_ResourceDir[0] != 0x00) {
+ Strings_Append((CHAR*)"/", 2, (void*)OPM_ResourceDir, 1024);
+ Strings_Append(OPM_Model, 10, (void*)OPM_ResourceDir, 1024);
}
- OPM_ResourceDir[0] = 0x00;
- Strings_Append((CHAR*)"/", 2, (void*)OPM_ResourceDir, 1024);
- Strings_Append(OPM_Model, 10, (void*)OPM_ResourceDir, 1024);
modules[0] = 0x00;
Platform_GetEnv((CHAR*)"MODULES", 8, (void*)modules, 1024);
__MOVE(".", searchpath, 2);
@@ -465,23 +482,22 @@ void OPM_InitOptions (void)
Files_SetSearchPath(searchpath, 1024);
}
-void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
+void OPM_Init (BOOLEAN *done)
{
Texts_Text T = NIL;
INT32 beg, end, time;
CHAR s[256];
*done = 0;
OPM_curpos = 0;
- if (OPM_S >= Platform_ArgCount) {
+ if (OPM_S >= Modules_ArgCount) {
return;
}
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
__NEW(T, Texts_TextDesc);
Texts_Open(T, s, 256);
OPM_LogWStr(s, 256);
OPM_LogWStr((CHAR*)" ", 3);
- __COPY(s, mname, mname__len);
__COPY(s, OPM_SourceFileName, 256);
if (T->len == 0) {
OPM_LogWStr(s, 256);
@@ -503,18 +519,14 @@ void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
void OPM_Get (CHAR *ch)
{
+ OPM_curpos = Texts_Pos(&OPM_inR, Texts_Reader__typ);
Texts_Read(&OPM_inR, Texts_Reader__typ, &*ch);
- if (*ch == 0x0d) {
- OPM_curpos = Texts_Pos(&OPM_inR, Texts_Reader__typ);
- } else {
- OPM_curpos += 1;
- }
if ((*ch < 0x09 && !OPM_inR.eot)) {
*ch = ' ';
}
}
-static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len)
+static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len)
{
INT16 i, j;
CHAR ch;
@@ -632,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;
@@ -640,7 +652,6 @@ static void OPM_ShowLine (INT64 pos)
OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogW('^');
OPM_LogVT100((CHAR*)"0m", 3);
- Files_Close(f);
}
void OPM_Mark (INT16 n, INT32 pos)
@@ -700,7 +711,7 @@ void OPM_err (INT16 n)
OPM_Mark(n, OPM_errpos);
}
-static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len)
+static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len)
{
INT16 i;
INT32 l;
@@ -772,10 +783,13 @@ void OPM_CloseOldSym (void)
Files_Close(Files_Base(&OPM_oldSF, Files_Rider__typ));
}
-void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done)
+void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done)
{
CHAR tag, ver;
OPM_FileName fileName;
+ INT16 res;
+ OPM_oldSFile = NIL;
+ *done = 0;
OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
OPM_oldSFile = Files_Old(fileName, 32);
*done = OPM_oldSFile != NIL;
@@ -783,8 +797,10 @@ void OPM_OldSym (CHAR *modName, LONGINT 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 != 0x82) {
- OPM_err(-306);
+ if (tag != 0xf7 || ver != 0x84) {
+ if (!__IN(4, OPM_Options, 32)) {
+ OPM_err(-306);
+ }
OPM_CloseOldSym();
*done = 0;
}
@@ -828,11 +844,23 @@ void OPM_RegisterNewSym (void)
}
}
-void OPM_DeleteNewSym (void)
+void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len)
{
+ OPM_FileName fn;
+ INT16 res;
+ OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".sym", 5);
+ Files_Delete(fn, 32, &res);
}
-void OPM_NewSym (CHAR *modName, LONGINT modName__len)
+void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len)
+{
+ OPM_FileName fn;
+ INT16 res;
+ OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".o", 3);
+ Files_Delete(fn, 32, &res);
+}
+
+void OPM_NewSym (CHAR *modName, ADDRESS modName__len)
{
OPM_FileName fileName;
OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
@@ -840,7 +868,7 @@ void OPM_NewSym (CHAR *modName, LONGINT 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, 0x82);
+ Files_Write(&OPM_newSF, Files_Rider__typ, 0x84);
} else {
OPM_err(153);
}
@@ -851,7 +879,7 @@ void OPM_Write (CHAR ch)
Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, ch);
}
-void OPM_WriteString (CHAR *s, LONGINT s__len)
+void OPM_WriteString (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@@ -861,7 +889,7 @@ void OPM_WriteString (CHAR *s, LONGINT s__len)
Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}
-void OPM_WriteStringVar (CHAR *s, LONGINT s__len)
+void OPM_WriteStringVar (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@@ -875,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);
@@ -893,7 +921,7 @@ void OPM_WriteHex (INT64 i)
void OPM_WriteInt (INT64 i)
{
- CHAR s[24];
+ CHAR s[26];
INT64 i1, k;
if ((i == OPM_SignedMinimum(2) || i == OPM_SignedMinimum(4)) || i == OPM_SignedMinimum(8)) {
OPM_Write('(');
@@ -901,21 +929,27 @@ void OPM_WriteInt (INT64 i)
OPM_WriteString((CHAR*)"-1)", 4);
} else {
i1 = __ABS(i);
- s[0] = (CHAR)(__MOD(i1, 10) + 48);
+ if (i1 <= 2147483647) {
+ k = 0;
+ } else {
+ __MOVE("LL", s, 3);
+ k = 2;
+ }
+ s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
- k = 1;
+ k += 1;
while (i1 > 0) {
- s[__X(k, 24)] = (CHAR)(__MOD(i1, 10) + 48);
+ s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k += 1;
}
if (i < 0) {
- s[__X(k, 24)] = '-';
+ s[__X(k, 26)] = '-';
k += 1;
}
while (k > 0) {
k -= 1;
- OPM_Write(s[__X(k, 24)]);
+ OPM_Write(s[__X(k, 26)]);
}
}
}
@@ -928,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') {
@@ -986,9 +1020,9 @@ static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F)
}
}
-void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
+void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len)
{
- CHAR FName[32];
+ OPM_FileName FName;
__COPY(moduleName, OPM_modName, 32);
OPM_HFile = Files_New((CHAR*)"", 1);
if (OPM_HFile != NIL) {
@@ -1014,7 +1048,7 @@ void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
void OPM_CloseFiles (void)
{
- CHAR FName[32];
+ OPM_FileName FName;
INT16 res;
if (OPM_noerr) {
OPM_LogWStr((CHAR*)" ", 3);
@@ -1050,6 +1084,59 @@ void OPM_CloseFiles (void)
Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, 0);
}
+static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len)
+{
+ CHAR testpath[4096];
+ Platform_FileIdentity identity;
+ __DUP(s, s__len, CHAR);
+ __COPY(OPM_InstallDir, testpath, 4096);
+ Strings_Append((CHAR*)"/lib/lib", 9, (void*)testpath, 4096);
+ Strings_Append((CHAR*)"voc", 4, (void*)testpath, 4096);
+ Strings_Append((CHAR*)"-O2.a", 6, (void*)testpath, 4096);
+ if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
+ __DEL(s);
+ return 0;
+ }
+ __COPY(OPM_InstallDir, testpath, 4096);
+ Strings_Append((CHAR*)"/2/include/Oberon.h", 20, (void*)testpath, 4096);
+ if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
+ __DEL(s);
+ return 0;
+ }
+ __COPY(OPM_InstallDir, testpath, 4096);
+ Strings_Append((CHAR*)"/2/sym/Files.sym", 17, (void*)testpath, 4096);
+ if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
+ __DEL(s);
+ return 0;
+ }
+ __DEL(s);
+ return 1;
+}
+
+static void OPM_FindInstallDir (void)
+{
+ INT16 i;
+ __COPY(Modules_BinaryDir, OPM_InstallDir, 1024);
+ Strings_Append((CHAR*)"/", 2, (void*)OPM_InstallDir, 1024);
+ Strings_Append((CHAR*)"voc", 4, (void*)OPM_InstallDir, 1024);
+ Strings_Append((CHAR*)".d", 3, (void*)OPM_InstallDir, 1024);
+ if (OPM_IsProbablyInstallDir(OPM_InstallDir, 1024)) {
+ return;
+ }
+ __COPY(Modules_BinaryDir, OPM_InstallDir, 1024);
+ i = Strings_Length(OPM_InstallDir, 1024);
+ while ((i > 0 && OPM_InstallDir[__X(i - 1, 1024)] != '/')) {
+ i -= 1;
+ }
+ if ((i > 0 && OPM_InstallDir[__X(i - 1, 1024)] == '/')) {
+ OPM_InstallDir[__X(i - 1, 1024)] = 0x00;
+ if (OPM_IsProbablyInstallDir(OPM_InstallDir, 1024)) {
+ return;
+ }
+ }
+ __COPY("", OPM_InstallDir, 1024);
+}
+
static void EnumPtrs(void (*P)(void*))
{
__ENUMR(&OPM_inR, Texts_Reader__typ, 48, 1, P);
@@ -1071,6 +1158,7 @@ export void *OPM__init(void)
__DEFMOD;
__MODULE_IMPORT(Configuration);
__MODULE_IMPORT(Files);
+ __MODULE_IMPORT(Modules);
__MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
@@ -1079,7 +1167,6 @@ export void *OPM__init(void)
__REGMOD("OPM", EnumPtrs);
__REGCMD("CloseFiles", OPM_CloseFiles);
__REGCMD("CloseOldSym", OPM_CloseOldSym);
- __REGCMD("DeleteNewSym", OPM_DeleteNewSym);
__REGCMD("InitOptions", OPM_InitOptions);
__REGCMD("LogWLn", OPM_LogWLn);
__REGCMD("RegisterNewSym", OPM_RegisterNewSym);
@@ -1089,5 +1176,8 @@ export void *OPM__init(void)
OPM_MaxLReal = 1.79769296342094e+308;
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 2d272feb..64c15a28 100644
--- a/bootstrap/windows-48/OPM.h
+++ b/bootstrap/windows-48/OPM.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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;
@@ -17,34 +17,39 @@ import INT32 OPM_curpos, OPM_errpos, OPM_breakpc;
import INT16 OPM_currFile, OPM_level, OPM_pc, OPM_entno;
import CHAR OPM_modName[32];
import CHAR OPM_objname[64];
+import CHAR OPM_InstallDir[1024];
import CHAR OPM_ResourceDir[1024];
import void OPM_CloseFiles (void);
import void OPM_CloseOldSym (void);
-import void OPM_DeleteNewSym (void);
+import void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
+import void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
import void OPM_FPrint (INT32 *fp, INT64 val);
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_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
+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);
-import void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
+import void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len);
+import void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len);
import void OPM_LogW (CHAR ch);
import void OPM_LogWLn (void);
import void OPM_LogWNum (INT64 i, INT64 len);
-import void OPM_LogWStr (CHAR *s, LONGINT s__len);
+import void OPM_LogWStr (CHAR *s, ADDRESS s__len);
import INT32 OPM_Longint (INT64 n);
import void OPM_Mark (INT16 n, INT32 pos);
-import void OPM_NewSym (CHAR *modName, LONGINT modName__len);
-import void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
-import void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
+import void OPM_NewSym (CHAR *modName, ADDRESS modName__len);
+import void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done);
+import void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len);
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);
@@ -61,8 +66,8 @@ import void OPM_WriteHex (INT64 i);
import void OPM_WriteInt (INT64 i);
import void OPM_WriteLn (void);
import void OPM_WriteReal (LONGREAL r, CHAR suffx);
-import void OPM_WriteString (CHAR *s, LONGINT s__len);
-import void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
+import void OPM_WriteString (CHAR *s, ADDRESS s__len);
+import void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
import BOOLEAN OPM_eofSF (void);
import void OPM_err (INT16 n);
import void *OPM__init(void);
diff --git a/bootstrap/windows-48/OPP.c b/bootstrap/windows-48/OPP.c
index 3f360d00..ad4a370a 100644
--- a/bootstrap/windows-48/OPP.c
+++ b/bootstrap/windows-48/OPP.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -527,7 +527,7 @@ static void OPP_selector (OPT_Node *x)
} else if (OPP_sym == 18) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
- __COPY(OPS_name, name, 256);
+ __MOVE(OPS_name, name, 256);
OPS_Get(&OPP_sym);
if ((*x)->typ != NIL) {
if ((*x)->typ->form == 11) {
@@ -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);
@@ -867,7 +867,7 @@ static void OPP_Receiver (INT8 *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct
} else {
*mode = 1;
}
- __COPY(OPS_name, name, 256);
+ __MOVE(OPS_name, name, 256);
OPP_CheckSym(38);
OPP_CheckSym(20);
if (OPP_sym == 38) {
@@ -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;
}
}
@@ -1030,7 +1030,7 @@ static void TProcDecl__23 (void)
}
OPP_Receiver(&objMode, objName, &objTyp, &recTyp);
if (OPP_sym == 38) {
- __COPY(OPS_name, *ProcedureDeclaration__16_s->name, 256);
+ __MOVE(OPS_name, *ProcedureDeclaration__16_s->name, 256);
OPP_CheckMark(&*ProcedureDeclaration__16_s->vis);
OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp, &*ProcedureDeclaration__16_s->fwd);
OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp->BaseTyp, &baseProc);
@@ -1129,7 +1129,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
TProcDecl__23();
} else if (OPP_sym == 38) {
OPT_Find(&fwd);
- __COPY(OPS_name, name, 256);
+ __MOVE(OPS_name, name, 256);
OPP_CheckMark(&vis);
if ((vis != 0 && mode == 6)) {
mode = 7;
@@ -1665,6 +1665,9 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
obj->typ = OPT_undftyp;
OPP_CheckMark(&obj->vis);
if (OPP_sym == 9) {
+ if (((((((((__STRCMP(obj->name, "SHORTINT") == 0 || __STRCMP(obj->name, "INTEGER") == 0) || __STRCMP(obj->name, "LONGINT") == 0) || __STRCMP(obj->name, "HUGEINT") == 0) || __STRCMP(obj->name, "REAL") == 0) || __STRCMP(obj->name, "LONGREAL") == 0) || __STRCMP(obj->name, "SET") == 0) || __STRCMP(obj->name, "CHAR") == 0) || __STRCMP(obj->name, "TRUE") == 0) || __STRCMP(obj->name, "FALSE") == 0) {
+ OPM_Mark(-310, OPM_curpos);
+ }
OPS_Get(&OPP_sym);
OPP_TypeDecl(&obj->typ, &obj->typ);
} else if (OPP_sym == 34 || OPP_sym == 20) {
@@ -1790,30 +1793,10 @@ void OPP_Module (OPT_Node *prog, UINT32 opt)
if (OPP_sym == 63) {
OPS_Get(&OPP_sym);
} else {
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Unexpected symbol found when MODULE expected:", 46);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" sym: ", 15);
- OPM_LogWNum(OPP_sym, 1);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.name: ", 15);
- OPM_LogWStr(OPS_name, 256);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.str: ", 15);
- OPM_LogWStr(OPS_str, 256);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.numtyp: ", 15);
- OPM_LogWNum(OPS_numtyp, 1);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.intval: ", 15);
- OPM_LogWNum(OPS_intval, 1);
- OPM_LogWLn();
OPP_err(16);
}
if (OPP_sym == 38) {
- OPM_LogWStr((CHAR*)"compiling ", 11);
- OPM_LogWStr(OPS_name, 256);
- OPM_LogW('.');
+ OPM_LogCompiling(OPS_name, 256);
OPT_Init(OPS_name, opt);
OPS_Get(&OPP_sym);
OPP_CheckSym(39);
diff --git a/bootstrap/windows-48/OPP.h b/bootstrap/windows-48/OPP.h
index 5a71eb39..3d8cefe8 100644
--- a/bootstrap/windows-48/OPP.h
+++ b/bootstrap/windows-48/OPP.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 6ee700e5..a25a2c12 100644
--- a/bootstrap/windows-48/OPS.c
+++ b/bootstrap/windows-48/OPS.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,9 +196,9 @@ 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(9223372036854775807 - (INT64)d, 10)) {
+ if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) {
OPS_intval = OPS_intval * 10 + (INT64)d;
} else {
OPS_err(203);
@@ -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 1f7a3e58..19e222ac 100644
--- a/bootstrap/windows-48/OPS.h
+++ b/bootstrap/windows-48/OPS.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 75820a95..ebb47dd8 100644
--- a/bootstrap/windows-48/OPT.c
+++ b/bootstrap/windows-48/OPT.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -49,6 +49,15 @@ typedef
INT8 glbmno[64];
} OPT_ImpCtxt;
+typedef
+ struct OPT_LinkDesc *OPT_Link;
+
+typedef
+ struct OPT_LinkDesc {
+ OPS_Name name;
+ OPT_Link next;
+ } OPT_LinkDesc;
+
typedef
struct OPT_NodeDesc *OPT_Node;
@@ -74,6 +83,7 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
+ OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@@ -101,6 +111,7 @@ static OPT_ExpCtxt OPT_expCtxt;
static INT32 OPT_nofhdfld;
static BOOLEAN OPT_newsf, OPT_findpc, OPT_extsf, OPT_sfpresent, OPT_symExtended, OPT_symNew;
static INT32 OPT_recno;
+export OPT_Link OPT_Links;
export ADDRESS *OPT_ConstDesc__typ;
export ADDRESS *OPT_ObjDesc__typ;
@@ -108,6 +119,7 @@ export ADDRESS *OPT_StrDesc__typ;
export ADDRESS *OPT_NodeDesc__typ;
export ADDRESS *OPT_ImpCtxt__typ;
export ADDRESS *OPT_ExpCtxt__typ;
+export ADDRESS *OPT_LinkDesc__typ;
export void OPT_Align (INT32 *adr, INT32 base);
export INT32 OPT_BaseAlignment (OPT_Struct typ);
@@ -120,7 +132,7 @@ static void OPT_EnterTyp (OPS_Name name, INT8 form, INT16 size, OPT_Struct *res)
static void OPT_EnterTypeAlias (OPS_Name name, OPT_Object *res);
export void OPT_Export (BOOLEAN *ext, BOOLEAN *new);
export void OPT_FPrintErr (OPT_Object obj, INT16 errcode);
-static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len);
+static void OPT_FPrintName (INT32 *fp, CHAR *name, ADDRESS name__len);
export void OPT_FPrintObj (OPT_Object obj);
static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par);
export void OPT_FPrintStr (OPT_Struct typ);
@@ -131,8 +143,9 @@ export void OPT_IdFPrint (OPT_Struct typ);
export void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
static void OPT_InConstant (INT32 f, OPT_Const conval);
static OPT_Object OPT_InFld (void);
+static void OPT_InLinks (void);
static void OPT_InMod (INT8 *mno);
-static void OPT_InName (CHAR *name, LONGINT name__len);
+static void OPT_InName (CHAR *name, ADDRESS name__len);
static OPT_Object OPT_InObj (INT8 mno);
static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par);
static void OPT_InStruct (OPT_Struct *typ);
@@ -154,12 +167,14 @@ export void OPT_OpenScope (INT8 level, OPT_Object owner);
static void OPT_OutConstant (OPT_Object obj);
static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible);
static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr);
+static void OPT_OutLinks (void);
static void OPT_OutMod (INT16 mno);
-static void OPT_OutName (CHAR *name, LONGINT name__len);
+static void OPT_OutName (CHAR *name, ADDRESS name__len);
static void OPT_OutObj (OPT_Object obj);
static void OPT_OutSign (OPT_Struct result, OPT_Object par);
static void OPT_OutStr (OPT_Struct typ);
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj);
+static void OPT_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);
@@ -339,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;
@@ -375,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;
}
@@ -434,14 +453,16 @@ void OPT_Init (OPS_Name name, UINT32 opt)
OPT_topScope = OPT_universe;
OPT_OpenScope(0, NIL);
OPT_SYSimported = 0;
- __COPY(name, OPT_SelfName, 256);
- __COPY(name, OPT_topScope->name, 256);
+ __MOVE(name, OPT_SelfName, 256);
+ __MOVE(name, OPT_topScope->name, 256);
OPT_GlbMod[0] = OPT_topScope;
OPT_nofGmod = 1;
OPT_newsf = __IN(4, opt, 32);
OPT_findpc = __IN(8, opt, 32);
OPT_extsf = OPT_newsf || __IN(9, opt, 32);
OPT_sfpresent = 1;
+ __NEW(OPT_Links, OPT_LinkDesc);
+ __MOVE(name, OPT_Links->name, 256);
}
void OPT_Close (void)
@@ -539,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;
@@ -570,13 +593,23 @@ 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;
}
}
*obj = ob1;
}
-static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len)
+static void OPT_FPrintName (INT32 *fp, CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@@ -957,7 +990,7 @@ void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old)
}
}
-static void OPT_InName (CHAR *name, LONGINT name__len)
+static void OPT_InName (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@@ -1011,6 +1044,26 @@ static void OPT_InMod (INT8 *mno)
}
}
+static void OPT_InLinks (void)
+{
+ OPS_Name linkname;
+ OPT_Link l = NIL;
+ OPT_InName((void*)linkname, 256);
+ while (linkname[0] != 0x00) {
+ l = OPT_Links;
+ while ((l != NIL && __STRCMP(l->name, linkname) != 0)) {
+ l = l->next;
+ }
+ if (l == NIL) {
+ l = OPT_Links;
+ __NEW(OPT_Links, OPT_LinkDesc);
+ OPT_Links->next = l;
+ __MOVE(linkname, OPT_Links->name, 256);
+ }
+ OPT_InName((void*)linkname, 256);
+ }
+}
+
static void OPT_InConstant (INT32 f, OPT_Const conval)
{
CHAR ch;
@@ -1068,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) {
@@ -1186,7 +1246,7 @@ static void OPT_InStruct (OPT_Struct *typ)
}
*typ = OPT_NewStr(0, 1);
} else {
- __COPY(name, obj->name, 256);
+ __MOVE(name, obj->name, 256);
OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
if (old != NIL) {
OPT_FPrintObj(old);
@@ -1216,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) {
@@ -1346,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;
@@ -1362,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);
@@ -1377,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)]);
@@ -1389,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);
@@ -1458,9 +1565,15 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
OPT_impCtxt.nofm = 0;
OPT_impCtxt.self = __STRCMP(aliasName, "@self") == 0;
OPT_impCtxt.reffp = 0;
- OPM_OldSym((void*)name, 256, &*done);
+ if ((OPT_impCtxt.self && __IN(17, OPM_Options, 32))) {
+ OPM_DeleteSym((void*)name, 256);
+ *done = 0;
+ } else {
+ OPM_OldSym((void*)name, 256, &*done);
+ }
if (*done) {
OPT_InMod(&mno);
+ OPT_InLinks();
OPT_impCtxt.nextTag = OPM_SymRInt();
while (!OPM_eofSF()) {
obj = OPT_InObj(mno);
@@ -1483,7 +1596,7 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
}
}
-static void OPT_OutName (CHAR *name, LONGINT name__len)
+static void OPT_OutName (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@@ -1507,6 +1620,17 @@ static void OPT_OutMod (INT16 mno)
}
}
+static void OPT_OutLinks (void)
+{
+ OPT_Link l = NIL;
+ l = OPT_Links;
+ while (l != NIL) {
+ OPT_OutName((void*)l->name, 256);
+ l = l->next;
+ }
+ OPM_SymWCh(0x00);
+}
+
static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr)
{
INT32 i, j, n;
@@ -1700,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);
@@ -1728,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) {
@@ -1833,6 +1984,7 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
if (OPM_noerr) {
OPM_SymWInt(16);
OPT_OutName((void*)OPT_SelfName, 256);
+ OPT_OutLinks();
OPT_expCtxt.reffp = 0;
OPT_expCtxt.ref = 14;
OPT_expCtxt.nofm = 1;
@@ -1854,7 +2006,7 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
OPT_newsf = 0;
OPT_symNew = 0;
if (!OPM_noerr || OPT_findpc) {
- OPM_DeleteNewSym();
+ OPM_DeleteSym((void*)OPT_SelfName, 256);
}
}
}
@@ -1969,10 +2121,11 @@ static void EnumPtrs(void (*P)(void*))
P(OPT_universe);
P(OPT_syslink);
__ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 3140, 1, P);
+ P(OPT_Links);
}
__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,
@@ -2008,6 +2161,7 @@ __TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 3140), {16, 20, 24, 28, 32,
1936, 1940, 1944, 1948, 1952, 1956, 1960, 1964, 1968, 1972, 1976, 1980, 1984, 1988, 1992, 1996,
2000, 2004, 2008, 2012, 2016, 2020, 2024, 2028, 2032, 2036, 2040, 2044, 2048, 2052, -2044}};
__TDESC(OPT_ExpCtxt, 1, 0) = {__TDFLDS("ExpCtxt", 72), {-4}};
+__TDESC(OPT_LinkDesc, 1, 1) = {__TDFLDS("LinkDesc", 260), {256, -8}};
export void *OPT__init(void)
{
@@ -2024,6 +2178,7 @@ export void *OPT__init(void)
__INITYP(OPT_NodeDesc, OPT_NodeDesc, 0);
__INITYP(OPT_ImpCtxt, OPT_ImpCtxt, 0);
__INITYP(OPT_ExpCtxt, OPT_ExpCtxt, 0);
+ __INITYP(OPT_LinkDesc, OPT_LinkDesc, 0);
/* BEGIN */
OPT_topScope = NIL;
OPT_OpenScope(0, NIL);
diff --git a/bootstrap/windows-48/OPT.h b/bootstrap/windows-48/OPT.h
index 90fcacf5..cf456af5 100644
--- a/bootstrap/windows-48/OPT.h
+++ b/bootstrap/windows-48/OPT.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -21,6 +21,15 @@ typedef
LONGREAL realval;
} OPT_ConstDesc;
+typedef
+ struct OPT_LinkDesc *OPT_Link;
+
+typedef
+ struct OPT_LinkDesc {
+ OPS_Name name;
+ OPT_Link next;
+ } OPT_LinkDesc;
+
typedef
struct OPT_NodeDesc *OPT_Node;
@@ -52,6 +61,7 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
+ OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@@ -75,11 +85,13 @@ import INT8 OPT_nofGmod;
import OPT_Object OPT_GlbMod[64];
import OPS_Name OPT_SelfName;
import BOOLEAN OPT_SYSimported;
+import OPT_Link OPT_Links;
import ADDRESS *OPT_ConstDesc__typ;
import ADDRESS *OPT_ObjDesc__typ;
import ADDRESS *OPT_StrDesc__typ;
import ADDRESS *OPT_NodeDesc__typ;
+import ADDRESS *OPT_LinkDesc__typ;
import void OPT_Align (INT32 *adr, INT32 base);
import INT32 OPT_BaseAlignment (OPT_Struct typ);
diff --git a/bootstrap/windows-48/OPV.c b/bootstrap/windows-48/OPV.c
index 5c21cb97..0425b2e0 100644
--- a/bootstrap/windows-48/OPV.c
+++ b/bootstrap/windows-48/OPV.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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));
@@ -163,7 +163,7 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
}
scope = obj->scope;
scope->leaf = 1;
- __COPY(obj->name, scope->name, 256);
+ __MOVE(obj->name, scope->name, 256);
OPV_Stamp(scope->name);
if (mode == 9) {
obj->adr = 1;
@@ -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);
@@ -1286,7 +1297,17 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPM_WriteString((CHAR*)", ", 3);
if (r->typ == OPT_stringtyp) {
OPM_WriteInt(r->conval->intval2);
+ } else if (r->typ->comp == 3) {
+ OPM_WriteString((CHAR*)"__X(", 5);
+ OPC_Len(r->obj, r->typ, 0);
+ OPM_WriteString((CHAR*)" * ", 4);
+ OPM_WriteInt(r->typ->BaseTyp->size);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteInt(l->typ->size + 1);
+ OPM_Write(')');
} else {
+ __ASSERT(r->typ->comp == 2, 0);
+ __ASSERT(r->typ->size <= l->typ->size, 0);
OPM_WriteInt(r->typ->size);
}
OPM_Write(')');
diff --git a/bootstrap/windows-48/OPV.h b/bootstrap/windows-48/OPV.h
index c4a61586..fbabd8f4 100644
--- a/bootstrap/windows-48/OPV.h
+++ b/bootstrap/windows-48/OPV.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 720267fd..b43e55f1 100644
--- a/bootstrap/windows-48/Out.c
+++ b/bootstrap/windows-48/Out.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 "Heap.h"
#include "Platform.h"
@@ -16,17 +17,18 @@ static INT16 Out_in;
export void Out_Char (CHAR ch);
export void Out_Flush (void);
+export void Out_Hex (INT64 x, INT64 n);
export void Out_Int (INT64 x, INT64 n);
-static INT32 Out_Length (CHAR *s, LONGINT s__len);
+static INT32 Out_Length (CHAR *s, ADDRESS s__len);
export void Out_Ln (void);
export void Out_LongReal (LONGREAL x, INT16 n);
export void Out_Open (void);
export void Out_Real (REAL x, INT16 n);
static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_);
-export void Out_String (CHAR *str, LONGINT str__len);
+export void Out_String (CHAR *str, ADDRESS str__len);
export LONGREAL Out_Ten (INT16 e);
-static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i);
-static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i);
+static void Out_digit (INT64 n, CHAR *s, ADDRESS s__len, INT16 *i);
+static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i);
#define Out_Entier64(x) (INT64)(x)
@@ -55,7 +57,7 @@ void Out_Char (CHAR ch)
}
}
-static INT32 Out_Length (CHAR *s, LONGINT s__len)
+static INT32 Out_Length (CHAR *s, ADDRESS s__len)
{
INT32 l;
l = 0;
@@ -65,7 +67,7 @@ static INT32 Out_Length (CHAR *s, LONGINT s__len)
return l;
}
-void Out_String (CHAR *str, LONGINT str__len)
+void Out_String (CHAR *str, ADDRESS str__len)
{
INT32 l;
INT16 error;
@@ -78,7 +80,7 @@ void Out_String (CHAR *str, LONGINT 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);
}
@@ -89,18 +91,18 @@ void Out_Int (INT64 x, INT64 n)
INT16 i;
BOOLEAN negative;
negative = x < 0;
- if (x == (-9223372036854775807-1)) {
+ if (x == (-9223372036854775807LL-1)) {
__MOVE("8085774586302733229", s, 20);
i = 19;
} else {
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;
}
@@ -119,19 +121,43 @@ void Out_Int (INT64 x, INT64 n)
}
}
+void Out_Hex (INT64 x, INT64 n)
+{
+ if (n < 1) {
+ n = 1;
+ } else if (n > 16) {
+ n = 16;
+ }
+ if (x >= 0) {
+ while ((n < 16 && __LSH(x, -__ASHL(n, 2), 64) != 0)) {
+ n += 1;
+ }
+ }
+ x = __ROT(x, __ASHL(16 - n, 2), 64);
+ while (n > 0) {
+ x = __ROTL(x, 4, 64);
+ n -= 1;
+ if (__MASK(x, -16) < 10) {
+ Out_Char(__CHR(__MASK(x, -16) + 48));
+ } else {
+ Out_Char(__CHR((__MASK(x, -16) - 10) + 65));
+ }
+ }
+}
+
void Out_Ln (void)
{
Out_String(Platform_NL, 3);
Out_Flush();
}
-static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i)
+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, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i)
+static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i)
{
INT16 j;
INT32 l;
@@ -140,7 +166,7 @@ static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT 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)];
@@ -175,7 +201,7 @@ static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_)
INT64 m;
INT16 d, dr;
e = (INT16)__MASK(__ASHR((__VAL(INT64, x)), 52), -2048);
- f = __MASK((__VAL(INT64, x)), -4503599627370496);
+ f = __MASK((__VAL(INT64, x)), -4503599627370496LL);
nn = (__VAL(INT64, x) < 0 && !((e == 2047 && f != 0)));
if (nn) {
n -= 1;
@@ -222,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 {
@@ -306,6 +332,7 @@ void Out_LongReal (LONGREAL x, INT16 n)
export void *Out__init(void)
{
__DEFMOD;
+ __MODULE_IMPORT(Heap);
__MODULE_IMPORT(Platform);
__REGMOD("Out", 0);
__REGCMD("Flush", Out_Flush);
diff --git a/bootstrap/windows-48/Out.h b/bootstrap/windows-48/Out.h
index 0e66420d..a72547f4 100644
--- a/bootstrap/windows-48/Out.h
+++ b/bootstrap/windows-48/Out.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -11,12 +11,13 @@ import BOOLEAN Out_IsConsole;
import void Out_Char (CHAR ch);
import void Out_Flush (void);
+import void Out_Hex (INT64 x, INT64 n);
import void Out_Int (INT64 x, INT64 n);
import void Out_Ln (void);
import void Out_LongReal (LONGREAL x, INT16 n);
import void Out_Open (void);
import void Out_Real (REAL x, INT16 n);
-import void Out_String (CHAR *str, LONGINT str__len);
+import void Out_String (CHAR *str, ADDRESS str__len);
import LONGREAL Out_Ten (INT16 e);
import void *Out__init(void);
diff --git a/bootstrap/windows-48/Platform.c b/bootstrap/windows-48/Platform.c
index 5a57f076..9b1f0e4f 100644
--- a/bootstrap/windows-48/Platform.c
+++ b/bootstrap/windows-48/Platform.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,49 +7,27 @@
#include "SYSTEM.h"
-typedef
- CHAR (*Platform_ArgPtr)[1024];
-
-typedef
- Platform_ArgPtr (*Platform_ArgVec)[1024];
-
-typedef
- INT32 (*Platform_ArgVecPtr)[1];
-
-typedef
- CHAR (*Platform_EnvPtr)[1024];
-
typedef
struct Platform_FileIdentity {
INT32 volume, indexhigh, indexlow, mtimehigh, mtimelow;
} Platform_FileIdentity;
-typedef
- void (*Platform_HaltProcedure)(INT32);
-
typedef
void (*Platform_SignalHandler)(INT32);
export BOOLEAN Platform_LittleEndian;
-export INT32 Platform_MainStackFrame;
-export INT32 Platform_HaltCode;
export INT16 Platform_PID;
export CHAR Platform_CWD[4096];
-export INT16 Platform_ArgCount;
-export INT32 Platform_ArgVector;
-static Platform_HaltProcedure Platform_HaltHandler;
static INT32 Platform_TimeStart;
export INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
export INT32 Platform_StdIn, Platform_StdOut, Platform_StdErr;
-static Platform_SignalHandler Platform_InterruptHandler;
export CHAR Platform_NL[3];
export ADDRESS *Platform_FileIdentity__typ;
export BOOLEAN Platform_Absent (INT16 e);
-export INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
-export INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
+export INT16 Platform_Chdir (CHAR *n, ADDRESS n__len);
export INT16 Platform_Close (INT32 h);
export BOOLEAN Platform_ConnectionFailed (INT16 e);
export void Platform_Delay (INT32 ms);
@@ -57,27 +35,26 @@ export BOOLEAN Platform_DifferentFilesystems (INT16 e);
static void Platform_EnableVT100 (void);
export INT16 Platform_Error (void);
export void Platform_Exit (INT32 code);
-export void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
export void Platform_GetClock (INT32 *t, INT32 *d);
-export void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
-export void Platform_GetIntArg (INT16 n, INT32 *val);
+export void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
export void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec);
export INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *identity__typ);
-export INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
+export INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
export BOOLEAN Platform_Inaccessible (INT16 e);
-export void Platform_Init (INT32 argc, INT32 argvadr);
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_New (CHAR *n, LONGINT n__len, INT32 *h);
+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);
export void Platform_OSFree (INT32 address);
-export INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h);
-export INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h);
+export INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h);
+export INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h);
export INT16 Platform_Read (INT32 h, INT32 p, INT32 l, INT32 *n);
-export INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n);
-export INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
+export INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n);
+export INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len);
export BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2);
export BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2);
export INT16 Platform_Seek (INT32 h, INT32 o, INT16 r);
@@ -85,16 +62,16 @@ export void Platform_SetBadInstructionHandler (Platform_SignalHandler handler);
export void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__typ, Platform_FileIdentity source);
export INT16 Platform_Size (INT32 h, INT32 *l);
export INT16 Platform_Sync (INT32 h);
-export INT16 Platform_System (CHAR *cmd, LONGINT cmd__len);
+export INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len);
static void Platform_TestLittleEndian (void);
export INT32 Platform_Time (void);
export BOOLEAN Platform_TimedOut (INT16 e);
export BOOLEAN Platform_TooManyFiles (INT16 e);
export INT16 Platform_Truncate (INT32 h, INT32 limit);
-export INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
+export INT16 Platform_Unlink (CHAR *n, ADDRESS n__len);
export INT16 Platform_Write (INT32 h, INT32 p, INT32 l);
static void Platform_YMDHMStoClock (INT16 ye, INT16 mo, INT16 da, INT16 ho, INT16 mi, INT16 se, INT32 *t, INT32 *d);
-export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
+export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
#include "WindowsWrapper.h"
#define Platform_ECONNABORTED() WSAECONNABORTED
@@ -111,10 +88,9 @@ export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT
#define Platform_ERRORTOOMANYOPENFILES() ERROR_TOO_MANY_OPEN_FILES
#define Platform_ERRORWRITEPROTECT() ERROR_WRITE_PROTECT
#define Platform_ETIMEDOUT() WSAETIMEDOUT
-extern void Heap_InitHeap();
#define Platform_GetConsoleMode(h, m) GetConsoleMode((HANDLE)h, (DWORD*)m)
#define Platform_GetTickCount() (LONGINT)(UINT32)GetTickCount()
-#define Platform_HeapInitHeap() Heap_InitHeap()
+#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)
@@ -151,9 +127,9 @@ extern void Heap_InitHeap();
#define Platform_largeInteger() LARGE_INTEGER li
#define Platform_liLongint() (LONGINT)li.QuadPart
#define Platform_moveFile(o, o__len, n, n__len) (INTEGER)MoveFileEx((char*)o, (char*)n, MOVEFILE_REPLACE_EXISTING)
-#define Platform_opennew(n, n__len) (ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
-#define Platform_openro(n, n__len) (ADDRESS)CreateFile((char*)n, GENERIC_READ , FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
-#define Platform_openrw(n, n__len) (ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
+#define Platform_opennew(n, n__len) (ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE|FILE_SHARE_DELETE, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
+#define Platform_openro(n, n__len) (ADDRESS)CreateFile((char*)n, GENERIC_READ , FILE_SHARE_READ|FILE_SHARE_WRITE|FILE_SHARE_DELETE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
+#define Platform_openrw(n, n__len) (ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE|FILE_SHARE_DELETE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
#define Platform_processInfo() PROCESS_INFORMATION pi = {0};
#define Platform_readfile(fd, p, l, n) (INTEGER)ReadFile((HANDLE)fd, (void*)p, (DWORD)l, (DWORD*)n, 0)
#define Platform_seekcur() FILE_CURRENT
@@ -218,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);
@@ -228,18 +214,7 @@ void Platform_OSFree (INT32 address)
Platform_free(address);
}
-void Platform_Init (INT32 argc, INT32 argvadr)
-{
- Platform_ArgVecPtr av = NIL;
- Platform_MainStackFrame = argvadr;
- Platform_ArgCount = __VAL(INT16, argc);
- av = (Platform_ArgVecPtr)(ADDRESS)argvadr;
- Platform_ArgVector = (*av)[0];
- Platform_HaltCode = -128;
- Platform_HeapInitHeap();
-}
-
-BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
+BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{
CHAR buf[4096];
INT16 res;
@@ -256,7 +231,7 @@ BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__le
__RETCHK;
}
-void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
+void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{
__DUP(var, var__len, CHAR);
if (!Platform_getEnv(var, var__len, (void*)val, val__len)) {
@@ -265,56 +240,6 @@ void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
__DEL(var);
}
-void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len)
-{
- Platform_ArgVec av = NIL;
- if (n < Platform_ArgCount) {
- av = (Platform_ArgVec)(ADDRESS)Platform_ArgVector;
- __COPY(*(*av)[__X(n, 1024)], val, val__len);
- }
-}
-
-void Platform_GetIntArg (INT16 n, INT32 *val)
-{
- CHAR s[64];
- INT32 k, d, i;
- s[0] = 0x00;
- Platform_GetArg(n, (void*)s, 64);
- i = 0;
- if (s[0] == '-') {
- i = 1;
- }
- k = 0;
- d = (INT16)s[__X(i, 64)] - 48;
- while ((d >= 0 && d <= 9)) {
- k = k * 10 + d;
- i += 1;
- d = (INT16)s[__X(i, 64)] - 48;
- }
- if (s[0] == '-') {
- k = -k;
- i -= 1;
- }
- if (i > 0) {
- *val = k;
- }
-}
-
-INT16 Platform_ArgPos (CHAR *s, LONGINT s__len)
-{
- INT16 i;
- CHAR arg[256];
- __DUP(s, s__len, CHAR);
- i = 0;
- Platform_GetArg(i, (void*)arg, 256);
- while ((i < Platform_ArgCount && __STRCMP(s, arg) != 0)) {
- i += 1;
- Platform_GetArg(i, (void*)arg, 256);
- }
- __DEL(s);
- return i;
-}
-
void Platform_SetBadInstructionHandler (Platform_SignalHandler handler)
{
}
@@ -359,7 +284,7 @@ void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec)
*usec = Platform_uluSec();
}
-INT16 Platform_System (CHAR *cmd, LONGINT cmd__len)
+INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len)
{
INT16 result;
__DUP(cmd, cmd__len, CHAR);
@@ -381,7 +306,7 @@ INT16 Platform_Error (void)
return Platform_err();
}
-INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h)
+INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h)
{
INT32 fd;
fd = Platform_openro(n, n__len);
@@ -394,7 +319,7 @@ INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h)
__RETCHK;
}
-INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h)
+INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h)
{
INT32 fd;
fd = Platform_openrw(n, n__len);
@@ -407,7 +332,7 @@ INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h)
__RETCHK;
}
-INT16 Platform_New (CHAR *n, LONGINT n__len, INT32 *h)
+INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h)
{
INT32 fd;
fd = Platform_opennew(n, n__len);
@@ -444,7 +369,7 @@ INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *iden
return 0;
}
-INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
+INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{
INT32 h;
INT16 e, i;
@@ -508,7 +433,7 @@ INT16 Platform_Read (INT32 h, INT32 p, INT32 l, INT32 *n)
__RETCHK;
}
-INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n)
+INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n)
{
INT16 result;
INT32 lengthread;
@@ -580,7 +505,7 @@ INT16 Platform_Truncate (INT32 h, INT32 limit)
return 0;
}
-INT16 Platform_Unlink (CHAR *n, LONGINT n__len)
+INT16 Platform_Unlink (CHAR *n, ADDRESS n__len)
{
if (Platform_deleteFile(n, n__len) == 0) {
return Platform_err();
@@ -590,7 +515,7 @@ INT16 Platform_Unlink (CHAR *n, LONGINT n__len)
__RETCHK;
}
-INT16 Platform_Chdir (CHAR *n, LONGINT n__len)
+INT16 Platform_Chdir (CHAR *n, ADDRESS n__len)
{
INT16 r;
r = Platform_setCurrentDirectory(n, n__len);
@@ -601,7 +526,7 @@ INT16 Platform_Chdir (CHAR *n, LONGINT n__len)
return 0;
}
-INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len)
+INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len)
{
if (Platform_moveFile(o, o__len, n, n__len) == 0) {
return Platform_err();
@@ -646,8 +571,6 @@ export void *Platform__init(void)
__INITYP(Platform_FileIdentity, Platform_FileIdentity, 0);
/* BEGIN */
Platform_TestLittleEndian();
- Platform_HaltCode = -128;
- Platform_HaltHandler = NIL;
Platform_TimeStart = 0;
Platform_TimeStart = Platform_Time();
Platform_CWD[0] = 0x00;
diff --git a/bootstrap/windows-48/Platform.h b/bootstrap/windows-48/Platform.h
index f62a8ab8..b1ed4c6f 100644
--- a/bootstrap/windows-48/Platform.h
+++ b/bootstrap/windows-48/Platform.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -16,12 +16,8 @@ typedef
import BOOLEAN Platform_LittleEndian;
-import INT32 Platform_MainStackFrame;
-import INT32 Platform_HaltCode;
import INT16 Platform_PID;
import CHAR Platform_CWD[4096];
-import INT16 Platform_ArgCount;
-import INT32 Platform_ArgVector;
import INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
import INT32 Platform_StdIn, Platform_StdOut, Platform_StdErr;
import CHAR Platform_NL[3];
@@ -29,35 +25,33 @@ import CHAR Platform_NL[3];
import ADDRESS *Platform_FileIdentity__typ;
import BOOLEAN Platform_Absent (INT16 e);
-import INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
-import INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
+import INT16 Platform_Chdir (CHAR *n, ADDRESS n__len);
import INT16 Platform_Close (INT32 h);
import BOOLEAN Platform_ConnectionFailed (INT16 e);
import void Platform_Delay (INT32 ms);
import BOOLEAN Platform_DifferentFilesystems (INT16 e);
import INT16 Platform_Error (void);
import void Platform_Exit (INT32 code);
-import void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
import void Platform_GetClock (INT32 *t, INT32 *d);
-import void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
-import void Platform_GetIntArg (INT16 n, INT32 *val);
+import void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
import void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec);
import INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *identity__typ);
-import INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
+import INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
import BOOLEAN Platform_Inaccessible (INT16 e);
-import void Platform_Init (INT32 argc, INT32 argvadr);
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_New (CHAR *n, LONGINT n__len, INT32 *h);
+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);
import void Platform_OSFree (INT32 address);
-import INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h);
-import INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h);
+import INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h);
+import INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h);
import INT16 Platform_Read (INT32 h, INT32 p, INT32 l, INT32 *n);
-import INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n);
-import INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
+import INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n);
+import INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len);
import BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2);
import BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2);
import INT16 Platform_Seek (INT32 h, INT32 o, INT16 r);
@@ -65,14 +59,14 @@ import void Platform_SetBadInstructionHandler (Platform_SignalHandler handler);
import void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__typ, Platform_FileIdentity source);
import INT16 Platform_Size (INT32 h, INT32 *l);
import INT16 Platform_Sync (INT32 h);
-import INT16 Platform_System (CHAR *cmd, LONGINT cmd__len);
+import INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len);
import INT32 Platform_Time (void);
import BOOLEAN Platform_TimedOut (INT16 e);
import BOOLEAN Platform_TooManyFiles (INT16 e);
import INT16 Platform_Truncate (INT32 h, INT32 limit);
-import INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
+import INT16 Platform_Unlink (CHAR *n, ADDRESS n__len);
import INT16 Platform_Write (INT32 h, INT32 p, INT32 l);
-import BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
+import BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
import void *Platform__init(void);
#define Platform_SetInterruptHandler(h) SystemSetInterruptHandler((ADDRESS)h)
diff --git a/bootstrap/windows-48/Reals.c b/bootstrap/windows-48/Reals.c
index cd4c3c61..512ec2c4 100644
--- a/bootstrap/windows-48/Reals.c
+++ b/bootstrap/windows-48/Reals.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -10,11 +10,11 @@
-static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len);
-export void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len);
-export void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len);
-export void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len);
-export void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len);
+static void Reals_BytesToHex (SYSTEM_BYTE *b, ADDRESS b__len, SYSTEM_BYTE *d, ADDRESS d__len);
+export void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len);
+export void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len);
+export void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len);
+export void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len);
export INT16 Reals_Expo (REAL x);
export INT16 Reals_ExpoL (LONGREAL x);
export void Reals_SetExpo (REAL *x, INT16 ex);
@@ -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)
@@ -79,7 +79,7 @@ INT16 Reals_ExpoL (LONGREAL x)
return __MASK(__ASHR(i, 4), -2048);
}
-void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len)
+void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len)
{
INT32 i, j, k;
if (x < (LONGREAL)0) {
@@ -87,27 +87,27 @@ void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT 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;
}
}
-void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len)
+void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len)
{
Reals_ConvertL(x, n, (void*)d, d__len);
}
@@ -115,14 +115,14 @@ void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT 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;
}
-static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len)
+static void Reals_BytesToHex (SYSTEM_BYTE *b, ADDRESS b__len, SYSTEM_BYTE *d, ADDRESS d__len)
{
INT16 i;
INT32 l;
@@ -137,12 +137,12 @@ static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LO
}
}
-void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len)
+void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len)
{
Reals_BytesToHex((void*)&y, 4, (void*)d, d__len * 1);
}
-void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len)
+void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len)
{
Reals_BytesToHex((void*)&x, 8, (void*)d, d__len * 1);
}
diff --git a/bootstrap/windows-48/Reals.h b/bootstrap/windows-48/Reals.h
index f0c84ab1..93e7fa75 100644
--- a/bootstrap/windows-48/Reals.h
+++ b/bootstrap/windows-48/Reals.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -8,10 +8,10 @@
-import void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len);
-import void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len);
-import void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len);
-import void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len);
+import void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len);
+import void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len);
+import void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len);
+import void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len);
import INT16 Reals_Expo (REAL x);
import INT16 Reals_ExpoL (LONGREAL x);
import void Reals_SetExpo (REAL *x, INT16 ex);
diff --git a/bootstrap/windows-48/Strings.c b/bootstrap/windows-48/Strings.c
index b5707327..4b18812f 100644
--- a/bootstrap/windows-48/Strings.c
+++ b/bootstrap/windows-48/Strings.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,22 +6,25 @@
#define SET UINT32
#include "SYSTEM.h"
+#include "Reals.h"
-export void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
-export void Strings_Cap (CHAR *s, LONGINT s__len);
-export void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n);
-export void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len);
-export void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
-export INT16 Strings_Length (CHAR *s, LONGINT s__len);
-export BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len);
-export INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos);
-export void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
+export void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len);
+export void Strings_Cap (CHAR *s, ADDRESS s__len);
+export void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n);
+export void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len);
+export void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len);
+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, LONGINT s__len)
+INT16 Strings_Length (CHAR *s, ADDRESS s__len)
{
INT32 i;
__DUP(s, s__len, CHAR);
@@ -31,7 +34,7 @@ INT16 Strings_Length (CHAR *s, LONGINT s__len)
}
if (i <= 32767) {
__DEL(s);
- return (INT16)i;
+ return __SHORT(i, 32768);
} else {
__DEL(s);
return 32767;
@@ -39,7 +42,7 @@ INT16 Strings_Length (CHAR *s, LONGINT s__len)
__RETCHK;
}
-void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len)
+void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len)
{
INT16 n1, n2, i;
__DUP(extra, extra__len, CHAR);
@@ -56,7 +59,7 @@ void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__
__DEL(extra);
}
-void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
+void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
{
INT16 n1, n2, i;
__DUP(source, source__len, CHAR);
@@ -87,7 +90,7 @@ void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, L
__DEL(source);
}
-void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n)
+void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n)
{
INT16 len, i;
len = Strings_Length(s, s__len);
@@ -110,7 +113,7 @@ void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n)
}
}
-void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
+void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
{
__DUP(source, source__len, CHAR);
Strings_Delete((void*)dest, dest__len, pos, pos + Strings_Length(source, source__len));
@@ -118,12 +121,12 @@ void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest,
__DEL(source);
}
-void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len)
+void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len)
{
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;
}
@@ -143,7 +146,7 @@ void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHA
__DEL(source);
}
-INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos)
+INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos)
{
INT16 n1, n2, i, j;
__DUP(pattern, pattern__len, CHAR);
@@ -175,7 +178,7 @@ INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len,
return -1;
}
-void Strings_Cap (CHAR *s, LONGINT s__len)
+void Strings_Cap (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@@ -191,9 +194,9 @@ static struct Match__7 {
struct Match__7 *lnk;
} *Match__7_s;
-static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m);
+static BOOLEAN M__8 (CHAR *name, ADDRESS name__len, CHAR *mask, ADDRESS mask__len, INT16 n, INT16 m);
-static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m)
+static BOOLEAN M__8 (CHAR *name, ADDRESS name__len, CHAR *mask, ADDRESS mask__len, INT16 n, INT16 m)
{
while ((((n >= 0 && m >= 0)) && mask[__X(m, mask__len)] != '*')) {
if (name[__X(n, name__len)] != mask[__X(m, mask__len)]) {
@@ -220,7 +223,7 @@ static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__le
return 0;
}
-BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len)
+BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len)
{
struct Match__7 _s;
BOOLEAN __retval;
@@ -236,10 +239,135 @@ BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT
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 c987af8d..f0e3ae34 100644
--- a/bootstrap/windows-48/Strings.h
+++ b/bootstrap/windows-48/Strings.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -8,15 +8,17 @@
-import void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
-import void Strings_Cap (CHAR *s, LONGINT s__len);
-import void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n);
-import void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len);
-import void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
-import INT16 Strings_Length (CHAR *s, LONGINT s__len);
-import BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len);
-import INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos);
-import void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
+import void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len);
+import void Strings_Cap (CHAR *s, ADDRESS s__len);
+import void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n);
+import void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len);
+import void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len);
+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 ad26b1cb..43c3858f 100644
--- a/bootstrap/windows-48/Texts.c
+++ b/bootstrap/windows-48/Texts.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -187,20 +187,20 @@ export void Texts_Append (Texts_Text T, Texts_Buffer B);
export void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
static Texts_Elem Texts_CloneElem (Texts_Elem e);
static Texts_Piece Texts_ClonePiece (Texts_Piece p);
-export void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
+export void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len);
export void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
export void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
export void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
export Texts_Text Texts_ElemBase (Texts_Elem E);
export INT32 Texts_ElemPos (Texts_Elem E);
static void Texts_Find (Texts_Text T, INT32 *pos, Texts_Run *u, INT32 *org, INT32 *off);
-static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len);
+static Texts_FontsFont Texts_FontsThis (CHAR *name, ADDRESS name__len);
static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__typ);
export void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
export void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
static void Texts_Load0 (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v);
-export void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
+export void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len);
export void Texts_OpenBuf (Texts_Buffer B);
export void Texts_OpenReader (Texts_Reader *R, ADDRESS *R__typ, Texts_Text T, INT32 pos);
export void Texts_OpenScanner (Texts_Scanner *S, ADDRESS *S__typ, Texts_Text T, INT32 pos);
@@ -229,10 +229,10 @@ export void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x
export void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
export void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
export void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
-export void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
+export void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len);
-static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len)
+static Texts_FontsFont Texts_FontsThis (CHAR *name, ADDRESS name__len)
{
Texts_FontsFont F = NIL;
__NEW(F, Texts_FontDesc);
@@ -390,27 +390,27 @@ static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__t
if (__IS(msg__typ, Texts_CopyMsg, 1)) {
Texts_CopyMsg *msg__ = (void*)msg;
__NEW(e, Texts__1);
- Texts_CopyElem((void*)((Texts_Alien)E), (void*)e);
- e->file = ((Texts_Alien)E)->file;
- e->org = ((Texts_Alien)E)->org;
- e->span = ((Texts_Alien)E)->span;
- __COPY(((Texts_Alien)E)->mod, e->mod, 32);
- __COPY(((Texts_Alien)E)->proc, e->proc, 32);
+ Texts_CopyElem((void*)(*(Texts_Alien*)&E), (void*)e);
+ e->file = (*(Texts_Alien*)&E)->file;
+ e->org = (*(Texts_Alien*)&E)->org;
+ e->span = (*(Texts_Alien*)&E)->span;
+ __MOVE((*(Texts_Alien*)&E)->mod, e->mod, 32);
+ __MOVE((*(Texts_Alien*)&E)->proc, e->proc, 32);
(*msg__).e = (Texts_Elem)e;
} else __WITHCHK;
} else if (__IS(msg__typ, Texts_IdentifyMsg, 1)) {
if (__IS(msg__typ, Texts_IdentifyMsg, 1)) {
Texts_IdentifyMsg *msg__ = (void*)msg;
- __COPY(((Texts_Alien)E)->mod, (*msg__).mod, 32);
- __COPY(((Texts_Alien)E)->proc, (*msg__).proc, 32);
+ __COPY((*(Texts_Alien*)&E)->mod, (*msg__).mod, 32);
+ __COPY((*(Texts_Alien*)&E)->proc, (*msg__).proc, 32);
(*msg__).mod[31] = 0x01;
} else __WITHCHK;
} else if (__IS(msg__typ, Texts_FileMsg, 1)) {
if (__IS(msg__typ, Texts_FileMsg, 1)) {
Texts_FileMsg *msg__ = (void*)msg;
if ((*msg__).id == 1) {
- Files_Set(&r, Files_Rider__typ, ((Texts_Alien)E)->file, ((Texts_Alien)E)->org);
- i = ((Texts_Alien)E)->span;
+ Files_Set(&r, Files_Rider__typ, (*(Texts_Alien*)&E)->file, (*(Texts_Alien*)&E)->org);
+ i = (*(Texts_Alien*)&E)->span;
while (i > 0) {
Files_Read(&r, Files_Rider__typ, (void*)&ch);
Files_Write(&(*msg__).r, Files_Rider__typ, ch);
@@ -646,7 +646,7 @@ void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch)
u = u->next;
if (__ISP(u, Texts_PieceDesc, 1)) {
if (__ISP(u, Texts_PieceDesc, 1)) {
- Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
+ Files_Set(&(*R).rider, Files_Rider__typ, (*(Texts_Piece*)&u)->file, (*(Texts_Piece*)&u)->org);
} else __WITHCHK;
}
(*R).run = u;
@@ -673,7 +673,7 @@ void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ)
(*R).elem = __GUARDP(u, Texts_ElemDesc, 1);
if (__ISP(un, Texts_PieceDesc, 1)) {
if (__ISP(un, Texts_PieceDesc, 1)) {
- Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)un)->file, ((Texts_Piece)un)->org);
+ Files_Set(&(*R).rider, Files_Rider__typ, (*(Texts_Piece*)&un)->file, (*(Texts_Piece*)&un)->org);
} else __WITHCHK;
}
} else {
@@ -812,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;
}
@@ -1027,7 +1027,7 @@ void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ)
Texts_Write(&*W, W__typ, 0x0d);
}
-void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len)
+void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
@@ -1046,7 +1046,7 @@ void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n)
CHAR a[24];
i = 0;
if (x < 0) {
- if (x == (-9223372036854775807-1)) {
+ if (x == (-9223372036854775807LL-1)) {
Texts_WriteString(&*W, W__typ, (CHAR*)" -9223372036854775808", 22);
return;
} else {
@@ -1057,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));
@@ -1084,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;
@@ -1162,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));
}
}
@@ -1313,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 {
@@ -1344,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));
}
}
@@ -1374,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)
@@ -1406,8 +1406,8 @@ static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span
static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span, Texts_Elem *e)
{
- Modules_Module M = NIL;
- Modules_Command Cmd;
+ Heap_Module M = NIL;
+ Heap_Command Cmd;
Texts_Alien a = NIL;
INT32 org, ew, eh;
INT8 eno;
@@ -1539,7 +1539,7 @@ void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
Texts_Load0(&*r, r__typ, T);
}
-void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len)
+void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
Files_Rider r;
@@ -1715,9 +1715,9 @@ void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
while (u != T->head) {
if (__ISP(u, Texts_PieceDesc, 1)) {
if (__ISP(u, Texts_PieceDesc, 1)) {
- if (((Texts_Piece)u)->ascii) {
- Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
- delta = ((Texts_Piece)u)->len;
+ if ((*(Texts_Piece*)&u)->ascii) {
+ Files_Set(&r1, Files_Rider__typ, (*(Texts_Piece*)&u)->file, (*(Texts_Piece*)&u)->org);
+ delta = (*(Texts_Piece*)&u)->len;
while (delta > 0) {
Files_Read(&r1, Files_Rider__typ, (void*)&ch);
delta -= 1;
@@ -1728,8 +1728,8 @@ void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
}
}
} else {
- Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
- delta = ((Texts_Piece)u)->len;
+ Files_Set(&r1, Files_Rider__typ, (*(Texts_Piece*)&u)->file, (*(Texts_Piece*)&u)->org);
+ delta = (*(Texts_Piece*)&u)->len;
while (delta > 1024) {
Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, 1024, 1024);
Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, 1024, 1024);
@@ -1755,7 +1755,7 @@ void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
Store__39_s = _s.lnk;
}
-void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len)
+void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
Files_Rider r;
diff --git a/bootstrap/windows-48/Texts.h b/bootstrap/windows-48/Texts.h
index e2c03958..fd0c0fa5 100644
--- a/bootstrap/windows-48/Texts.h
+++ b/bootstrap/windows-48/Texts.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -131,7 +131,7 @@ import ADDRESS *Texts_Writer__typ;
import void Texts_Append (Texts_Text T, Texts_Buffer B);
import void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
-import void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
+import void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len);
import void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
import void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
import void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
@@ -139,7 +139,7 @@ import Texts_Text Texts_ElemBase (Texts_Elem E);
import INT32 Texts_ElemPos (Texts_Elem E);
import void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
import void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
-import void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
+import void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len);
import void Texts_OpenBuf (Texts_Buffer B);
import void Texts_OpenReader (Texts_Reader *R, ADDRESS *R__typ, Texts_Text T, INT32 pos);
import void Texts_OpenScanner (Texts_Scanner *S, ADDRESS *S__typ, Texts_Text T, INT32 pos);
@@ -166,7 +166,7 @@ import void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x
import void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
import void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
import void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
-import void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
+import void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len);
import void *Texts__init(void);
diff --git a/bootstrap/windows-48/VT100.c b/bootstrap/windows-48/VT100.c
index f69fd90e..346fb37b 100644
--- a/bootstrap/windows-48/VT100.c
+++ b/bootstrap/windows-48/VT100.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -27,23 +27,24 @@ export void VT100_DECTCEMl (void);
export void VT100_DSR (INT16 n);
export void VT100_ED (INT16 n);
export void VT100_EL (INT16 n);
-static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len);
-static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len);
-static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len);
-static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len);
+static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len);
+static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len);
+static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len);
+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, LONGINT str__len);
+export void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len);
export void VT100_RCP (void);
-static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end);
+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);
export void VT100_SGR (INT16 n);
export void VT100_SGR2 (INT16 n, INT16 m);
export void VT100_SU (INT16 n);
-export void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
+export void VT100_SetAttr (CHAR *attr, ADDRESS attr__len);
-static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end)
+static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end)
{
CHAR h;
while (start < end) {
@@ -55,7 +56,7 @@ static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end)
}
}
-void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
+void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len)
{
CHAR b[21];
INT16 s, e;
@@ -74,7 +75,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT 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));
@@ -84,7 +85,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
__COPY(b, str, str__len);
}
-static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len)
+static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len)
{
CHAR cmd[9];
__DUP(letter, letter__len, CHAR);
@@ -94,7 +95,7 @@ static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len)
__DEL(letter);
}
-static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len)
+static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len)
{
CHAR nstr[2];
CHAR cmd[7];
@@ -107,7 +108,7 @@ static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len)
__DEL(letter);
}
-static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len)
+static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len)
{
CHAR nstr[2];
CHAR cmd[7];
@@ -120,7 +121,7 @@ static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len)
__DEL(letter);
}
-static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len)
+static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len)
{
CHAR nstr[5], mstr[5];
CHAR cmd[12];
@@ -136,6 +137,15 @@ static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT 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);
@@ -236,7 +246,7 @@ void VT100_DECTCEMh (void)
VT100_EscSeq0((CHAR*)"\?25h", 5);
}
-void VT100_SetAttr (CHAR *attr, LONGINT attr__len)
+void VT100_SetAttr (CHAR *attr, ADDRESS attr__len)
{
CHAR tmpstr[16];
__DUP(attr, attr__len, CHAR);
@@ -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 d99406ec..4e708647 100644
--- a/bootstrap/windows-48/VT100.h
+++ b/bootstrap/windows-48/VT100.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -23,14 +23,15 @@ import void VT100_DSR (INT16 n);
import void VT100_ED (INT16 n);
import void VT100_EL (INT16 n);
import void VT100_HVP (INT16 n, INT16 m);
-import void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len);
+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);
import void VT100_SGR2 (INT16 n, INT16 m);
import void VT100_SU (INT16 n);
-import void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
+import void VT100_SetAttr (CHAR *attr, ADDRESS attr__len);
import void *VT100__init(void);
diff --git a/bootstrap/windows-48/extTools.c b/bootstrap/windows-48/extTools.c
index 37630d23..ce2fc413 100644
--- a/bootstrap/windows-48/extTools.c
+++ b/bootstrap/windows-48/extTools.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,33 +7,40 @@
#include "SYSTEM.h"
#include "Configuration.h"
+#include "Heap.h"
#include "Modules.h"
#include "OPM.h"
#include "Out.h"
#include "Platform.h"
#include "Strings.h"
-
-static CHAR extTools_CFLAGS[1023];
+typedef
+ CHAR extTools_CommandString[4096];
-export void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len);
-static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT s__len);
-export void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len);
-static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len);
+static extTools_CommandString extTools_CFLAGS;
-static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len)
+export void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__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);
+
+
+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, LONGINT title__len, CHAR *cmd, LONGIN
__DEL(cmd);
}
-static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT 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, LONGINT moduleName__len)
+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*)"Assemble: ", 11, 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, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len)
+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", 8, (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((CHAR*)"", 1, (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*)"Assemble and link: ", 20, 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 63e5df15..686f0b4e 100644
--- a/bootstrap/windows-48/extTools.h
+++ b/bootstrap/windows-48/extTools.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -8,8 +8,8 @@
-import void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len);
-import void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len);
+import void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len);
+import void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len);
import void *extTools__init(void);
diff --git a/bootstrap/windows-88/Compiler.c b/bootstrap/windows-88/Compiler.c
index dc4bb660..4460479d 100644
--- a/bootstrap/windows-88/Compiler.c
+++ b/bootstrap/windows-88/Compiler.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -20,9 +20,9 @@
#include "extTools.h"
-static CHAR Compiler_mname[256];
+static void Compiler_FindLocalObjectFiles (CHAR *objectnames, ADDRESS objectnames__len);
export void Compiler_Module (BOOLEAN *done);
static void Compiler_PropagateElementaryTypeSizes (void);
export void Compiler_Translate (void);
@@ -41,11 +41,12 @@ void Compiler_Module (BOOLEAN *done)
OPT_Export(&ext, &new);
if (OPM_noerr) {
OPM_OpenFiles((void*)OPT_SelfName, 256);
+ OPM_DeleteObj((void*)OPT_SelfName, 256);
OPC_Init();
OPV_Module(p);
if (OPM_noerr) {
if ((__IN(10, OPM_Options, 32) && __STRCMP(OPM_modName, "SYSTEM") != 0)) {
- OPM_DeleteNewSym();
+ OPM_DeleteSym((void*)OPT_SelfName, 256);
OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogWStr((CHAR*)" Main program.", 16);
OPM_LogVT100((CHAR*)"0m", 3);
@@ -61,7 +62,7 @@ void Compiler_Module (BOOLEAN *done)
}
}
} else {
- OPM_DeleteNewSym();
+ OPM_DeleteSym((void*)OPT_SelfName, 256);
}
}
}
@@ -88,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;
@@ -104,14 +105,44 @@ static void Compiler_PropagateElementaryTypeSizes (void)
}
}
+static void Compiler_FindLocalObjectFiles (CHAR *objectnames, ADDRESS objectnames__len)
+{
+ OPT_Link l = NIL;
+ CHAR fn[64];
+ Platform_FileIdentity id;
+ objectnames[0] = 0x00;
+ l = OPT_Links;
+ while (l != NIL) {
+ __COPY(l->name, fn, 64);
+ Strings_Append((CHAR*)".sym", 5, (void*)fn, 64);
+ if (Platform_IdentifyByName(fn, 64, &id, Platform_FileIdentity__typ) == 0) {
+ __COPY(l->name, fn, 64);
+ Strings_Append((CHAR*)".o", 3, (void*)fn, 64);
+ if (Platform_IdentifyByName(fn, 64, &id, Platform_FileIdentity__typ) == 0) {
+ Strings_Append((CHAR*)" ", 2, (void*)objectnames, objectnames__len);
+ Strings_Append(fn, 64, (void*)objectnames, objectnames__len);
+ } else {
+ OPM_LogVT100((CHAR*)"91m", 4);
+ OPM_LogWStr((CHAR*)"Link warning: a local symbol file is present for module ", 57);
+ OPM_LogWStr(l->name, 256);
+ OPM_LogWStr((CHAR*)", but local object file '", 26);
+ OPM_LogWStr(fn, 64);
+ OPM_LogWStr((CHAR*)"' is missing.", 14);
+ OPM_LogVT100((CHAR*)"0m", 3);
+ OPM_LogWLn();
+ }
+ }
+ l = l->next;
+ }
+}
+
void Compiler_Translate (void)
{
BOOLEAN done;
- CHAR modulesobj[2048];
- modulesobj[0] = 0x00;
+ CHAR linkfiles[2048];
if (OPM_OpenPar()) {
for (;;) {
- OPM_Init(&done, (void*)Compiler_mname, 256);
+ OPM_Init(&done);
if (!done) {
return;
}
@@ -131,11 +162,9 @@ void Compiler_Translate (void)
} else {
if (!__IN(10, OPM_Options, 32)) {
extTools_Assemble(OPM_modName, 32);
- Strings_Append((CHAR*)" ", 2, (void*)modulesobj, 2048);
- Strings_Append(OPM_modName, 32, (void*)modulesobj, 2048);
- Strings_Append((CHAR*)".o", 3, (void*)modulesobj, 2048);
} else {
- extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), modulesobj, 2048);
+ Compiler_FindLocalObjectFiles((void*)linkfiles, 2048);
+ extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), linkfiles, 2048);
}
}
}
diff --git a/bootstrap/windows-88/Configuration.c b/bootstrap/windows-88/Configuration.c
index 2d0061df..fa87c9de 100644
--- a/bootstrap/windows-88/Configuration.c
+++ b/bootstrap/windows-88/Configuration.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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("1.95 [2016/11/24]. 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 b28e0caa..c3c54eed 100644
--- a/bootstrap/windows-88/Configuration.h
+++ b/bootstrap/windows-88/Configuration.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 c3ea44cf..07655515 100644
--- a/bootstrap/windows-88/Files.c
+++ b/bootstrap/windows-88/Files.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 {
@@ -37,7 +37,7 @@ typedef
INT32 len, pos;
Files_Buffer bufs[4];
INT16 swapper, state;
- Files_File next;
+ struct Files_FileDesc *next;
} Files_FileDesc;
typedef
@@ -49,11 +49,12 @@ typedef
} Files_Rider;
-static Files_File Files_files;
+export INT16 Files_MaxPathLength, Files_MaxNameLength;
+static Files_FileDesc *Files_files;
static INT16 Files_tempno;
static CHAR Files_HOME[1024];
static struct {
- LONGINT len[1];
+ ADDRESS len[1];
CHAR data[1];
} *Files_SearchPath;
@@ -61,58 +62,68 @@ export ADDRESS *Files_FileDesc__typ;
export ADDRESS *Files_BufDesc__typ;
export ADDRESS *Files_Rider__typ;
+static void Files_Assert (BOOLEAN truth);
export Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
static Files_File Files_CacheEntry (Platform_FileIdentity identity);
-export void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
+export void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res);
export void Files_Close (Files_File f);
static void Files_CloseOSFile (Files_File f);
static void Files_Create (Files_File f);
-export void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res);
-static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode);
+export void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res);
+static void Files_Deregister (CHAR *name, ADDRESS name__len);
+static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode);
static void Files_Finalize (SYSTEM_PTR o);
-static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len);
+static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len);
static void Files_Flush (Files_Buffer buf);
export void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
-export void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
-static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len);
-static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len);
+export void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len);
+static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len);
+static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len);
export INT32 Files_Length (Files_File f);
-static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len);
-export Files_File Files_New (CHAR *name, LONGINT name__len);
-export Files_File Files_Old (CHAR *name, LONGINT name__len);
+static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len);
+export Files_File Files_New (CHAR *name, ADDRESS name__len);
+export Files_File Files_Old (CHAR *name, ADDRESS name__len);
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_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+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);
export void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
-export void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
-export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
+export void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
+export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
export void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
export void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
-export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
export void Files_Register (Files_File f);
-export void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res);
-static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len);
+export void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res);
+static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len);
export void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos);
-export void Files_SetSearchPath (CHAR *path, LONGINT path__len);
+export void Files_SetSearchPath (CHAR *path, ADDRESS path__len);
export void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
export void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
-export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
export void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
export void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
export void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
export void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
export void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
export void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
-export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
#define Files_IdxTrap() __HALT(-1)
-#define Files_ToAdr(x) (ADDRESS)x
-static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
+static void Files_Assert (BOOLEAN truth)
+{
+ if (!truth) {
+ Out_Ln();
+ __ASSERT(truth, 0);
+ }
+}
+
+static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
{
__DUP(s, s__len, CHAR);
Out_Ln();
@@ -121,17 +132,17 @@ static void Files_Err (CHAR *s, LONGINT 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();
@@ -139,98 +150,125 @@ static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
__DEL(s);
}
-static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len)
+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, LONGINT finalName__len, CHAR *name, LONGINT name__len)
+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);
}
+static void Files_Deregister (CHAR *name, ADDRESS name__len)
+{
+ Platform_FileIdentity identity;
+ Files_File osfile = NIL;
+ INT16 error;
+ __DUP(name, name__len, CHAR);
+ if (Platform_IdentifyByName(name, name__len, &identity, Platform_FileIdentity__typ) == 0) {
+ osfile = (Files_File)Files_files;
+ while ((osfile != NIL && !Platform_SameFile(osfile->identity, identity))) {
+ osfile = (Files_File)osfile->next;
+ }
+ if (osfile != NIL) {
+ __ASSERT(!osfile->tempFile, 0);
+ __ASSERT(osfile->fd >= 0, 0);
+ __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, 256, (void*)osfile->workName, 256);
+ if (error != 0) {
+ Files_Err((CHAR*)"Couldn't rename previous version of file being registered", 58, osfile, error);
+ }
+ }
+ }
+ __DEL(name);
+}
+
static void Files_Create (Files_File f)
{
- Platform_FileIdentity identity;
BOOLEAN done;
INT16 error;
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 if (f->state == 2) {
- __COPY(f->registerName, f->workName, 101);
+ } else {
+ __ASSERT(f->state == 2, 0);
+ 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;
@@ -276,27 +314,6 @@ static void Files_Flush (Files_Buffer buf)
}
}
-static void Files_CloseOSFile (Files_File f)
-{
- Files_File prev = NIL;
- INT16 error;
- if (Files_files == f) {
- Files_files = f->next;
- } else {
- prev = Files_files;
- while ((prev != NIL && prev->next != f)) {
- prev = prev->next;
- }
- if (prev->next != NIL) {
- prev->next = f->next;
- }
- }
- error = Platform_Close(f->fd);
- f->fd = -1;
- f->state = 1;
- Heap_FileCount -= 1;
-}
-
void Files_Close (Files_File f)
{
INT32 i;
@@ -304,11 +321,10 @@ 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;
}
- Files_CloseOSFile(f);
}
}
@@ -317,13 +333,13 @@ INT32 Files_Length (Files_File f)
return f->len;
}
-Files_File Files_New (CHAR *name, LONGINT name__len)
+Files_File Files_New (CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
__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;
@@ -333,7 +349,7 @@ Files_File Files_New (CHAR *name, LONGINT name__len)
return f;
}
-static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len)
+static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len)
{
INT16 i;
CHAR ch;
@@ -345,38 +361,38 @@ static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT 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, LONGINT name__len)
+static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@@ -384,7 +400,7 @@ static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
ch = name[0];
while ((ch != 0x00 && ch != '/')) {
i += 1;
- ch = name[i];
+ ch = name[__X(i, name__len)];
}
return ch == '/';
}
@@ -393,15 +409,15 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
{
Files_File f = NIL;
INT16 i, error;
- f = Files_files;
+ f = (Files_File)Files_files;
while (f != NIL) {
if (Platform_SameFile(identity, f->identity)) {
if (!Platform_SameFileTime(identity, f->identity)) {
i = 0;
while (i < 4) {
- if (f->bufs[i] != NIL) {
- f->bufs[i]->org = -1;
- f->bufs[i] = NIL;
+ if (f->bufs[__X(i, 4)] != NIL) {
+ f->bufs[__X(i, 4)]->org = -1;
+ f->bufs[__X(i, 4)] = NIL;
}
i += 1;
}
@@ -411,12 +427,12 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
}
return f;
}
- f = f->next;
+ f = (Files_File)f->next;
}
return NIL;
}
-Files_File Files_Old (CHAR *name, LONGINT name__len)
+Files_File Files_Old (CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
INT64 fd;
@@ -457,6 +473,7 @@ Files_File Files_Old (CHAR *name, LONGINT name__len)
error = Platform_Identify(fd, &identity, Platform_FileIdentity__typ);
f = Files_CacheEntry(identity);
if (f != NIL) {
+ error = Platform_Close(fd);
__DEL(name);
return f;
} else {
@@ -467,7 +484,7 @@ Files_File Files_Old (CHAR *name, LONGINT 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;
@@ -499,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;
}
@@ -527,7 +544,7 @@ void Files_GetDate (Files_File f, INT32 *t, INT32 *d)
INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ)
{
- __ASSERT((*r).offset <= 4096, 0);
+ Files_Assert((*r).offset <= 4096);
return (*r).org + (*r).offset;
}
@@ -545,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) {
@@ -586,7 +603,7 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
org = 0;
offset = 0;
}
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
(*r).buf = buf;
(*r).org = org;
(*r).offset = offset;
@@ -605,9 +622,9 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
buf = (*r).buf;
offset = (*r).offset;
}
- __ASSERT(offset <= buf->size, 0);
+ 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);
@@ -619,7 +636,12 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
}
}
-void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
+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;
Files_Buffer buf = NIL;
@@ -645,12 +667,12 @@ void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x
} else {
min = n;
}
- __MOVE((ADDRESS)buf->data + Files_ToAdr(offset), (ADDRESS)x + Files_ToAdr(xpos), min);
+ __MOVE((ADDRESS)&buf->data[__X(offset, 4096)], (ADDRESS)&x[__X(xpos, x__len)], min);
offset += min;
(*r).offset = offset;
xpos += min;
n -= min;
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
}
(*r).res = 0;
(*r).eof = 0;
@@ -667,14 +689,14 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
INT32 offset;
buf = (*r).buf;
offset = (*r).offset;
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
- __ASSERT(offset < 4096, 0);
- buf->data[offset] = x;
+ Files_Assert(offset < 4096);
+ buf->data[__X(offset, 4096)] = x;
buf->chg = 1;
if (offset == buf->size) {
buf->size += 1;
@@ -684,7 +706,7 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
(*r).res = 0;
}
-void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
+void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n)
{
INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
@@ -695,23 +717,23 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT
buf = (*r).buf;
offset = (*r).offset;
while (n > 0) {
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
restInBuf = 4096 - offset;
if (n > restInBuf) {
min = restInBuf;
} else {
min = n;
}
- __MOVE((ADDRESS)x + Files_ToAdr(xpos), (ADDRESS)buf->data + Files_ToAdr(offset), min);
+ __MOVE((ADDRESS)&x[__X(xpos, x__len)], (ADDRESS)&buf->data[__X(offset, 4096)], min);
offset += min;
(*r).offset = offset;
- __ASSERT(offset <= 4096, 0);
+ Files_Assert(offset <= 4096);
if (offset > buf->size) {
buf->f->len += offset - buf->size;
buf->size = offset;
@@ -723,14 +745,15 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT
(*r).res = 0;
}
-void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res)
+void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res)
{
__DUP(name, name__len, CHAR);
+ Files_Deregister(name, name__len);
*res = Platform_Unlink((void*)name, name__len);
__DEL(name);
}
-void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res)
+void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res)
{
INT64 fdold, fdnew;
INT32 n;
@@ -797,31 +820,30 @@ void Files_Register (Files_File f)
{
INT16 idx, errcode;
Files_File f1 = NIL;
- CHAR file[104];
if ((f->state == 1 && f->registerName[0] != 0x00)) {
f->state = 2;
}
Files_Close(f);
if (f->registerName[0] != 0x00) {
- Files_Rename(f->workName, 101, f->registerName, 101, &errcode);
+ Files_Deregister(f->registerName, 256);
+ Files_Rename(f->workName, 256, f->registerName, 256, &errcode);
if (errcode != 0) {
- __COPY(f->registerName, file, 104);
- __HALT(99);
+ Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode);
}
- __COPY(f->registerName, f->workName, 101);
+ __MOVE(f->registerName, f->workName, 256);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
}
-void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res)
+void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res)
{
__DUP(path, path__len, CHAR);
*res = Platform_Chdir((void*)path, path__len);
__DEL(path);
}
-static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len)
+static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len)
{
INT32 i, j;
if (!Platform_LittleEndian) {
@@ -829,7 +851,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT 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 {
@@ -879,36 +901,36 @@ void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x)
Files_FlipBytes((void*)b, 8, (void*)&*x, 8);
}
-void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
+void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
{
INT16 i;
CHAR ch;
i = 0;
do {
Files_Read(&*R, R__typ, (void*)&ch);
- x[i] = ch;
+ x[__X(i, x__len)] = ch;
i += 1;
} while (!(ch == 0x00));
}
-void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
+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, LONGINT x__len)
+void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len)
{
INT8 s, b;
INT64 q;
@@ -921,7 +943,7 @@ void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__
Files_Read(&*R, R__typ, (void*)&b);
}
q += (INT64)__ASH((__MASK(b, -64) - __ASHL(__ASHR(b, 6), 6)), s);
- __ASSERT(x__len <= 8, 0);
+ Files_Assert(x__len <= 8);
__MOVE((ADDRESS)&q, (ADDRESS)x, x__len);
}
@@ -933,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);
}
@@ -952,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);
}
@@ -974,11 +998,11 @@ void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x)
Files_WriteBytes(&*R, R__typ, (void*)b, 8, 8);
}
-void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
+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);
@@ -987,17 +1011,38 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT 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, LONGINT name__len)
+void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len)
{
__COPY(f->workName, name, name__len);
}
+static void Files_CloseOSFile (Files_File f)
+{
+ Files_File prev = NIL;
+ INT16 error;
+ if (Files_files == (void *) f) {
+ Files_files = f->next;
+ } else {
+ prev = (Files_File)Files_files;
+ while ((prev != NIL && prev->next != (void *) f)) {
+ prev = (Files_File)prev->next;
+ }
+ if (prev->next != NIL) {
+ prev->next = f->next;
+ }
+ }
+ error = Platform_Close(f->fd);
+ f->fd = -1;
+ f->state = 1;
+ Heap_FileCount -= 1;
+}
+
static void Files_Finalize (SYSTEM_PTR o)
{
Files_File f = NIL;
@@ -1006,12 +1051,12 @@ 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);
}
}
}
-void Files_SetSearchPath (CHAR *path, LONGINT path__len)
+void Files_SetSearchPath (CHAR *path, ADDRESS path__len)
{
__DUP(path, path__len, CHAR);
if (Strings_Length(path, path__len) != 0) {
@@ -1025,11 +1070,10 @@ void Files_SetSearchPath (CHAR *path, LONGINT path__len)
static void EnumPtrs(void (*P)(void*))
{
- P(Files_files);
P(Files_SearchPath);
}
-__TDESC(Files_FileDesc, 1, 5) = {__TDFLDS("FileDesc", 288), {240, 248, 256, 264, 280, -48}};
+__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}};
@@ -1049,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 5c402312..8a7e59f8 100644
--- a/bootstrap/windows-88/Files.h
+++ b/bootstrap/windows-88/Files.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -10,9 +10,8 @@ typedef
typedef
struct Files_FileDesc {
- char _prvt0[224];
- INT64 fd;
- char _prvt1[56];
+ INT64 _prvt0;
+ char _prvt1[592];
} Files_FileDesc;
typedef
@@ -24,46 +23,48 @@ typedef
} Files_Rider;
+import INT16 Files_MaxPathLength, Files_MaxNameLength;
import ADDRESS *Files_FileDesc__typ;
import ADDRESS *Files_Rider__typ;
import Files_File Files_Base (Files_Rider *r, ADDRESS *r__typ);
-import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
+import void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res);
import void Files_Close (Files_File f);
-import void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res);
+import void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res);
import void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
-import void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
+import void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len);
import INT32 Files_Length (Files_File f);
-import Files_File Files_New (CHAR *name, LONGINT name__len);
-import Files_File Files_Old (CHAR *name, LONGINT name__len);
+import Files_File Files_New (CHAR *name, ADDRESS name__len);
+import Files_File Files_Old (CHAR *name, ADDRESS name__len);
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_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+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);
import void Files_ReadLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL *x);
-import void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
-import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len);
+import void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
+import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
import void Files_ReadReal (Files_Rider *R, ADDRESS *R__typ, REAL *x);
import void Files_ReadSet (Files_Rider *R, ADDRESS *R__typ, UINT32 *x);
-import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
import void Files_Register (Files_File f);
-import void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res);
+import void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res);
import void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos);
-import void Files_SetSearchPath (CHAR *path, LONGINT path__len);
+import void Files_SetSearchPath (CHAR *path, ADDRESS path__len);
import void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x);
import void Files_WriteBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN x);
-import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n);
+import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
import void Files_WriteInt (Files_Rider *R, ADDRESS *R__typ, INT16 x);
import void Files_WriteLInt (Files_Rider *R, ADDRESS *R__typ, INT32 x);
import void Files_WriteLReal (Files_Rider *R, ADDRESS *R__typ, LONGREAL x);
import void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x);
import void Files_WriteReal (Files_Rider *R, ADDRESS *R__typ, REAL x);
import void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x);
-import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
+import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len);
import void *Files__init(void);
diff --git a/bootstrap/windows-88/Heap.c b/bootstrap/windows-88/Heap.c
index a2bb8f2f..7b004b60 100644
--- a/bootstrap/windows-88/Heap.c
+++ b/bootstrap/windows-88/Heap.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,8 +68,10 @@ static INT64 Heap_freeList[10];
static INT64 Heap_bigBlocks;
export INT64 Heap_allocated;
static BOOLEAN Heap_firstTry;
-static INT64 Heap_heap, Heap_heapend;
-export INT64 Heap_heapsize;
+static INT16 Heap_ldUnit;
+export INT64 Heap_heap;
+static INT64 Heap_heapMin, Heap_heapMax;
+export INT64 Heap_heapsize, Heap_heapMinExpand;
static Heap_FinNode Heap_fin;
static INT16 Heap_lockdepth;
static BOOLEAN Heap_interrupted;
@@ -84,15 +86,16 @@ static void Heap_CheckFin (void);
static void Heap_ExtendHeap (INT64 blksz);
export void Heap_FINALL (void);
static void Heap_Finalize (void);
+export INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len);
export void Heap_GC (BOOLEAN markStack);
-static void Heap_HeapSort (INT64 n, INT64 *a, LONGINT a__len);
+static void Heap_HeapSort (INT32 n, INT64 *a, ADDRESS a__len);
export void Heap_INCREF (Heap_Module m);
export void Heap_InitHeap (void);
export void Heap_Lock (void);
static void Heap_Mark (INT64 q);
-static void Heap_MarkCandidates (INT64 n, INT64 *cand, LONGINT cand__len);
+static void Heap_MarkCandidates (INT32 n, INT64 *cand, ADDRESS cand__len);
static void Heap_MarkP (SYSTEM_PTR p);
-static void Heap_MarkStack (INT64 n, INT64 *cand, LONGINT cand__len);
+static void Heap_MarkStack (INT64 n, INT64 *cand, ADDRESS cand__len);
export SYSTEM_PTR Heap_NEWBLK (INT64 size);
export SYSTEM_PTR Heap_NEWREC (INT64 tag);
static INT64 Heap_NewChunk (INT64 blksz);
@@ -101,16 +104,18 @@ export SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs);
export void Heap_REGTYP (Heap_Module m, INT64 typ);
export void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize);
static void Heap_Scan (void);
-static void Heap_Sift (INT64 l, INT64 r, INT64 *a, LONGINT a__len);
+static void Heap_Sift (INT32 l, INT32 r, INT64 *a, ADDRESS a__len);
export void Heap_Unlock (void);
extern void *Heap__init();
-extern ADDRESS Platform_MainStackFrame;
+extern ADDRESS Modules_MainStackFrame;
extern ADDRESS Platform_OSAllocate(ADDRESS size);
#define Heap_HeapModuleInit() Heap__init()
#define Heap_ModulesHalt(code) Modules_Halt(code)
+#define Heap_ModulesMainStackFrame() Modules_MainStackFrame
#define Heap_OSAllocate(size) Platform_OSAllocate(size)
-#define Heap_PlatformMainStackFrame() Platform_MainStackFrame
+#define Heap_uLE(x, y) ((size_t)x <= (size_t)y)
+#define Heap_uLT(x, y) ((size_t)x < (size_t)y)
void Heap_Lock (void)
{
@@ -143,6 +148,35 @@ SYSTEM_PTR Heap_REGMOD (Heap_ModuleName name, Heap_EnumProc enumPtrs)
return (void*)m;
}
+INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len)
+{
+ Heap_Module m, p;
+ __DUP(name, name__len, CHAR);
+ m = (Heap_Module)(ADDRESS)Heap_modules;
+ while ((m != NIL && __STRCMP(m->name, name) != 0)) {
+ p = m;
+ m = m->next;
+ }
+ if ((m != NIL && m->refcnt == 0)) {
+ if (m == (Heap_Module)(ADDRESS)Heap_modules) {
+ Heap_modules = (SYSTEM_PTR)m->next;
+ } else {
+ p->next = m->next;
+ }
+ __DEL(name);
+ return 0;
+ } else {
+ if (m == NIL) {
+ __DEL(name);
+ return -1;
+ } else {
+ __DEL(name);
+ return m->refcnt;
+ }
+ }
+ __RETCHK;
+}
+
void Heap_REGCMD (Heap_Module m, Heap_CmdName name, Heap_Command cmd)
{
Heap_Cmd c;
@@ -170,16 +204,24 @@ void Heap_INCREF (Heap_Module m)
static INT64 Heap_NewChunk (INT64 blksz)
{
- INT64 chnk;
+ INT64 chnk, blk, end;
chnk = Heap_OSAllocate(blksz + 24);
if (chnk != 0) {
- __PUT(chnk + 8, chnk + (24 + blksz), INT64);
- __PUT(chnk + 24, chnk + 32, INT64);
- __PUT(chnk + 32, blksz, INT64);
- __PUT(chnk + 40, -8, INT64);
- __PUT(chnk + 48, Heap_bigBlocks, INT64);
- Heap_bigBlocks = chnk + 24;
+ blk = chnk + 24;
+ end = blk + blksz;
+ __PUT(chnk + 8, end, INT64);
+ __PUT(blk, blk + 8, INT64);
+ __PUT(blk + 8, blksz, INT64);
+ __PUT(blk + 16, -8, INT64);
+ __PUT(blk + 24, Heap_bigBlocks, INT64);
+ Heap_bigBlocks = blk;
Heap_heapsize += blksz;
+ if (Heap_uLT(blk + 8, Heap_heapMin)) {
+ Heap_heapMin = blk + 8;
+ }
+ if (Heap_uLT(Heap_heapMax, end)) {
+ Heap_heapMax = end;
+ }
}
return chnk;
}
@@ -187,29 +229,28 @@ static INT64 Heap_NewChunk (INT64 blksz)
static void Heap_ExtendHeap (INT64 blksz)
{
INT64 size, chnk, j, next;
- if (blksz > 320000) {
+ if (Heap_uLT(Heap_heapMinExpand, blksz)) {
size = blksz;
} else {
- size = 320000;
+ size = Heap_heapMinExpand;
}
chnk = Heap_NewChunk(size);
if (chnk != 0) {
- if (chnk < Heap_heap) {
+ if (Heap_uLT(chnk, Heap_heap)) {
__PUT(chnk, Heap_heap, INT64);
Heap_heap = chnk;
} else {
j = Heap_heap;
__GET(j, next, INT64);
- while ((next != 0 && chnk > next)) {
+ while ((next != 0 && Heap_uLT(next, chnk))) {
j = next;
__GET(j, next, INT64);
}
__PUT(chnk, next, INT64);
__PUT(j, chnk, INT64);
}
- if (next == 0) {
- __GET(chnk + 8, Heap_heapend, INT64);
- }
+ } else if (!Heap_firstTry) {
+ Heap_heapMinExpand = 32;
}
}
@@ -219,7 +260,7 @@ 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 (i < 9) {
adr = Heap_freeList[i];
@@ -251,16 +292,17 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
if (Heap_firstTry) {
Heap_GC(1);
blksz += 32;
- if (__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2) < Heap_heapsize) {
- Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 96), 7) - Heap_heapsize);
+ 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 {
@@ -269,7 +311,7 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
}
}
__GET(adr + 8, t, INT64);
- if (t >= blksz) {
+ if (Heap_uLE(blksz, t)) {
break;
}
prev = adr;
@@ -280,7 +322,7 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
__PUT(end + 8, blksz, INT64);
__PUT(end + 16, -8, INT64);
__PUT(end, end + 8, INT64);
- if (restsize > 288) {
+ if (Heap_uLT(288, restsize)) {
__PUT(adr + 8, restsize, INT64);
} else {
__GET(adr + 24, next, INT64);
@@ -289,7 +331,7 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
} else {
__PUT(prev + 24, next, INT64);
}
- if (restsize > 0) {
+ if (restsize != 0) {
di = __ASHR(restsize, 5);
__PUT(adr + 8, restsize, INT64);
__PUT(adr + 24, Heap_freeList[di], INT64);
@@ -300,7 +342,7 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
}
i = adr + 32;
end = adr + blksz;
- while (i < end) {
+ while (Heap_uLT(i, end)) {
__PUT(i, 0, INT64);
__PUT(i + 8, 0, INT64);
__PUT(i + 16, 0, INT64);
@@ -397,17 +439,17 @@ static void Heap_Scan (void)
while (chnk != 0) {
adr = chnk + 24;
__GET(chnk + 8, end, INT64);
- while (adr < end) {
+ while (Heap_uLT(adr, end)) {
__GET(adr, tag, INT64);
if (__ODD(tag)) {
- if (freesize > 0) {
+ if (freesize != 0) {
start = adr - freesize;
__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 (i < 9) {
+ if (Heap_uLT(i, 9)) {
__PUT(start + 24, Heap_freeList[i], INT64);
Heap_freeList[i] = start;
} else {
@@ -426,14 +468,14 @@ static void Heap_Scan (void)
adr += size;
}
}
- if (freesize > 0) {
+ if (freesize != 0) {
start = adr - freesize;
__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 (i < 9) {
+ if (Heap_uLT(i, 9)) {
__PUT(start + 24, Heap_freeList[i], INT64);
Heap_freeList[i] = start;
} else {
@@ -445,18 +487,19 @@ static void Heap_Scan (void)
}
}
-static void Heap_Sift (INT64 l, INT64 r, INT64 *a, LONGINT a__len)
+static void Heap_Sift (INT32 l, INT32 r, INT64 *a, ADDRESS a__len)
{
- INT64 i, j, x;
+ INT32 i, j;
+ INT64 x;
j = l;
x = a[j];
for (;;) {
i = j;
j = __ASHL(j, 1) + 1;
- if ((j < r && a[j] < a[j + 1])) {
+ if ((j < r && Heap_uLT(a[j], a[j + 1]))) {
j += 1;
}
- if (j > r || a[j] <= x) {
+ if (j > r || Heap_uLE(a[j], x)) {
break;
}
a[i] = a[j];
@@ -464,9 +507,10 @@ static void Heap_Sift (INT64 l, INT64 r, INT64 *a, LONGINT a__len)
a[i] = x;
}
-static void Heap_HeapSort (INT64 n, INT64 *a, LONGINT a__len)
+static void Heap_HeapSort (INT32 n, INT64 *a, ADDRESS a__len)
{
- INT64 l, r, x;
+ INT32 l, r;
+ INT64 x;
l = __ASHR(n, 1);
r = n - 1;
while (l > 0) {
@@ -482,37 +526,42 @@ static void Heap_HeapSort (INT64 n, INT64 *a, LONGINT a__len)
}
}
-static void Heap_MarkCandidates (INT64 n, INT64 *cand, LONGINT cand__len)
+static void Heap_MarkCandidates (INT32 n, INT64 *cand, ADDRESS cand__len)
{
- INT64 chnk, adr, tag, next, lim, lim1, i, ptr, size;
- chnk = Heap_heap;
+ INT64 chnk, end, adr, tag, next, i, ptr, size;
+ chnk = Heap_heap;
i = 0;
- lim = cand[n - 1];
- while ((chnk != 0 && chnk < lim)) {
+ while (chnk != 0) {
+ __GET(chnk + 8, end, INT64);
adr = chnk + 24;
- __GET(chnk + 8, lim1, INT64);
- if (lim < lim1) {
- lim1 = lim;
- }
- while (adr < lim1) {
+ while (Heap_uLT(adr, end)) {
__GET(adr, tag, INT64);
if (__ODD(tag)) {
__GET(tag - 1, size, INT64);
adr += size;
+ ptr = adr + 8;
+ while (Heap_uLT(cand[i], ptr)) {
+ i += 1;
+ if (i == (INT64)n) {
+ return;
+ }
+ }
} else {
__GET(tag, size, INT64);
ptr = adr + 8;
- while (cand[i] < ptr) {
+ adr += size;
+ while (Heap_uLT(cand[i], ptr)) {
i += 1;
+ if (i == (INT64)n) {
+ return;
+ }
}
- if (i == n) {
- return;
- }
- next = adr + size;
- if (cand[i] < next) {
+ if (Heap_uLT(cand[i], adr)) {
Heap_Mark(ptr);
}
- adr = next;
+ }
+ if (Heap_uLE(end, cand[i])) {
+ adr = end;
}
}
__GET(chnk, chnk, INT64);
@@ -571,10 +620,11 @@ void Heap_FINALL (void)
}
}
-static void Heap_MarkStack (INT64 n, INT64 *cand, LONGINT cand__len)
+static void Heap_MarkStack (INT64 n, INT64 *cand, ADDRESS cand__len)
{
SYSTEM_PTR frame;
- INT64 inc, nofcand, sp, p, stack0;
+ INT32 nofcand;
+ INT64 inc, sp, p, stack0;
struct Heap__1 align;
if (n > 0) {
Heap_MarkStack(n - 1, cand, cand__len);
@@ -585,15 +635,15 @@ static void Heap_MarkStack (INT64 n, INT64 *cand, LONGINT cand__len)
if (n == 0) {
nofcand = 0;
sp = (ADDRESS)&frame;
- stack0 = Heap_PlatformMainStackFrame();
+ stack0 = Heap_ModulesMainStackFrame();
inc = (ADDRESS)&align.p - (ADDRESS)&align;
- if (sp > stack0) {
+ if (Heap_uLT(stack0, sp)) {
inc = -inc;
}
while (sp != stack0) {
__GET(sp, p, INT64);
- if ((p > Heap_heap && p < Heap_heapend)) {
- if (nofcand == (INT64)cand__len) {
+ if ((Heap_uLE(Heap_heapMin, p) && Heap_uLT(p, Heap_heapMax))) {
+ if (nofcand == cand__len) {
Heap_HeapSort(nofcand, (void*)cand, cand__len);
Heap_MarkCandidates(nofcand, (void*)cand, cand__len);
nofcand = 0;
@@ -615,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)
@@ -703,17 +751,21 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
void Heap_InitHeap (void)
{
- Heap_heap = Heap_NewChunk(256000);
- __GET(Heap_heap + 8, Heap_heapend, INT64);
- __PUT(Heap_heap, 0, INT64);
+ Heap_heap = 0;
+ Heap_heapsize = 0;
Heap_allocated = 0;
+ Heap_lockdepth = 0;
+ 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;
Heap_freeList[9] = 1;
- Heap_lockdepth = 0;
Heap_FileCount = 0;
Heap_modules = NIL;
- Heap_heapsize = 0;
- Heap_bigBlocks = 0;
Heap_fin = NIL;
Heap_interrupted = 0;
Heap_HeapModuleInit();
diff --git a/bootstrap/windows-88/Heap.h b/bootstrap/windows-88/Heap.h
index 163cad8c..45a9c6d2 100644
--- a/bootstrap/windows-88/Heap.h
+++ b/bootstrap/windows-88/Heap.h
@@ -1,16 +1,26 @@
-/* voc 1.95 [2016/11/24]. 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
#include "SYSTEM.h"
+typedef
+ struct Heap_CmdDesc *Heap_Cmd;
+
typedef
CHAR Heap_CmdName[24];
typedef
void (*Heap_Command)(void);
+typedef
+ struct Heap_CmdDesc {
+ Heap_Cmd next;
+ Heap_CmdName name;
+ Heap_Command cmd;
+ } Heap_CmdDesc;
+
typedef
void (*Heap_EnumProc)(void(*)(SYSTEM_PTR));
@@ -21,22 +31,31 @@ typedef
struct Heap_ModuleDesc *Heap_Module;
typedef
- struct Heap_ModuleDesc {
- INT64 _prvt0;
- char _prvt1[56];
- } Heap_ModuleDesc;
+ CHAR Heap_ModuleName[20];
typedef
- CHAR Heap_ModuleName[20];
+ struct Heap_ModuleDesc {
+ Heap_Module next;
+ Heap_ModuleName name;
+ INT32 refcnt;
+ Heap_Cmd cmds;
+ INT64 types;
+ Heap_EnumProc enumPtrs;
+ char _prvt0[8];
+ } Heap_ModuleDesc;
import SYSTEM_PTR Heap_modules;
-import INT64 Heap_allocated, Heap_heapsize;
+import INT64 Heap_allocated;
+import INT64 Heap_heap;
+import INT64 Heap_heapsize, Heap_heapMinExpand;
import INT16 Heap_FileCount;
import ADDRESS *Heap_ModuleDesc__typ;
+import ADDRESS *Heap_CmdDesc__typ;
import void Heap_FINALL (void);
+import INT32 Heap_FreeModule (CHAR *name, ADDRESS name__len);
import void Heap_GC (BOOLEAN markStack);
import void Heap_INCREF (Heap_Module m);
import void Heap_InitHeap (void);
diff --git a/bootstrap/windows-88/Modules.c b/bootstrap/windows-88/Modules.c
index 4e4d62e7..7a49b8ff 100644
--- a/bootstrap/windows-88/Modules.c
+++ b/bootstrap/windows-88/Modules.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -9,81 +9,303 @@
#include "Heap.h"
#include "Platform.h"
-typedef
- struct Modules_CmdDesc *Modules_Cmd;
-
-typedef
- void (*Modules_Command)(void);
-
-typedef
- struct Modules_CmdDesc {
- Modules_Cmd next;
- CHAR name[24];
- Modules_Command cmd;
- } Modules_CmdDesc;
-
-typedef
- struct Modules_ModuleDesc *Modules_Module;
-
-typedef
- CHAR Modules_ModuleName[20];
-
-typedef
- struct Modules_ModuleDesc {
- Modules_Module next;
- Modules_ModuleName name;
- INT32 refcnt;
- Modules_Cmd cmds;
- INT32 types;
- void (*enumPtrs)(void(*)(INT32));
- INT32 reserved1, reserved2;
- } Modules_ModuleDesc;
-
export INT16 Modules_res;
export CHAR Modules_resMsg[256];
-export Modules_ModuleName Modules_imported, Modules_importing;
+export Heap_ModuleName Modules_imported, Modules_importing;
+export INT64 Modules_MainStackFrame;
+export INT16 Modules_ArgCount;
+export INT64 Modules_ArgVector;
+export CHAR Modules_BinaryDir[1024];
-export ADDRESS *Modules_ModuleDesc__typ;
-export ADDRESS *Modules_CmdDesc__typ;
-static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len);
+static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
+static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
+export INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len);
export void Modules_AssertFail (INT32 code);
+static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
+static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len);
static void Modules_DisplayHaltCode (INT32 code);
-export void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
+static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len);
+static void Modules_FindBinaryDir (CHAR *binarydir, ADDRESS binarydir__len);
+export void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all);
+export void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len);
+export void Modules_GetIntArg (INT16 n, INT32 *val);
export void Modules_Halt (INT32 code);
-export Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
-export Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
+export void Modules_Init (INT32 argc, INT64 argvadr);
+static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len);
+static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len);
+static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len);
+export Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len);
+export Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len);
+static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len);
static void Modules_errch (CHAR c);
static void Modules_errint (INT32 l);
-static void Modules_errstring (CHAR *s, LONGINT s__len);
+static void Modules_errstring (CHAR *s, ADDRESS s__len);
-#define Modules_modules() (Modules_Module)Heap_modules
-#define Modules_setmodules(m) Heap_modules = m
+extern void Heap_InitHeap();
+extern void *Modules__init(void);
+#define Modules_InitHeap() Heap_InitHeap()
+#define Modules_ModulesInit() Modules__init()
+#define Modules_modules() (Heap_Module)Heap_modules
-static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len)
+void Modules_Init (INT32 argc, INT64 argvadr)
{
- INT16 i, j;
- __DUP(b, b__len, CHAR);
+ Modules_MainStackFrame = argvadr;
+ Modules_ArgCount = __VAL(INT16, argc);
+ __GET(argvadr, Modules_ArgVector, INT64);
+ Modules_InitHeap();
+ Modules_ModulesInit();
+}
+
+typedef
+ CHAR (*argptr__15)[1024];
+
+void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len)
+{
+ argptr__15 arg = NIL;
+ if (n < Modules_ArgCount) {
+ __GET(Modules_ArgVector + (INT64)__ASHL(n, 3), arg, argptr__15);
+ __COPY(*arg, val, val__len);
+ }
+}
+
+void Modules_GetIntArg (INT16 n, INT32 *val)
+{
+ CHAR s[64];
+ INT32 k, d, i;
+ s[0] = 0x00;
+ Modules_GetArg(n, (void*)s, 64);
i = 0;
- while (a[__X(i, a__len)] != 0x00) {
+ if (s[0] == '-') {
+ i = 1;
+ }
+ k = 0;
+ d = (INT16)s[__X(i, 64)] - 48;
+ while ((d >= 0 && d <= 9)) {
+ k = k * 10 + d;
+ i += 1;
+ d = (INT16)s[__X(i, 64)] - 48;
+ }
+ if (s[0] == '-') {
+ k = -k;
+ i -= 1;
+ }
+ if (i > 0) {
+ *val = k;
+ }
+}
+
+INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len)
+{
+ INT16 i;
+ CHAR arg[256];
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ Modules_GetArg(i, (void*)arg, 256);
+ while ((i < Modules_ArgCount && __STRCMP(s, arg) != 0)) {
+ i += 1;
+ Modules_GetArg(i, (void*)arg, 256);
+ }
+ __DEL(s);
+ return i;
+}
+
+static INT16 Modules_CharCount (CHAR *s, ADDRESS s__len)
+{
+ INT16 i;
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ while ((i < s__len && s[__X(i, s__len)] != 0x00)) {
i += 1;
}
- j = 0;
- while (b[__X(j, b__len)] != 0x00) {
- a[__X(i, a__len)] = b[__X(j, b__len)];
+ __DEL(s);
+ return i;
+}
+
+static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
+{
+ INT16 i, j;
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ j = Modules_CharCount(d, d__len);
+ while (s[__X(i, s__len)] != 0x00) {
+ d[__X(j, d__len)] = s[__X(i, s__len)];
i += 1;
j += 1;
}
- a[__X(i, a__len)] = 0x00;
- __DEL(b);
+ d[__X(j, d__len)] = 0x00;
+ __DEL(s);
}
-Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
+static void Modules_AppendPart (CHAR c, CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
{
- Modules_Module m = NIL;
+ INT16 i, j;
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ j = Modules_CharCount(d, d__len);
+ if ((j > 0 && d[__X(j - 1, d__len)] != c)) {
+ d[__X(j, d__len)] = c;
+ j += 1;
+ }
+ while (s[__X(i, s__len)] != 0x00) {
+ d[__X(j, d__len)] = s[__X(i, s__len)];
+ i += 1;
+ j += 1;
+ }
+ d[__X(j, d__len)] = 0x00;
+ __DEL(s);
+}
+
+static BOOLEAN Modules_IsOneOf (CHAR c, CHAR *s, ADDRESS s__len)
+{
+ INT16 i;
+ __DUP(s, s__len, CHAR);
+ if (c == 0x00) {
+ __DEL(s);
+ return 0;
+ }
+ i = 0;
+ while ((s[__X(i, s__len)] != c && s[__X(i, s__len)] != 0x00)) {
+ i += 1;
+ }
+ __DEL(s);
+ return s[__X(i, s__len)] == c;
+}
+
+static BOOLEAN Modules_IsAbsolute (CHAR *d, ADDRESS d__len)
+{
+ __DUP(d, d__len, CHAR);
+ if (d[0] == 0x00) {
+ __DEL(d);
+ return 0;
+ }
+ if (Modules_IsOneOf(d[0], (CHAR*)"/\\", 3)) {
+ __DEL(d);
+ return 1;
+ }
+ if (d[__X(1, d__len)] == ':') {
+ __DEL(d);
+ return 1;
+ }
+ __DEL(d);
+ return 0;
+}
+
+static void Modules_Canonify (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
+{
+ __DUP(s, s__len, CHAR);
+ if (Modules_IsAbsolute(s, s__len)) {
+ __COPY(s, d, d__len);
+ } else {
+ __COPY(Platform_CWD, d, d__len);
+ Modules_AppendPart('/', s, s__len, (void*)d, d__len);
+ }
+ __DEL(s);
+}
+
+static BOOLEAN Modules_IsFilePresent (CHAR *s, ADDRESS s__len)
+{
+ Platform_FileIdentity identity;
+ __DUP(s, s__len, CHAR);
+ __DEL(s);
+ return Platform_IdentifyByName(s, s__len, &identity, Platform_FileIdentity__typ) == 0;
+}
+
+static void Modules_ExtractPart (CHAR *s, ADDRESS s__len, INT16 *i, CHAR *p, ADDRESS p__len, CHAR *d, ADDRESS d__len)
+{
+ INT16 j;
+ __DUP(s, s__len, CHAR);
+ __DUP(p, p__len, CHAR);
+ j = 0;
+ while ((s[__X(*i, s__len)] != 0x00 && !Modules_IsOneOf(s[__X(*i, s__len)], p, p__len))) {
+ d[__X(j, d__len)] = s[__X(*i, s__len)];
+ *i += 1;
+ j += 1;
+ }
+ d[__X(j, d__len)] = 0x00;
+ while (Modules_IsOneOf(s[__X(*i, s__len)], p, p__len)) {
+ *i += 1;
+ }
+ __DEL(s);
+ __DEL(p);
+}
+
+static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
+{
+ INT16 i, j;
+ CHAR part[1024];
+ __DUP(s, s__len, CHAR);
+ i = 0;
+ j = 0;
+ while ((i < 2 && Modules_IsOneOf(s[__X(i, s__len)], (CHAR*)"/\\", 3))) {
+ i += 1;
+ d[__X(j, d__len)] = '/';
+ j += 1;
+ }
+ d[__X(j, d__len)] = 0x00;
+ while (s[__X(i, s__len)] != 0x00) {
+ Modules_ExtractPart(s, s__len, &i, (CHAR*)"/\\", 3, (void*)part, 1024);
+ if ((part[0] != 0x00 && __STRCMP(part, ".") != 0)) {
+ Modules_AppendPart('/', part, 1024, (void*)d, d__len);
+ }
+ }
+ __DEL(s);
+}
+
+typedef
+ CHAR pathstring__12[4096];
+
+static void Modules_FindBinaryDir (CHAR *binarydir, ADDRESS binarydir__len)
+{
+ pathstring__12 arg0, pathlist, pathdir, tempstr;
+ INT16 i, j, k;
+ BOOLEAN present;
+ if (Modules_ArgCount < 1) {
+ binarydir[0] = 0x00;
+ return;
+ }
+ Modules_GetArg(0, (void*)arg0, 4096);
+ i = 0;
+ while ((((arg0[__X(i, 4096)] != 0x00 && arg0[__X(i, 4096)] != '/')) && arg0[__X(i, 4096)] != '\\')) {
+ i += 1;
+ }
+ if (arg0[__X(i, 4096)] == '/' || arg0[__X(i, 4096)] == '\\') {
+ Modules_Trim(arg0, 4096, (void*)tempstr, 4096);
+ Modules_Canonify(tempstr, 4096, (void*)binarydir, binarydir__len);
+ present = Modules_IsFilePresent(binarydir, binarydir__len);
+ } else {
+ Platform_GetEnv((CHAR*)"PATH", 5, (void*)pathlist, 4096);
+ i = 0;
+ present = 0;
+ while ((!present && pathlist[__X(i, 4096)] != 0x00)) {
+ Modules_ExtractPart(pathlist, 4096, &i, (CHAR*)":;", 3, (void*)pathdir, 4096);
+ Modules_AppendPart('/', arg0, 4096, (void*)pathdir, 4096);
+ Modules_Trim(pathdir, 4096, (void*)tempstr, 4096);
+ Modules_Canonify(tempstr, 4096, (void*)binarydir, binarydir__len);
+ present = Modules_IsFilePresent(binarydir, binarydir__len);
+ }
+ }
+ if (present) {
+ k = Modules_CharCount(binarydir, binarydir__len);
+ while ((k > 0 && !Modules_IsOneOf(binarydir[__X(k - 1, binarydir__len)], (CHAR*)"/\\", 3))) {
+ k -= 1;
+ }
+ if (k == 0) {
+ binarydir[__X(k, binarydir__len)] = 0x00;
+ } else {
+ binarydir[__X(k - 1, binarydir__len)] = 0x00;
+ }
+ } else {
+ binarydir[0] = 0x00;
+ }
+}
+
+Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len)
+{
+ Heap_Module m = NIL;
CHAR bodyname[64];
- Modules_Command body;
+ Heap_Command body;
__DUP(name, name__len, CHAR);
m = Modules_modules();
while ((m != NIL && __STRCMP(m->name, name) != 0)) {
@@ -96,16 +318,16 @@ Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len)
Modules_res = 1;
__COPY(name, Modules_importing, 20);
__MOVE(" module \"", Modules_resMsg, 10);
- Modules_Append((void*)Modules_resMsg, 256, name, name__len);
- Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
+ Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
+ Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
}
__DEL(name);
return m;
}
-Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len)
+Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len)
{
- Modules_Cmd c = NIL;
+ Heap_Cmd c = NIL;
__DUP(name, name__len, CHAR);
c = mod->cmds;
while ((c != NIL && __STRCMP(c->name, name) != 0)) {
@@ -120,43 +342,36 @@ Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT nam
Modules_res = 2;
__MOVE(" command \"", Modules_resMsg, 11);
__COPY(name, Modules_importing, 20);
- Modules_Append((void*)Modules_resMsg, 256, mod->name, 20);
- Modules_Append((void*)Modules_resMsg, 256, (CHAR*)".", 2);
- Modules_Append((void*)Modules_resMsg, 256, name, name__len);
- Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
+ Modules_Append(mod->name, 20, (void*)Modules_resMsg, 256);
+ Modules_Append((CHAR*)".", 2, (void*)Modules_resMsg, 256);
+ Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
+ Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
__DEL(name);
return NIL;
}
__RETCHK;
}
-void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all)
+void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all)
{
- Modules_Module m = NIL, p = NIL;
+ Heap_Module m = NIL, p = NIL;
+ INT32 refcount;
__DUP(name, name__len, CHAR);
m = Modules_modules();
if (all) {
Modules_res = 1;
__MOVE("unloading \"all\" not yet supported", Modules_resMsg, 34);
} else {
- while ((m != NIL && __STRCMP(m->name, name) != 0)) {
- p = m;
- m = m->next;
- }
- if ((m != NIL && m->refcnt == 0)) {
- if (m == Modules_modules()) {
- Modules_setmodules(m->next);
- } else {
- p->next = m->next;
- }
+ refcount = Heap_FreeModule(name, name__len);
+ if (refcount == 0) {
Modules_res = 0;
} else {
- Modules_res = 1;
- if (m == NIL) {
+ if (refcount < 0) {
__MOVE("module not found", Modules_resMsg, 17);
} else {
__MOVE("clients of this module exist", Modules_resMsg, 29);
}
+ Modules_res = 1;
}
}
__DEL(name);
@@ -165,10 +380,10 @@ void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all)
static void Modules_errch (CHAR c)
{
INT16 e;
- e = Platform_Write(1, (ADDRESS)&c, 1);
+ e = Platform_Write(Platform_StdOut, (ADDRESS)&c, 1);
}
-static void Modules_errstring (CHAR *s, LONGINT s__len)
+static void Modules_errstring (CHAR *s, ADDRESS s__len)
{
INT32 i;
__DUP(s, s__len, CHAR);
@@ -189,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)
@@ -250,6 +465,7 @@ static void Modules_DisplayHaltCode (INT32 code)
void Modules_Halt (INT32 code)
{
+ Heap_FINALL();
Modules_errstring((CHAR*)"Terminated by Halt(", 20);
Modules_errint(code);
Modules_errstring((CHAR*)"). ", 4);
@@ -262,6 +478,7 @@ void Modules_Halt (INT32 code)
void Modules_AssertFail (INT32 code)
{
+ Heap_FINALL();
Modules_errstring((CHAR*)"Assertion failure.", 19);
if (code != 0) {
Modules_errstring((CHAR*)" ASSERT code ", 14);
@@ -269,11 +486,13 @@ void Modules_AssertFail (INT32 code)
Modules_errstring((CHAR*)".", 2);
}
Modules_errstring(Platform_NL, 3);
- Platform_Exit(code);
+ if (code > 0) {
+ Platform_Exit(code);
+ } else {
+ Platform_Exit(-1);
+ }
}
-__TDESC(Modules_ModuleDesc, 1, 2) = {__TDFLDS("ModuleDesc", 64), {0, 32, -24}};
-__TDESC(Modules_CmdDesc, 1, 1) = {__TDFLDS("CmdDesc", 40), {0, -16}};
export void *Modules__init(void)
{
@@ -281,8 +500,7 @@ export void *Modules__init(void)
__MODULE_IMPORT(Heap);
__MODULE_IMPORT(Platform);
__REGMOD("Modules", 0);
- __INITYP(Modules_ModuleDesc, Modules_ModuleDesc, 0);
- __INITYP(Modules_CmdDesc, Modules_CmdDesc, 0);
/* BEGIN */
+ Modules_FindBinaryDir((void*)Modules_BinaryDir, 1024);
__ENDMOD;
}
diff --git a/bootstrap/windows-88/Modules.h b/bootstrap/windows-88/Modules.h
index 8bb89fe5..ee65a938 100644
--- a/bootstrap/windows-88/Modules.h
+++ b/bootstrap/windows-88/Modules.h
@@ -1,53 +1,30 @@
-/* voc 1.95 [2016/11/24]. 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
#include "SYSTEM.h"
-
-typedef
- struct Modules_CmdDesc *Modules_Cmd;
-
-typedef
- void (*Modules_Command)(void);
-
-typedef
- struct Modules_CmdDesc {
- Modules_Cmd next;
- CHAR name[24];
- Modules_Command cmd;
- } Modules_CmdDesc;
-
-typedef
- struct Modules_ModuleDesc *Modules_Module;
-
-typedef
- CHAR Modules_ModuleName[20];
-
-typedef
- struct Modules_ModuleDesc {
- Modules_Module next;
- Modules_ModuleName name;
- INT32 refcnt;
- Modules_Cmd cmds;
- INT32 types;
- void (*enumPtrs)(void(*)(INT32));
- char _prvt0[8];
- } Modules_ModuleDesc;
+#include "Heap.h"
import INT16 Modules_res;
import CHAR Modules_resMsg[256];
-import Modules_ModuleName Modules_imported, Modules_importing;
+import Heap_ModuleName Modules_imported, Modules_importing;
+import INT64 Modules_MainStackFrame;
+import INT16 Modules_ArgCount;
+import INT64 Modules_ArgVector;
+import CHAR Modules_BinaryDir[1024];
-import ADDRESS *Modules_ModuleDesc__typ;
-import ADDRESS *Modules_CmdDesc__typ;
+import INT16 Modules_ArgPos (CHAR *s, ADDRESS s__len);
import void Modules_AssertFail (INT32 code);
-import void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
+import void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all);
+import void Modules_GetArg (INT16 n, CHAR *val, ADDRESS val__len);
+import void Modules_GetIntArg (INT16 n, INT32 *val);
import void Modules_Halt (INT32 code);
-import Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
-import Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
+import void Modules_Init (INT32 argc, INT64 argvadr);
+import Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len);
+import Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len);
import void *Modules__init(void);
diff --git a/bootstrap/windows-88/OPB.c b/bootstrap/windows-88/OPB.c
index 3ef8e2f9..913fbf2d 100644
--- a/bootstrap/windows-88/OPB.c
+++ b/bootstrap/windows-88/OPB.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -253,7 +253,7 @@ OPT_Node OPB_NewString (OPS_String str, INT64 len)
x->conval->intval = -1;
x->conval->intval2 = OPM_Longint(len);
x->conval->ext = OPT_NewExt();
- __COPY(str, *x->conval->ext, 256);
+ __MOVE(str, *x->conval->ext, 256);
return x;
}
@@ -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;
@@ -550,7 +550,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
if (__IN(f, 0xf0, 32)) {
if (z->class == 7) {
if (f == 4) {
- if (z->conval->intval == (-9223372036854775807-1)) {
+ if (z->conval->intval == (-9223372036854775807LL-1)) {
OPB_err(203);
} else {
z->conval->intval = -z->conval->intval;
@@ -577,7 +577,7 @@ void OPB_MOp (INT8 op, OPT_Node *x)
if (__IN(f, 0x70, 32)) {
if (z->class == 7) {
if (f == 4) {
- if (z->conval->intval == (-9223372036854775807-1)) {
+ if (z->conval->intval == (-9223372036854775807LL-1)) {
OPB_err(203);
} else {
z->conval->intval = __ABS(z->conval->intval);
@@ -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);
@@ -920,7 +920,7 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
if (f == 4) {
xv = xval->intval;
yv = yval->intval;
- if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807-1))) && yv != (-9223372036854775807-1))) && -xv <= __DIV(9223372036854775807, -yv))) {
+ if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807LL, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807LL-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807LL-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807LL-1))) && yv != (-9223372036854775807LL-1))) && -xv <= __DIV(9223372036854775807LL, -yv))) {
xval->intval = xv * yv;
OPB_SetIntType(x);
} else {
@@ -999,8 +999,8 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
break;
case 6:
if (f == 4) {
- temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807 - yval->intval);
- if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807-1) - yval->intval)) {
+ temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807LL - yval->intval);
+ if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807LL-1) - yval->intval)) {
xval->intval += yval->intval;
OPB_SetIntType(x);
} else {
@@ -1023,7 +1023,7 @@ static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
break;
case 7:
if (f == 4) {
- if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807 + yval->intval)) {
+ if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807LL-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807LL + yval->intval)) {
xval->intval -= yval->intval;
OPB_SetIntType(x);
} else {
@@ -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);
}
}
@@ -1624,23 +1624,20 @@ static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
g = 8;
}
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) {
OPB_err(114);
}
- } else if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
} else {
OPB_err(113);
}
} else {
OPB_err(113);
}
- } else if ((x->comp == 3 && x->BaseTyp == OPT_chartyp)) {
- if ((__IN(y->comp, 0x0c, 32) && y->BaseTyp == OPT_chartyp)) {
- } else {
- OPB_err(113);
- }
} else if (x->comp == 4) {
if (x == y) {
} else if (y->comp == 4) {
@@ -2091,7 +2088,7 @@ void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
OPB_err(208);
p->conval->intval = 1;
} else if (x->conval->intval >= 0) {
- if (__ABS(p->conval->intval) <= __DIV(9223372036854775807, (INT64)__ASH(1, x->conval->intval))) {
+ if (__ABS(p->conval->intval) <= __DIV(9223372036854775807LL, (INT64)__ASH(1, x->conval->intval))) {
p->conval->intval = p->conval->intval * (INT64)__ASH(1, x->conval->intval);
} else {
OPB_err(208);
@@ -2536,7 +2533,6 @@ void OPB_Return (OPT_Node *x, OPT_Object proc)
void OPB_Assign (OPT_Node *x, OPT_Node y)
{
OPT_Node z = NIL;
- INT8 subcl;
if ((*x)->class >= 7) {
OPB_err(56);
}
@@ -2562,13 +2558,8 @@ void OPB_Assign (OPT_Node *x, OPT_Node y)
y->conval->intval = 0;
OPB_Index(&*x, OPB_NewIntConst(0));
}
- if ((((((__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp == OPT_chartyp)) && __IN(y->typ->comp, 0x0c, 32))) && y->typ->BaseTyp == OPT_chartyp)) {
- subcl = 18;
- } else {
- subcl = 0;
- }
OPB_BindNodes(19, OPT_notyp, &*x, y);
- (*x)->subcl = subcl;
+ (*x)->subcl = 0;
}
void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ)
@@ -2595,7 +2586,7 @@ export void *OPB__init(void)
__MODULE_IMPORT(OPT);
__REGMOD("OPB", 0);
/* BEGIN */
- OPB_maxExp = OPB_log(4611686018427387904);
+ OPB_maxExp = OPB_log(4611686018427387904LL);
OPB_maxExp = OPB_exp;
__ENDMOD;
}
diff --git a/bootstrap/windows-88/OPB.h b/bootstrap/windows-88/OPB.h
index 0be714e8..f66fcd66 100644
--- a/bootstrap/windows-88/OPB.h
+++ b/bootstrap/windows-88/OPB.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 ef4b429f..7b92ccc1 100644
--- a/bootstrap/windows-88/OPC.c
+++ b/bootstrap/windows-88/OPC.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -56,7 +56,7 @@ static void OPC_GenHeaderMsg (void);
export void OPC_Halt (INT32 n);
export void OPC_Ident (OPT_Object obj);
static void OPC_IdentList (OPT_Object obj, INT16 vis);
-static void OPC_Include (CHAR *name, LONGINT name__len);
+static void OPC_Include (CHAR *name, ADDRESS name__len);
static void OPC_IncludeImports (OPT_Object obj, INT16 vis);
export void OPC_Increment (BOOLEAN decrement);
export void OPC_Indent (INT16 count);
@@ -68,11 +68,11 @@ static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj);
export void OPC_IntLiteral (INT64 n, INT32 size);
export void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim);
static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName);
-static INT16 OPC_Length (CHAR *s, LONGINT s__len);
+static INT16 OPC_Length (CHAR *s, ADDRESS s__len);
export BOOLEAN OPC_NeedsRetval (OPT_Object proc);
export INT32 OPC_NofPtrs (OPT_Struct typ);
-static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len);
-static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len);
+static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len);
+static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len);
static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define);
static void OPC_ProcPredefs (OPT_Object obj, INT8 vis);
static void OPC_PutBase (OPT_Struct typ);
@@ -80,8 +80,8 @@ static void OPC_PutPtrOffsets (OPT_Struct typ, INT32 adr, INT32 *cnt);
static void OPC_RegCmds (OPT_Object obj);
export void OPC_SetInclude (BOOLEAN exclude);
static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
-static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x);
-static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l);
+static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x);
+static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l);
export void OPC_TDescDecl (OPT_Struct typ);
export void OPC_TypeDefs (OPT_Object obj, INT16 vis);
export void OPC_TypeOf (OPT_Object ap);
@@ -137,7 +137,7 @@ void OPC_EndBlk0 (void)
OPM_Write('}');
}
-static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
+static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x)
{
CHAR ch;
INT16 i;
@@ -156,7 +156,7 @@ static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
__DEL(s);
}
-static INT16 OPC_Length (CHAR *s, LONGINT s__len)
+static INT16 OPC_Length (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@@ -166,7 +166,7 @@ static INT16 OPC_Length (CHAR *s, LONGINT s__len)
return i;
}
-static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len)
+static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len)
{
INT16 i, h;
i = 0;
@@ -364,7 +364,7 @@ static void OPC_DeclareBase (OPT_Object dcl)
OPM_WriteString((CHAR*)"struct ", 8);
OPC_BegBlk();
OPC_BegStat();
- OPC_Str1((CHAR*)"LONGINT len[#]", 15, nofdims);
+ OPC_Str1((CHAR*)"ADDRESS len[#]", 15, nofdims);
OPC_EndStat();
OPC_BegStat();
__NEW(obj, OPT_ObjDesc);
@@ -511,7 +511,7 @@ static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamNa
typ = par->typ->BaseTyp;
while (typ->comp == 3) {
if (ansiDefine) {
- OPM_WriteString((CHAR*)", LONGINT ", 11);
+ OPM_WriteString((CHAR*)", ADDRESS ", 11);
} else {
OPM_WriteString((CHAR*)", ", 3);
}
@@ -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,12 +721,19 @@ 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();
+ }
}
}
}
}
-static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len)
+static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len)
{
INT16 i;
__DUP(y, y__len, CHAR);
@@ -968,8 +981,8 @@ static void OPC_IdentList (OPT_Object obj, INT16 vis)
if (obj->typ->comp == 3) {
OPC_EndStat();
OPC_BegStat();
- base = OPT_linttyp;
- OPM_WriteString((CHAR*)"LONGINT ", 9);
+ base = OPT_adrtyp;
+ OPM_WriteString((CHAR*)"ADDRESS ", 9);
OPC_LenList(obj, 0, 1);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPC_EndStat();
@@ -1008,7 +1021,7 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
__COPY(name, obj->name, 256);
}
if (obj->typ->comp == 3) {
- OPM_WriteString((CHAR*)", LONGINT ", 11);
+ OPM_WriteString((CHAR*)", ADDRESS ", 11);
OPC_LenList(obj, 1, showParamNames);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPM_WriteString((CHAR*)", ADDRESS *", 12);
@@ -1062,7 +1075,7 @@ static void OPC_ProcPredefs (OPT_Object obj, INT8 vis)
}
}
-static void OPC_Include (CHAR *name, LONGINT name__len)
+static void OPC_Include (CHAR *name, ADDRESS name__len)
{
__DUP(name, name__len, CHAR);
OPM_WriteString((CHAR*)"#include ", 10);
@@ -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) {
@@ -1659,9 +1672,9 @@ void OPC_CompleteIdent (OPT_Object obj)
OPC_Ident(obj);
OPM_WriteString((CHAR*)"__", 3);
} else {
- OPM_WriteString((CHAR*)"((", 3);
+ OPM_WriteString((CHAR*)"(*(", 4);
OPC_Ident(obj->typ->strobj);
- OPM_Write(')');
+ OPM_WriteString((CHAR*)"*)&", 4);
OPC_Ident(obj);
OPM_Write(')');
}
@@ -1739,12 +1752,12 @@ 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('\'');
}
}
-static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l)
+static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
{
INT32 i;
INT16 c;
@@ -1755,16 +1768,16 @@ static void OPC_StringLiteral (CHAR *s, LONGINT 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);
}
}
@@ -1912,9 +1927,9 @@ static struct InitKeywords__46 {
struct InitKeywords__46 *lnk;
} *InitKeywords__46_s;
-static void Enter__47 (CHAR *s, LONGINT s__len);
+static void Enter__47 (CHAR *s, ADDRESS s__len);
-static void Enter__47 (CHAR *s, LONGINT s__len)
+static void Enter__47 (CHAR *s, ADDRESS s__len)
{
INT16 h;
__DUP(s, s__len, CHAR);
diff --git a/bootstrap/windows-88/OPC.h b/bootstrap/windows-88/OPC.h
index 842e7dec..3bfd88b8 100644
--- a/bootstrap/windows-88/OPC.h
+++ b/bootstrap/windows-88/OPC.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 60ab38c7..b486b3b9 100644
--- a/bootstrap/windows-88/OPM.c
+++ b/bootstrap/windows-88/OPM.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,6 +8,7 @@
#include "SYSTEM.h"
#include "Configuration.h"
#include "Files.h"
+#include "Modules.h"
#include "Out.h"
#include "Platform.h"
#include "Strings.h"
@@ -18,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];
@@ -26,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;
@@ -41,41 +44,48 @@ static Files_Rider OPM_oldSF, OPM_newSF;
static Files_Rider OPM_R[3];
static Files_File OPM_oldSFile, OPM_newSFile, OPM_HFile, OPM_BFile, OPM_HIFile;
static INT16 OPM_S;
+export CHAR OPM_InstallDir[1024];
export CHAR OPM_ResourceDir[1024];
static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F);
export void OPM_CloseFiles (void);
export void OPM_CloseOldSym (void);
-export void OPM_DeleteNewSym (void);
+export void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
+export void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
export void OPM_FPrint (INT32 *fp, INT64 val);
export void OPM_FPrintLReal (INT32 *fp, LONGREAL val);
export void OPM_FPrintReal (INT32 *fp, REAL val);
export void OPM_FPrintSet (INT32 *fp, UINT64 val);
+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, LONGINT bytes__len);
+static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len);
export void OPM_Get (CHAR *ch);
-export void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
+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);
+static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len);
+export void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len);
static void OPM_LogErrMsg (INT16 n);
-export void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
+export void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len);
export void OPM_LogW (CHAR ch);
export void OPM_LogWLn (void);
export void OPM_LogWNum (INT64 i, INT64 len);
-export void OPM_LogWStr (CHAR *s, LONGINT s__len);
+export void OPM_LogWStr (CHAR *s, ADDRESS s__len);
export INT32 OPM_Longint (INT64 n);
-static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len);
+static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len);
export void OPM_Mark (INT16 n, INT32 pos);
-export void OPM_NewSym (CHAR *modName, LONGINT modName__len);
-export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
-export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
+export void OPM_NewSym (CHAR *modName, ADDRESS modName__len);
+export void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done);
+export void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len);
export BOOLEAN OPM_OpenPar (void);
export void OPM_RegisterNewSym (void);
-static void OPM_ScanOptions (CHAR *s, LONGINT s__len);
+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);
@@ -87,14 +97,13 @@ export void OPM_SymWInt (INT64 i);
export void OPM_SymWLReal (LONGREAL lr);
export void OPM_SymWReal (REAL r);
export void OPM_SymWSet (UINT64 s);
-static void OPM_VerboseListSizes (void);
export void OPM_Write (CHAR ch);
export void OPM_WriteHex (INT64 i);
export void OPM_WriteInt (INT64 i);
export void OPM_WriteLn (void);
export void OPM_WriteReal (LONGREAL r, CHAR suffx);
-export void OPM_WriteString (CHAR *s, LONGINT s__len);
-export void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
+export void OPM_WriteString (CHAR *s, ADDRESS s__len);
+export void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
export BOOLEAN OPM_eofSF (void);
export void OPM_err (INT16 n);
@@ -105,7 +114,7 @@ void OPM_LogW (CHAR ch)
Out_Char(ch);
}
-void OPM_LogWStr (CHAR *s, LONGINT s__len)
+void OPM_LogWStr (CHAR *s, ADDRESS s__len)
{
__DUP(s, s__len, CHAR);
Out_String(s, s__len);
@@ -122,7 +131,7 @@ void OPM_LogWLn (void)
Out_Ln();
}
-void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
+void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len)
{
__DUP(vt100code, vt100code__len, CHAR);
if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) {
@@ -131,6 +140,57 @@ void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
__DEL(vt100code);
}
+void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len)
+{
+ __DUP(modname, modname__len, CHAR);
+ OPM_LogWStr((CHAR*)"Compiling ", 11);
+ OPM_LogWStr(modname, modname__len);
+ if (__IN(18, OPM_Options, 32)) {
+ OPM_LogWStr((CHAR*)", s:", 5);
+ OPM_LogWNum(__ASHL(OPM_ShortintSize, 3), 1);
+ OPM_LogWStr((CHAR*)" i:", 4);
+ OPM_LogWNum(__ASHL(OPM_IntegerSize, 3), 1);
+ OPM_LogWStr((CHAR*)" l:", 4);
+ OPM_LogWNum(__ASHL(OPM_LongintSize, 3), 1);
+ OPM_LogWStr((CHAR*)" adr:", 6);
+ OPM_LogWNum(__ASHL(OPM_AddressSize, 3), 1);
+ OPM_LogWStr((CHAR*)" algn:", 7);
+ OPM_LogWNum(__ASHL(OPM_Alignment, 3), 1);
+ }
+ OPM_LogW('.');
+ __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;
@@ -154,7 +214,7 @@ INT16 OPM_Integer (INT64 n)
return __VAL(INT16, n);
}
-static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
+static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
@@ -227,29 +287,6 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
i += 2;
}
break;
- case 'B':
- if (s[__X(i + 1, s__len)] != 0x00) {
- i += 1;
- OPM_IntegerSize = (INT16)s[__X(i, s__len)] - 48;
- }
- if (s[__X(i + 1, s__len)] != 0x00) {
- i += 1;
- OPM_AddressSize = (INT16)s[__X(i, s__len)] - 48;
- }
- if (s[__X(i + 1, s__len)] != 0x00) {
- i += 1;
- OPM_Alignment = (INT16)s[__X(i, s__len)] - 48;
- }
- __ASSERT(OPM_IntegerSize == 2 || OPM_IntegerSize == 4, 0);
- __ASSERT(OPM_AddressSize == 4 || OPM_AddressSize == 8, 0);
- __ASSERT(OPM_Alignment == 4 || OPM_Alignment == 8, 0);
- if (OPM_IntegerSize == 2) {
- OPM_LongintSize = 4;
- } else {
- OPM_LongintSize = 8;
- }
- Files_SetSearchPath((CHAR*)"", 1);
- break;
default:
OPM_LogWStr((CHAR*)" warning: option ", 19);
OPM_LogW('-');
@@ -266,16 +303,19 @@ static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
BOOLEAN OPM_OpenPar (void)
{
CHAR s[256];
- if (Platform_ArgCount == 1) {
+ 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);
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Further development by Norayr Chilingarian, David Brown and others.", 68);
OPM_LogWLn();
+ OPM_LogWStr((CHAR*)"Loaded from ", 13);
+ OPM_LogWStr(Modules_BinaryDir, 1024);
+ OPM_LogWLn();
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Usage:", 7);
OPM_LogWLn();
@@ -332,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();
@@ -362,64 +402,38 @@ BOOLEAN OPM_OpenPar (void)
OPM_Options = 0xa9;
OPM_S = 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
}
OPM_GlobalAddressSize = OPM_AddressSize;
OPM_GlobalAlignment = OPM_Alignment;
- __COPY(OPM_Model, OPM_GlobalModel, 10);
+ __MOVE(OPM_Model, OPM_GlobalModel, 10);
OPM_GlobalOptions = OPM_Options;
return 1;
}
__RETCHK;
}
-static void OPM_VerboseListSizes (void)
-{
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Type Size", 15);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"SHORTINT ", 12);
- OPM_LogWNum(OPM_ShortintSize, 4);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"INTEGER ", 12);
- OPM_LogWNum(OPM_IntegerSize, 4);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"LONGINT ", 12);
- OPM_LogWNum(OPM_LongintSize, 4);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"SET ", 12);
- OPM_LogWNum(OPM_LongintSize, 4);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"ADDRESS ", 12);
- OPM_LogWNum(OPM_AddressSize, 4);
- OPM_LogWLn();
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Alignment: ", 12);
- OPM_LogWNum(OPM_Alignment, 4);
- OPM_LogWLn();
-}
-
void OPM_InitOptions (void)
{
CHAR s[256];
CHAR searchpath[1024], modules[1024];
CHAR MODULES[1024];
OPM_Options = OPM_GlobalOptions;
- __COPY(OPM_GlobalModel, OPM_Model, 10);
+ __MOVE(OPM_GlobalModel, OPM_Model, 10);
OPM_Alignment = OPM_GlobalAlignment;
OPM_AddressSize = OPM_GlobalAddressSize;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
}
if (__IN(15, OPM_Options, 32)) {
OPM_Options |= __SETOF(10,32);
@@ -430,29 +444,32 @@ 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;
}
- if (__IN(18, OPM_Options, 32)) {
- OPM_VerboseListSizes();
+ __MOVE(OPM_InstallDir, OPM_ResourceDir, 1024);
+ if (OPM_ResourceDir[0] != 0x00) {
+ Strings_Append((CHAR*)"/", 2, (void*)OPM_ResourceDir, 1024);
+ Strings_Append(OPM_Model, 10, (void*)OPM_ResourceDir, 1024);
}
- OPM_ResourceDir[0] = 0x00;
- Strings_Append((CHAR*)"/", 2, (void*)OPM_ResourceDir, 1024);
- Strings_Append(OPM_Model, 10, (void*)OPM_ResourceDir, 1024);
modules[0] = 0x00;
Platform_GetEnv((CHAR*)"MODULES", 8, (void*)modules, 1024);
__MOVE(".", searchpath, 2);
@@ -465,23 +482,22 @@ void OPM_InitOptions (void)
Files_SetSearchPath(searchpath, 1024);
}
-void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
+void OPM_Init (BOOLEAN *done)
{
Texts_Text T = NIL;
INT32 beg, end, time;
CHAR s[256];
*done = 0;
OPM_curpos = 0;
- if (OPM_S >= Platform_ArgCount) {
+ if (OPM_S >= Modules_ArgCount) {
return;
}
s[0] = 0x00;
- Platform_GetArg(OPM_S, (void*)s, 256);
+ Modules_GetArg(OPM_S, (void*)s, 256);
__NEW(T, Texts_TextDesc);
Texts_Open(T, s, 256);
OPM_LogWStr(s, 256);
OPM_LogWStr((CHAR*)" ", 3);
- __COPY(s, mname, mname__len);
__COPY(s, OPM_SourceFileName, 256);
if (T->len == 0) {
OPM_LogWStr(s, 256);
@@ -503,18 +519,14 @@ void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
void OPM_Get (CHAR *ch)
{
+ OPM_curpos = Texts_Pos(&OPM_inR, Texts_Reader__typ);
Texts_Read(&OPM_inR, Texts_Reader__typ, &*ch);
- if (*ch == 0x0d) {
- OPM_curpos = Texts_Pos(&OPM_inR, Texts_Reader__typ);
- } else {
- OPM_curpos += 1;
- }
if ((*ch < 0x09 && !OPM_inR.eot)) {
*ch = ' ';
}
}
-static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len)
+static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len)
{
INT16 i, j;
CHAR ch;
@@ -632,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;
@@ -640,7 +652,6 @@ static void OPM_ShowLine (INT64 pos)
OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogW('^');
OPM_LogVT100((CHAR*)"0m", 3);
- Files_Close(f);
}
void OPM_Mark (INT16 n, INT32 pos)
@@ -700,7 +711,7 @@ void OPM_err (INT16 n)
OPM_Mark(n, OPM_errpos);
}
-static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len)
+static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len)
{
INT16 i;
INT32 l;
@@ -772,10 +783,13 @@ void OPM_CloseOldSym (void)
Files_Close(Files_Base(&OPM_oldSF, Files_Rider__typ));
}
-void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done)
+void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done)
{
CHAR tag, ver;
OPM_FileName fileName;
+ INT16 res;
+ OPM_oldSFile = NIL;
+ *done = 0;
OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
OPM_oldSFile = Files_Old(fileName, 32);
*done = OPM_oldSFile != NIL;
@@ -783,8 +797,10 @@ void OPM_OldSym (CHAR *modName, LONGINT 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 != 0x82) {
- OPM_err(-306);
+ if (tag != 0xf7 || ver != 0x84) {
+ if (!__IN(4, OPM_Options, 32)) {
+ OPM_err(-306);
+ }
OPM_CloseOldSym();
*done = 0;
}
@@ -828,11 +844,23 @@ void OPM_RegisterNewSym (void)
}
}
-void OPM_DeleteNewSym (void)
+void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len)
{
+ OPM_FileName fn;
+ INT16 res;
+ OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".sym", 5);
+ Files_Delete(fn, 32, &res);
}
-void OPM_NewSym (CHAR *modName, LONGINT modName__len)
+void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len)
+{
+ OPM_FileName fn;
+ INT16 res;
+ OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".o", 3);
+ Files_Delete(fn, 32, &res);
+}
+
+void OPM_NewSym (CHAR *modName, ADDRESS modName__len)
{
OPM_FileName fileName;
OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
@@ -840,7 +868,7 @@ void OPM_NewSym (CHAR *modName, LONGINT 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, 0x82);
+ Files_Write(&OPM_newSF, Files_Rider__typ, 0x84);
} else {
OPM_err(153);
}
@@ -851,7 +879,7 @@ void OPM_Write (CHAR ch)
Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, ch);
}
-void OPM_WriteString (CHAR *s, LONGINT s__len)
+void OPM_WriteString (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@@ -861,7 +889,7 @@ void OPM_WriteString (CHAR *s, LONGINT s__len)
Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}
-void OPM_WriteStringVar (CHAR *s, LONGINT s__len)
+void OPM_WriteStringVar (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@@ -875,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);
@@ -893,7 +921,7 @@ void OPM_WriteHex (INT64 i)
void OPM_WriteInt (INT64 i)
{
- CHAR s[24];
+ CHAR s[26];
INT64 i1, k;
if ((i == OPM_SignedMinimum(2) || i == OPM_SignedMinimum(4)) || i == OPM_SignedMinimum(8)) {
OPM_Write('(');
@@ -901,21 +929,27 @@ void OPM_WriteInt (INT64 i)
OPM_WriteString((CHAR*)"-1)", 4);
} else {
i1 = __ABS(i);
- s[0] = (CHAR)(__MOD(i1, 10) + 48);
+ if (i1 <= 2147483647) {
+ k = 0;
+ } else {
+ __MOVE("LL", s, 3);
+ k = 2;
+ }
+ s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
- k = 1;
+ k += 1;
while (i1 > 0) {
- s[__X(k, 24)] = (CHAR)(__MOD(i1, 10) + 48);
+ s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k += 1;
}
if (i < 0) {
- s[__X(k, 24)] = '-';
+ s[__X(k, 26)] = '-';
k += 1;
}
while (k > 0) {
k -= 1;
- OPM_Write(s[__X(k, 24)]);
+ OPM_Write(s[__X(k, 26)]);
}
}
}
@@ -928,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') {
@@ -986,9 +1020,9 @@ static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F)
}
}
-void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
+void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len)
{
- CHAR FName[32];
+ OPM_FileName FName;
__COPY(moduleName, OPM_modName, 32);
OPM_HFile = Files_New((CHAR*)"", 1);
if (OPM_HFile != NIL) {
@@ -1014,7 +1048,7 @@ void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
void OPM_CloseFiles (void)
{
- CHAR FName[32];
+ OPM_FileName FName;
INT16 res;
if (OPM_noerr) {
OPM_LogWStr((CHAR*)" ", 3);
@@ -1050,6 +1084,59 @@ void OPM_CloseFiles (void)
Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, 0);
}
+static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len)
+{
+ CHAR testpath[4096];
+ Platform_FileIdentity identity;
+ __DUP(s, s__len, CHAR);
+ __COPY(OPM_InstallDir, testpath, 4096);
+ Strings_Append((CHAR*)"/lib/lib", 9, (void*)testpath, 4096);
+ Strings_Append((CHAR*)"voc", 4, (void*)testpath, 4096);
+ Strings_Append((CHAR*)"-O2.a", 6, (void*)testpath, 4096);
+ if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
+ __DEL(s);
+ return 0;
+ }
+ __COPY(OPM_InstallDir, testpath, 4096);
+ Strings_Append((CHAR*)"/2/include/Oberon.h", 20, (void*)testpath, 4096);
+ if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
+ __DEL(s);
+ return 0;
+ }
+ __COPY(OPM_InstallDir, testpath, 4096);
+ Strings_Append((CHAR*)"/2/sym/Files.sym", 17, (void*)testpath, 4096);
+ if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
+ __DEL(s);
+ return 0;
+ }
+ __DEL(s);
+ return 1;
+}
+
+static void OPM_FindInstallDir (void)
+{
+ INT16 i;
+ __COPY(Modules_BinaryDir, OPM_InstallDir, 1024);
+ Strings_Append((CHAR*)"/", 2, (void*)OPM_InstallDir, 1024);
+ Strings_Append((CHAR*)"voc", 4, (void*)OPM_InstallDir, 1024);
+ Strings_Append((CHAR*)".d", 3, (void*)OPM_InstallDir, 1024);
+ if (OPM_IsProbablyInstallDir(OPM_InstallDir, 1024)) {
+ return;
+ }
+ __COPY(Modules_BinaryDir, OPM_InstallDir, 1024);
+ i = Strings_Length(OPM_InstallDir, 1024);
+ while ((i > 0 && OPM_InstallDir[__X(i - 1, 1024)] != '/')) {
+ i -= 1;
+ }
+ if ((i > 0 && OPM_InstallDir[__X(i - 1, 1024)] == '/')) {
+ OPM_InstallDir[__X(i - 1, 1024)] = 0x00;
+ if (OPM_IsProbablyInstallDir(OPM_InstallDir, 1024)) {
+ return;
+ }
+ }
+ __COPY("", OPM_InstallDir, 1024);
+}
+
static void EnumPtrs(void (*P)(void*))
{
__ENUMR(&OPM_inR, Texts_Reader__typ, 72, 1, P);
@@ -1071,6 +1158,7 @@ export void *OPM__init(void)
__DEFMOD;
__MODULE_IMPORT(Configuration);
__MODULE_IMPORT(Files);
+ __MODULE_IMPORT(Modules);
__MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
@@ -1079,7 +1167,6 @@ export void *OPM__init(void)
__REGMOD("OPM", EnumPtrs);
__REGCMD("CloseFiles", OPM_CloseFiles);
__REGCMD("CloseOldSym", OPM_CloseOldSym);
- __REGCMD("DeleteNewSym", OPM_DeleteNewSym);
__REGCMD("InitOptions", OPM_InitOptions);
__REGCMD("LogWLn", OPM_LogWLn);
__REGCMD("RegisterNewSym", OPM_RegisterNewSym);
@@ -1089,5 +1176,8 @@ export void *OPM__init(void)
OPM_MaxLReal = 1.79769296342094e+308;
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 2d272feb..64c15a28 100644
--- a/bootstrap/windows-88/OPM.h
+++ b/bootstrap/windows-88/OPM.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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;
@@ -17,34 +17,39 @@ import INT32 OPM_curpos, OPM_errpos, OPM_breakpc;
import INT16 OPM_currFile, OPM_level, OPM_pc, OPM_entno;
import CHAR OPM_modName[32];
import CHAR OPM_objname[64];
+import CHAR OPM_InstallDir[1024];
import CHAR OPM_ResourceDir[1024];
import void OPM_CloseFiles (void);
import void OPM_CloseOldSym (void);
-import void OPM_DeleteNewSym (void);
+import void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
+import void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
import void OPM_FPrint (INT32 *fp, INT64 val);
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_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
+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);
-import void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len);
+import void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len);
+import void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len);
import void OPM_LogW (CHAR ch);
import void OPM_LogWLn (void);
import void OPM_LogWNum (INT64 i, INT64 len);
-import void OPM_LogWStr (CHAR *s, LONGINT s__len);
+import void OPM_LogWStr (CHAR *s, ADDRESS s__len);
import INT32 OPM_Longint (INT64 n);
import void OPM_Mark (INT16 n, INT32 pos);
-import void OPM_NewSym (CHAR *modName, LONGINT modName__len);
-import void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
-import void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
+import void OPM_NewSym (CHAR *modName, ADDRESS modName__len);
+import void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done);
+import void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len);
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);
@@ -61,8 +66,8 @@ import void OPM_WriteHex (INT64 i);
import void OPM_WriteInt (INT64 i);
import void OPM_WriteLn (void);
import void OPM_WriteReal (LONGREAL r, CHAR suffx);
-import void OPM_WriteString (CHAR *s, LONGINT s__len);
-import void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
+import void OPM_WriteString (CHAR *s, ADDRESS s__len);
+import void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
import BOOLEAN OPM_eofSF (void);
import void OPM_err (INT16 n);
import void *OPM__init(void);
diff --git a/bootstrap/windows-88/OPP.c b/bootstrap/windows-88/OPP.c
index df908a43..3fed2e31 100644
--- a/bootstrap/windows-88/OPP.c
+++ b/bootstrap/windows-88/OPP.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -527,7 +527,7 @@ static void OPP_selector (OPT_Node *x)
} else if (OPP_sym == 18) {
OPS_Get(&OPP_sym);
if (OPP_sym == 38) {
- __COPY(OPS_name, name, 256);
+ __MOVE(OPS_name, name, 256);
OPS_Get(&OPP_sym);
if ((*x)->typ != NIL) {
if ((*x)->typ->form == 11) {
@@ -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);
@@ -867,7 +867,7 @@ static void OPP_Receiver (INT8 *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct
} else {
*mode = 1;
}
- __COPY(OPS_name, name, 256);
+ __MOVE(OPS_name, name, 256);
OPP_CheckSym(38);
OPP_CheckSym(20);
if (OPP_sym == 38) {
@@ -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;
}
}
@@ -1030,7 +1030,7 @@ static void TProcDecl__23 (void)
}
OPP_Receiver(&objMode, objName, &objTyp, &recTyp);
if (OPP_sym == 38) {
- __COPY(OPS_name, *ProcedureDeclaration__16_s->name, 256);
+ __MOVE(OPS_name, *ProcedureDeclaration__16_s->name, 256);
OPP_CheckMark(&*ProcedureDeclaration__16_s->vis);
OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp, &*ProcedureDeclaration__16_s->fwd);
OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp->BaseTyp, &baseProc);
@@ -1129,7 +1129,7 @@ static void OPP_ProcedureDeclaration (OPT_Node *x)
TProcDecl__23();
} else if (OPP_sym == 38) {
OPT_Find(&fwd);
- __COPY(OPS_name, name, 256);
+ __MOVE(OPS_name, name, 256);
OPP_CheckMark(&vis);
if ((vis != 0 && mode == 6)) {
mode = 7;
@@ -1665,6 +1665,9 @@ static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
obj->typ = OPT_undftyp;
OPP_CheckMark(&obj->vis);
if (OPP_sym == 9) {
+ if (((((((((__STRCMP(obj->name, "SHORTINT") == 0 || __STRCMP(obj->name, "INTEGER") == 0) || __STRCMP(obj->name, "LONGINT") == 0) || __STRCMP(obj->name, "HUGEINT") == 0) || __STRCMP(obj->name, "REAL") == 0) || __STRCMP(obj->name, "LONGREAL") == 0) || __STRCMP(obj->name, "SET") == 0) || __STRCMP(obj->name, "CHAR") == 0) || __STRCMP(obj->name, "TRUE") == 0) || __STRCMP(obj->name, "FALSE") == 0) {
+ OPM_Mark(-310, OPM_curpos);
+ }
OPS_Get(&OPP_sym);
OPP_TypeDecl(&obj->typ, &obj->typ);
} else if (OPP_sym == 34 || OPP_sym == 20) {
@@ -1790,30 +1793,10 @@ void OPP_Module (OPT_Node *prog, UINT32 opt)
if (OPP_sym == 63) {
OPS_Get(&OPP_sym);
} else {
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)"Unexpected symbol found when MODULE expected:", 46);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" sym: ", 15);
- OPM_LogWNum(OPP_sym, 1);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.name: ", 15);
- OPM_LogWStr(OPS_name, 256);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.str: ", 15);
- OPM_LogWStr(OPS_str, 256);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.numtyp: ", 15);
- OPM_LogWNum(OPS_numtyp, 1);
- OPM_LogWLn();
- OPM_LogWStr((CHAR*)" OPS.intval: ", 15);
- OPM_LogWNum(OPS_intval, 1);
- OPM_LogWLn();
OPP_err(16);
}
if (OPP_sym == 38) {
- OPM_LogWStr((CHAR*)"compiling ", 11);
- OPM_LogWStr(OPS_name, 256);
- OPM_LogW('.');
+ OPM_LogCompiling(OPS_name, 256);
OPT_Init(OPS_name, opt);
OPS_Get(&OPP_sym);
OPP_CheckSym(39);
diff --git a/bootstrap/windows-88/OPP.h b/bootstrap/windows-88/OPP.h
index 5a71eb39..3d8cefe8 100644
--- a/bootstrap/windows-88/OPP.h
+++ b/bootstrap/windows-88/OPP.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 6ee700e5..a25a2c12 100644
--- a/bootstrap/windows-88/OPS.c
+++ b/bootstrap/windows-88/OPS.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,9 +196,9 @@ 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(9223372036854775807 - (INT64)d, 10)) {
+ if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) {
OPS_intval = OPS_intval * 10 + (INT64)d;
} else {
OPS_err(203);
@@ -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 1f7a3e58..19e222ac 100644
--- a/bootstrap/windows-88/OPS.h
+++ b/bootstrap/windows-88/OPS.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 a8d42b40..c3999981 100644
--- a/bootstrap/windows-88/OPT.c
+++ b/bootstrap/windows-88/OPT.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -49,6 +49,15 @@ typedef
INT8 glbmno[64];
} OPT_ImpCtxt;
+typedef
+ struct OPT_LinkDesc *OPT_Link;
+
+typedef
+ struct OPT_LinkDesc {
+ OPS_Name name;
+ OPT_Link next;
+ } OPT_LinkDesc;
+
typedef
struct OPT_NodeDesc *OPT_Node;
@@ -74,6 +83,7 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
+ OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@@ -101,6 +111,7 @@ static OPT_ExpCtxt OPT_expCtxt;
static INT32 OPT_nofhdfld;
static BOOLEAN OPT_newsf, OPT_findpc, OPT_extsf, OPT_sfpresent, OPT_symExtended, OPT_symNew;
static INT32 OPT_recno;
+export OPT_Link OPT_Links;
export ADDRESS *OPT_ConstDesc__typ;
export ADDRESS *OPT_ObjDesc__typ;
@@ -108,6 +119,7 @@ export ADDRESS *OPT_StrDesc__typ;
export ADDRESS *OPT_NodeDesc__typ;
export ADDRESS *OPT_ImpCtxt__typ;
export ADDRESS *OPT_ExpCtxt__typ;
+export ADDRESS *OPT_LinkDesc__typ;
export void OPT_Align (INT32 *adr, INT32 base);
export INT32 OPT_BaseAlignment (OPT_Struct typ);
@@ -120,7 +132,7 @@ static void OPT_EnterTyp (OPS_Name name, INT8 form, INT16 size, OPT_Struct *res)
static void OPT_EnterTypeAlias (OPS_Name name, OPT_Object *res);
export void OPT_Export (BOOLEAN *ext, BOOLEAN *new);
export void OPT_FPrintErr (OPT_Object obj, INT16 errcode);
-static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len);
+static void OPT_FPrintName (INT32 *fp, CHAR *name, ADDRESS name__len);
export void OPT_FPrintObj (OPT_Object obj);
static void OPT_FPrintSign (INT32 *fp, OPT_Struct result, OPT_Object par);
export void OPT_FPrintStr (OPT_Struct typ);
@@ -131,8 +143,9 @@ export void OPT_IdFPrint (OPT_Struct typ);
export void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done);
static void OPT_InConstant (INT32 f, OPT_Const conval);
static OPT_Object OPT_InFld (void);
+static void OPT_InLinks (void);
static void OPT_InMod (INT8 *mno);
-static void OPT_InName (CHAR *name, LONGINT name__len);
+static void OPT_InName (CHAR *name, ADDRESS name__len);
static OPT_Object OPT_InObj (INT8 mno);
static void OPT_InSign (INT8 mno, OPT_Struct *res, OPT_Object *par);
static void OPT_InStruct (OPT_Struct *typ);
@@ -154,12 +167,14 @@ export void OPT_OpenScope (INT8 level, OPT_Object owner);
static void OPT_OutConstant (OPT_Object obj);
static void OPT_OutFlds (OPT_Object fld, INT32 adr, BOOLEAN visible);
static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr);
+static void OPT_OutLinks (void);
static void OPT_OutMod (INT16 mno);
-static void OPT_OutName (CHAR *name, LONGINT name__len);
+static void OPT_OutName (CHAR *name, ADDRESS name__len);
static void OPT_OutObj (OPT_Object obj);
static void OPT_OutSign (OPT_Struct result, OPT_Object par);
static void OPT_OutStr (OPT_Struct typ);
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj);
+static void OPT_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);
@@ -339,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;
@@ -375,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;
}
@@ -434,14 +453,16 @@ void OPT_Init (OPS_Name name, UINT32 opt)
OPT_topScope = OPT_universe;
OPT_OpenScope(0, NIL);
OPT_SYSimported = 0;
- __COPY(name, OPT_SelfName, 256);
- __COPY(name, OPT_topScope->name, 256);
+ __MOVE(name, OPT_SelfName, 256);
+ __MOVE(name, OPT_topScope->name, 256);
OPT_GlbMod[0] = OPT_topScope;
OPT_nofGmod = 1;
OPT_newsf = __IN(4, opt, 32);
OPT_findpc = __IN(8, opt, 32);
OPT_extsf = OPT_newsf || __IN(9, opt, 32);
OPT_sfpresent = 1;
+ __NEW(OPT_Links, OPT_LinkDesc);
+ __MOVE(name, OPT_Links->name, 256);
}
void OPT_Close (void)
@@ -539,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;
@@ -570,13 +593,23 @@ 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;
}
}
*obj = ob1;
}
-static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len)
+static void OPT_FPrintName (INT32 *fp, CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@@ -957,7 +990,7 @@ void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old)
}
}
-static void OPT_InName (CHAR *name, LONGINT name__len)
+static void OPT_InName (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@@ -1011,6 +1044,26 @@ static void OPT_InMod (INT8 *mno)
}
}
+static void OPT_InLinks (void)
+{
+ OPS_Name linkname;
+ OPT_Link l = NIL;
+ OPT_InName((void*)linkname, 256);
+ while (linkname[0] != 0x00) {
+ l = OPT_Links;
+ while ((l != NIL && __STRCMP(l->name, linkname) != 0)) {
+ l = l->next;
+ }
+ if (l == NIL) {
+ l = OPT_Links;
+ __NEW(OPT_Links, OPT_LinkDesc);
+ OPT_Links->next = l;
+ __MOVE(linkname, OPT_Links->name, 256);
+ }
+ OPT_InName((void*)linkname, 256);
+ }
+}
+
static void OPT_InConstant (INT32 f, OPT_Const conval)
{
CHAR ch;
@@ -1068,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) {
@@ -1186,7 +1246,7 @@ static void OPT_InStruct (OPT_Struct *typ)
}
*typ = OPT_NewStr(0, 1);
} else {
- __COPY(name, obj->name, 256);
+ __MOVE(name, obj->name, 256);
OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
if (old != NIL) {
OPT_FPrintObj(old);
@@ -1216,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) {
@@ -1346,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;
@@ -1362,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);
@@ -1377,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)]);
@@ -1389,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);
@@ -1458,9 +1565,15 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
OPT_impCtxt.nofm = 0;
OPT_impCtxt.self = __STRCMP(aliasName, "@self") == 0;
OPT_impCtxt.reffp = 0;
- OPM_OldSym((void*)name, 256, &*done);
+ if ((OPT_impCtxt.self && __IN(17, OPM_Options, 32))) {
+ OPM_DeleteSym((void*)name, 256);
+ *done = 0;
+ } else {
+ OPM_OldSym((void*)name, 256, &*done);
+ }
if (*done) {
OPT_InMod(&mno);
+ OPT_InLinks();
OPT_impCtxt.nextTag = OPM_SymRInt();
while (!OPM_eofSF()) {
obj = OPT_InObj(mno);
@@ -1483,7 +1596,7 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
}
}
-static void OPT_OutName (CHAR *name, LONGINT name__len)
+static void OPT_OutName (CHAR *name, ADDRESS name__len)
{
INT16 i;
CHAR ch;
@@ -1507,6 +1620,17 @@ static void OPT_OutMod (INT16 mno)
}
}
+static void OPT_OutLinks (void)
+{
+ OPT_Link l = NIL;
+ l = OPT_Links;
+ while (l != NIL) {
+ OPT_OutName((void*)l->name, 256);
+ l = l->next;
+ }
+ OPM_SymWCh(0x00);
+}
+
static void OPT_OutHdFld (OPT_Struct typ, OPT_Object fld, INT32 adr)
{
INT32 i, j, n;
@@ -1700,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);
@@ -1728,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) {
@@ -1833,6 +1984,7 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
if (OPM_noerr) {
OPM_SymWInt(16);
OPT_OutName((void*)OPT_SelfName, 256);
+ OPT_OutLinks();
OPT_expCtxt.reffp = 0;
OPT_expCtxt.ref = 14;
OPT_expCtxt.nofm = 1;
@@ -1854,7 +2006,7 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
OPT_newsf = 0;
OPT_symNew = 0;
if (!OPM_noerr || OPT_findpc) {
- OPM_DeleteNewSym();
+ OPM_DeleteSym((void*)OPT_SelfName, 256);
}
}
}
@@ -1969,10 +2121,11 @@ static void EnumPtrs(void (*P)(void*))
P(OPT_universe);
P(OPT_syslink);
__ENUMR(&OPT_impCtxt, OPT_ImpCtxt__typ, 5184, 1, P);
+ P(OPT_Links);
}
__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,
@@ -2008,6 +2161,7 @@ __TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 5184), {16, 24, 32, 40, 48,
3856, 3864, 3872, 3880, 3888, 3896, 3904, 3912, 3920, 3928, 3936, 3944, 3952, 3960, 3968, 3976,
3984, 3992, 4000, 4008, 4016, 4024, 4032, 4040, 4048, 4056, 4064, 4072, 4080, 4088, -4088}};
__TDESC(OPT_ExpCtxt, 1, 0) = {__TDFLDS("ExpCtxt", 72), {-8}};
+__TDESC(OPT_LinkDesc, 1, 1) = {__TDFLDS("LinkDesc", 264), {256, -16}};
export void *OPT__init(void)
{
@@ -2024,6 +2178,7 @@ export void *OPT__init(void)
__INITYP(OPT_NodeDesc, OPT_NodeDesc, 0);
__INITYP(OPT_ImpCtxt, OPT_ImpCtxt, 0);
__INITYP(OPT_ExpCtxt, OPT_ExpCtxt, 0);
+ __INITYP(OPT_LinkDesc, OPT_LinkDesc, 0);
/* BEGIN */
OPT_topScope = NIL;
OPT_OpenScope(0, NIL);
diff --git a/bootstrap/windows-88/OPT.h b/bootstrap/windows-88/OPT.h
index 90fcacf5..cf456af5 100644
--- a/bootstrap/windows-88/OPT.h
+++ b/bootstrap/windows-88/OPT.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -21,6 +21,15 @@ typedef
LONGREAL realval;
} OPT_ConstDesc;
+typedef
+ struct OPT_LinkDesc *OPT_Link;
+
+typedef
+ struct OPT_LinkDesc {
+ OPS_Name name;
+ OPT_Link next;
+ } OPT_LinkDesc;
+
typedef
struct OPT_NodeDesc *OPT_Node;
@@ -52,6 +61,7 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
+ OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@@ -75,11 +85,13 @@ import INT8 OPT_nofGmod;
import OPT_Object OPT_GlbMod[64];
import OPS_Name OPT_SelfName;
import BOOLEAN OPT_SYSimported;
+import OPT_Link OPT_Links;
import ADDRESS *OPT_ConstDesc__typ;
import ADDRESS *OPT_ObjDesc__typ;
import ADDRESS *OPT_StrDesc__typ;
import ADDRESS *OPT_NodeDesc__typ;
+import ADDRESS *OPT_LinkDesc__typ;
import void OPT_Align (INT32 *adr, INT32 base);
import INT32 OPT_BaseAlignment (OPT_Struct typ);
diff --git a/bootstrap/windows-88/OPV.c b/bootstrap/windows-88/OPV.c
index 4bd6b3fb..26c1c715 100644
--- a/bootstrap/windows-88/OPV.c
+++ b/bootstrap/windows-88/OPV.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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));
@@ -163,7 +163,7 @@ static void OPV_Traverse (OPT_Object obj, OPT_Object outerScope, BOOLEAN exporte
}
scope = obj->scope;
scope->leaf = 1;
- __COPY(obj->name, scope->name, 256);
+ __MOVE(obj->name, scope->name, 256);
OPV_Stamp(scope->name);
if (mode == 9) {
obj->adr = 1;
@@ -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);
@@ -1286,7 +1297,17 @@ static void OPV_stat (OPT_Node n, OPT_Object outerProc)
OPM_WriteString((CHAR*)", ", 3);
if (r->typ == OPT_stringtyp) {
OPM_WriteInt(r->conval->intval2);
+ } else if (r->typ->comp == 3) {
+ OPM_WriteString((CHAR*)"__X(", 5);
+ OPC_Len(r->obj, r->typ, 0);
+ OPM_WriteString((CHAR*)" * ", 4);
+ OPM_WriteInt(r->typ->BaseTyp->size);
+ OPM_WriteString((CHAR*)", ", 3);
+ OPM_WriteInt(l->typ->size + 1);
+ OPM_Write(')');
} else {
+ __ASSERT(r->typ->comp == 2, 0);
+ __ASSERT(r->typ->size <= l->typ->size, 0);
OPM_WriteInt(r->typ->size);
}
OPM_Write(')');
diff --git a/bootstrap/windows-88/OPV.h b/bootstrap/windows-88/OPV.h
index c4a61586..fbabd8f4 100644
--- a/bootstrap/windows-88/OPV.h
+++ b/bootstrap/windows-88/OPV.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 720267fd..b43e55f1 100644
--- a/bootstrap/windows-88/Out.c
+++ b/bootstrap/windows-88/Out.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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 "Heap.h"
#include "Platform.h"
@@ -16,17 +17,18 @@ static INT16 Out_in;
export void Out_Char (CHAR ch);
export void Out_Flush (void);
+export void Out_Hex (INT64 x, INT64 n);
export void Out_Int (INT64 x, INT64 n);
-static INT32 Out_Length (CHAR *s, LONGINT s__len);
+static INT32 Out_Length (CHAR *s, ADDRESS s__len);
export void Out_Ln (void);
export void Out_LongReal (LONGREAL x, INT16 n);
export void Out_Open (void);
export void Out_Real (REAL x, INT16 n);
static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_);
-export void Out_String (CHAR *str, LONGINT str__len);
+export void Out_String (CHAR *str, ADDRESS str__len);
export LONGREAL Out_Ten (INT16 e);
-static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i);
-static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i);
+static void Out_digit (INT64 n, CHAR *s, ADDRESS s__len, INT16 *i);
+static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i);
#define Out_Entier64(x) (INT64)(x)
@@ -55,7 +57,7 @@ void Out_Char (CHAR ch)
}
}
-static INT32 Out_Length (CHAR *s, LONGINT s__len)
+static INT32 Out_Length (CHAR *s, ADDRESS s__len)
{
INT32 l;
l = 0;
@@ -65,7 +67,7 @@ static INT32 Out_Length (CHAR *s, LONGINT s__len)
return l;
}
-void Out_String (CHAR *str, LONGINT str__len)
+void Out_String (CHAR *str, ADDRESS str__len)
{
INT32 l;
INT16 error;
@@ -78,7 +80,7 @@ void Out_String (CHAR *str, LONGINT 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);
}
@@ -89,18 +91,18 @@ void Out_Int (INT64 x, INT64 n)
INT16 i;
BOOLEAN negative;
negative = x < 0;
- if (x == (-9223372036854775807-1)) {
+ if (x == (-9223372036854775807LL-1)) {
__MOVE("8085774586302733229", s, 20);
i = 19;
} else {
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;
}
@@ -119,19 +121,43 @@ void Out_Int (INT64 x, INT64 n)
}
}
+void Out_Hex (INT64 x, INT64 n)
+{
+ if (n < 1) {
+ n = 1;
+ } else if (n > 16) {
+ n = 16;
+ }
+ if (x >= 0) {
+ while ((n < 16 && __LSH(x, -__ASHL(n, 2), 64) != 0)) {
+ n += 1;
+ }
+ }
+ x = __ROT(x, __ASHL(16 - n, 2), 64);
+ while (n > 0) {
+ x = __ROTL(x, 4, 64);
+ n -= 1;
+ if (__MASK(x, -16) < 10) {
+ Out_Char(__CHR(__MASK(x, -16) + 48));
+ } else {
+ Out_Char(__CHR((__MASK(x, -16) - 10) + 65));
+ }
+ }
+}
+
void Out_Ln (void)
{
Out_String(Platform_NL, 3);
Out_Flush();
}
-static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i)
+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, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i)
+static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i)
{
INT16 j;
INT32 l;
@@ -140,7 +166,7 @@ static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT 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)];
@@ -175,7 +201,7 @@ static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_)
INT64 m;
INT16 d, dr;
e = (INT16)__MASK(__ASHR((__VAL(INT64, x)), 52), -2048);
- f = __MASK((__VAL(INT64, x)), -4503599627370496);
+ f = __MASK((__VAL(INT64, x)), -4503599627370496LL);
nn = (__VAL(INT64, x) < 0 && !((e == 2047 && f != 0)));
if (nn) {
n -= 1;
@@ -222,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 {
@@ -306,6 +332,7 @@ void Out_LongReal (LONGREAL x, INT16 n)
export void *Out__init(void)
{
__DEFMOD;
+ __MODULE_IMPORT(Heap);
__MODULE_IMPORT(Platform);
__REGMOD("Out", 0);
__REGCMD("Flush", Out_Flush);
diff --git a/bootstrap/windows-88/Out.h b/bootstrap/windows-88/Out.h
index 0e66420d..a72547f4 100644
--- a/bootstrap/windows-88/Out.h
+++ b/bootstrap/windows-88/Out.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -11,12 +11,13 @@ import BOOLEAN Out_IsConsole;
import void Out_Char (CHAR ch);
import void Out_Flush (void);
+import void Out_Hex (INT64 x, INT64 n);
import void Out_Int (INT64 x, INT64 n);
import void Out_Ln (void);
import void Out_LongReal (LONGREAL x, INT16 n);
import void Out_Open (void);
import void Out_Real (REAL x, INT16 n);
-import void Out_String (CHAR *str, LONGINT str__len);
+import void Out_String (CHAR *str, ADDRESS str__len);
import LONGREAL Out_Ten (INT16 e);
import void *Out__init(void);
diff --git a/bootstrap/windows-88/Platform.c b/bootstrap/windows-88/Platform.c
index 1e93deb2..563f6417 100644
--- a/bootstrap/windows-88/Platform.c
+++ b/bootstrap/windows-88/Platform.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,49 +7,27 @@
#include "SYSTEM.h"
-typedef
- CHAR (*Platform_ArgPtr)[1024];
-
-typedef
- Platform_ArgPtr (*Platform_ArgVec)[1024];
-
-typedef
- INT64 (*Platform_ArgVecPtr)[1];
-
-typedef
- CHAR (*Platform_EnvPtr)[1024];
-
typedef
struct Platform_FileIdentity {
INT32 volume, indexhigh, indexlow, mtimehigh, mtimelow;
} Platform_FileIdentity;
-typedef
- void (*Platform_HaltProcedure)(INT32);
-
typedef
void (*Platform_SignalHandler)(INT32);
export BOOLEAN Platform_LittleEndian;
-export INT64 Platform_MainStackFrame;
-export INT32 Platform_HaltCode;
export INT16 Platform_PID;
export CHAR Platform_CWD[4096];
-export INT16 Platform_ArgCount;
-export INT64 Platform_ArgVector;
-static Platform_HaltProcedure Platform_HaltHandler;
static INT32 Platform_TimeStart;
export INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
export INT64 Platform_StdIn, Platform_StdOut, Platform_StdErr;
-static Platform_SignalHandler Platform_InterruptHandler;
export CHAR Platform_NL[3];
export ADDRESS *Platform_FileIdentity__typ;
export BOOLEAN Platform_Absent (INT16 e);
-export INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
-export INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
+export INT16 Platform_Chdir (CHAR *n, ADDRESS n__len);
export INT16 Platform_Close (INT64 h);
export BOOLEAN Platform_ConnectionFailed (INT16 e);
export void Platform_Delay (INT32 ms);
@@ -57,27 +35,26 @@ export BOOLEAN Platform_DifferentFilesystems (INT16 e);
static void Platform_EnableVT100 (void);
export INT16 Platform_Error (void);
export void Platform_Exit (INT32 code);
-export void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
export void Platform_GetClock (INT32 *t, INT32 *d);
-export void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
-export void Platform_GetIntArg (INT16 n, INT32 *val);
+export void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
export void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec);
export INT16 Platform_Identify (INT64 h, Platform_FileIdentity *identity, ADDRESS *identity__typ);
-export INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
+export INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
export BOOLEAN Platform_Inaccessible (INT16 e);
-export void Platform_Init (INT32 argc, INT64 argvadr);
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_New (CHAR *n, LONGINT n__len, INT64 *h);
+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);
export void Platform_OSFree (INT64 address);
-export INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT64 *h);
-export INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT64 *h);
+export INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT64 *h);
+export INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT64 *h);
export INT16 Platform_Read (INT64 h, INT64 p, INT32 l, INT32 *n);
-export INT16 Platform_ReadBuf (INT64 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n);
-export INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
+export INT16 Platform_ReadBuf (INT64 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n);
+export INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len);
export BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2);
export BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2);
export INT16 Platform_Seek (INT64 h, INT32 o, INT16 r);
@@ -85,16 +62,16 @@ export void Platform_SetBadInstructionHandler (Platform_SignalHandler handler);
export void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__typ, Platform_FileIdentity source);
export INT16 Platform_Size (INT64 h, INT32 *l);
export INT16 Platform_Sync (INT64 h);
-export INT16 Platform_System (CHAR *cmd, LONGINT cmd__len);
+export INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len);
static void Platform_TestLittleEndian (void);
export INT32 Platform_Time (void);
export BOOLEAN Platform_TimedOut (INT16 e);
export BOOLEAN Platform_TooManyFiles (INT16 e);
export INT16 Platform_Truncate (INT64 h, INT32 limit);
-export INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
+export INT16 Platform_Unlink (CHAR *n, ADDRESS n__len);
export INT16 Platform_Write (INT64 h, INT64 p, INT32 l);
static void Platform_YMDHMStoClock (INT16 ye, INT16 mo, INT16 da, INT16 ho, INT16 mi, INT16 se, INT32 *t, INT32 *d);
-export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
+export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
#include "WindowsWrapper.h"
#define Platform_ECONNABORTED() WSAECONNABORTED
@@ -111,10 +88,9 @@ export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT
#define Platform_ERRORTOOMANYOPENFILES() ERROR_TOO_MANY_OPEN_FILES
#define Platform_ERRORWRITEPROTECT() ERROR_WRITE_PROTECT
#define Platform_ETIMEDOUT() WSAETIMEDOUT
-extern void Heap_InitHeap();
#define Platform_GetConsoleMode(h, m) GetConsoleMode((HANDLE)h, (DWORD*)m)
#define Platform_GetTickCount() (LONGINT)(UINT32)GetTickCount()
-#define Platform_HeapInitHeap() Heap_InitHeap()
+#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)
@@ -151,9 +127,9 @@ extern void Heap_InitHeap();
#define Platform_largeInteger() LARGE_INTEGER li
#define Platform_liLongint() (LONGINT)li.QuadPart
#define Platform_moveFile(o, o__len, n, n__len) (INTEGER)MoveFileEx((char*)o, (char*)n, MOVEFILE_REPLACE_EXISTING)
-#define Platform_opennew(n, n__len) (ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
-#define Platform_openro(n, n__len) (ADDRESS)CreateFile((char*)n, GENERIC_READ , FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
-#define Platform_openrw(n, n__len) (ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
+#define Platform_opennew(n, n__len) (ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE|FILE_SHARE_DELETE, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
+#define Platform_openro(n, n__len) (ADDRESS)CreateFile((char*)n, GENERIC_READ , FILE_SHARE_READ|FILE_SHARE_WRITE|FILE_SHARE_DELETE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
+#define Platform_openrw(n, n__len) (ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE|FILE_SHARE_DELETE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
#define Platform_processInfo() PROCESS_INFORMATION pi = {0};
#define Platform_readfile(fd, p, l, n) (INTEGER)ReadFile((HANDLE)fd, (void*)p, (DWORD)l, (DWORD*)n, 0)
#define Platform_seekcur() FILE_CURRENT
@@ -218,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);
@@ -228,18 +214,7 @@ void Platform_OSFree (INT64 address)
Platform_free(address);
}
-void Platform_Init (INT32 argc, INT64 argvadr)
-{
- Platform_ArgVecPtr av = NIL;
- Platform_MainStackFrame = argvadr;
- Platform_ArgCount = __VAL(INT16, argc);
- av = (Platform_ArgVecPtr)(ADDRESS)argvadr;
- Platform_ArgVector = (*av)[0];
- Platform_HaltCode = -128;
- Platform_HeapInitHeap();
-}
-
-BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
+BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{
CHAR buf[4096];
INT16 res;
@@ -256,7 +231,7 @@ BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__le
__RETCHK;
}
-void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
+void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
{
__DUP(var, var__len, CHAR);
if (!Platform_getEnv(var, var__len, (void*)val, val__len)) {
@@ -265,56 +240,6 @@ void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
__DEL(var);
}
-void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len)
-{
- Platform_ArgVec av = NIL;
- if (n < Platform_ArgCount) {
- av = (Platform_ArgVec)(ADDRESS)Platform_ArgVector;
- __COPY(*(*av)[__X(n, 1024)], val, val__len);
- }
-}
-
-void Platform_GetIntArg (INT16 n, INT32 *val)
-{
- CHAR s[64];
- INT32 k, d, i;
- s[0] = 0x00;
- Platform_GetArg(n, (void*)s, 64);
- i = 0;
- if (s[0] == '-') {
- i = 1;
- }
- k = 0;
- d = (INT16)s[__X(i, 64)] - 48;
- while ((d >= 0 && d <= 9)) {
- k = k * 10 + d;
- i += 1;
- d = (INT16)s[__X(i, 64)] - 48;
- }
- if (s[0] == '-') {
- k = -k;
- i -= 1;
- }
- if (i > 0) {
- *val = k;
- }
-}
-
-INT16 Platform_ArgPos (CHAR *s, LONGINT s__len)
-{
- INT16 i;
- CHAR arg[256];
- __DUP(s, s__len, CHAR);
- i = 0;
- Platform_GetArg(i, (void*)arg, 256);
- while ((i < Platform_ArgCount && __STRCMP(s, arg) != 0)) {
- i += 1;
- Platform_GetArg(i, (void*)arg, 256);
- }
- __DEL(s);
- return i;
-}
-
void Platform_SetBadInstructionHandler (Platform_SignalHandler handler)
{
}
@@ -359,7 +284,7 @@ void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec)
*usec = Platform_uluSec();
}
-INT16 Platform_System (CHAR *cmd, LONGINT cmd__len)
+INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len)
{
INT16 result;
__DUP(cmd, cmd__len, CHAR);
@@ -381,7 +306,7 @@ INT16 Platform_Error (void)
return Platform_err();
}
-INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT64 *h)
+INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT64 *h)
{
INT64 fd;
fd = Platform_openro(n, n__len);
@@ -394,7 +319,7 @@ INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT64 *h)
__RETCHK;
}
-INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT64 *h)
+INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT64 *h)
{
INT64 fd;
fd = Platform_openrw(n, n__len);
@@ -407,7 +332,7 @@ INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT64 *h)
__RETCHK;
}
-INT16 Platform_New (CHAR *n, LONGINT n__len, INT64 *h)
+INT16 Platform_New (CHAR *n, ADDRESS n__len, INT64 *h)
{
INT64 fd;
fd = Platform_opennew(n, n__len);
@@ -444,7 +369,7 @@ INT16 Platform_Identify (INT64 h, Platform_FileIdentity *identity, ADDRESS *iden
return 0;
}
-INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
+INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{
INT64 h;
INT16 e, i;
@@ -508,7 +433,7 @@ INT16 Platform_Read (INT64 h, INT64 p, INT32 l, INT32 *n)
__RETCHK;
}
-INT16 Platform_ReadBuf (INT64 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n)
+INT16 Platform_ReadBuf (INT64 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n)
{
INT16 result;
INT32 lengthread;
@@ -580,7 +505,7 @@ INT16 Platform_Truncate (INT64 h, INT32 limit)
return 0;
}
-INT16 Platform_Unlink (CHAR *n, LONGINT n__len)
+INT16 Platform_Unlink (CHAR *n, ADDRESS n__len)
{
if (Platform_deleteFile(n, n__len) == 0) {
return Platform_err();
@@ -590,7 +515,7 @@ INT16 Platform_Unlink (CHAR *n, LONGINT n__len)
__RETCHK;
}
-INT16 Platform_Chdir (CHAR *n, LONGINT n__len)
+INT16 Platform_Chdir (CHAR *n, ADDRESS n__len)
{
INT16 r;
r = Platform_setCurrentDirectory(n, n__len);
@@ -601,7 +526,7 @@ INT16 Platform_Chdir (CHAR *n, LONGINT n__len)
return 0;
}
-INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len)
+INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len)
{
if (Platform_moveFile(o, o__len, n, n__len) == 0) {
return Platform_err();
@@ -646,8 +571,6 @@ export void *Platform__init(void)
__INITYP(Platform_FileIdentity, Platform_FileIdentity, 0);
/* BEGIN */
Platform_TestLittleEndian();
- Platform_HaltCode = -128;
- Platform_HaltHandler = NIL;
Platform_TimeStart = 0;
Platform_TimeStart = Platform_Time();
Platform_CWD[0] = 0x00;
diff --git a/bootstrap/windows-88/Platform.h b/bootstrap/windows-88/Platform.h
index f6a5d008..1259a228 100644
--- a/bootstrap/windows-88/Platform.h
+++ b/bootstrap/windows-88/Platform.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -16,12 +16,8 @@ typedef
import BOOLEAN Platform_LittleEndian;
-import INT64 Platform_MainStackFrame;
-import INT32 Platform_HaltCode;
import INT16 Platform_PID;
import CHAR Platform_CWD[4096];
-import INT16 Platform_ArgCount;
-import INT64 Platform_ArgVector;
import INT16 Platform_SeekSet, Platform_SeekCur, Platform_SeekEnd;
import INT64 Platform_StdIn, Platform_StdOut, Platform_StdErr;
import CHAR Platform_NL[3];
@@ -29,35 +25,33 @@ import CHAR Platform_NL[3];
import ADDRESS *Platform_FileIdentity__typ;
import BOOLEAN Platform_Absent (INT16 e);
-import INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
-import INT16 Platform_Chdir (CHAR *n, LONGINT n__len);
+import INT16 Platform_Chdir (CHAR *n, ADDRESS n__len);
import INT16 Platform_Close (INT64 h);
import BOOLEAN Platform_ConnectionFailed (INT16 e);
import void Platform_Delay (INT32 ms);
import BOOLEAN Platform_DifferentFilesystems (INT16 e);
import INT16 Platform_Error (void);
import void Platform_Exit (INT32 code);
-import void Platform_GetArg (INT16 n, CHAR *val, LONGINT val__len);
import void Platform_GetClock (INT32 *t, INT32 *d);
-import void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
-import void Platform_GetIntArg (INT16 n, INT32 *val);
+import void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
import void Platform_GetTimeOfDay (INT32 *sec, INT32 *usec);
import INT16 Platform_Identify (INT64 h, Platform_FileIdentity *identity, ADDRESS *identity__typ);
-import INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
+import INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
import BOOLEAN Platform_Inaccessible (INT16 e);
-import void Platform_Init (INT32 argc, INT64 argvadr);
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_New (CHAR *n, LONGINT n__len, INT64 *h);
+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);
import void Platform_OSFree (INT64 address);
-import INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT64 *h);
-import INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT64 *h);
+import INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT64 *h);
+import INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT64 *h);
import INT16 Platform_Read (INT64 h, INT64 p, INT32 l, INT32 *n);
-import INT16 Platform_ReadBuf (INT64 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n);
-import INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len);
+import INT16 Platform_ReadBuf (INT64 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n);
+import INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len);
import BOOLEAN Platform_SameFile (Platform_FileIdentity i1, Platform_FileIdentity i2);
import BOOLEAN Platform_SameFileTime (Platform_FileIdentity i1, Platform_FileIdentity i2);
import INT16 Platform_Seek (INT64 h, INT32 o, INT16 r);
@@ -65,14 +59,14 @@ import void Platform_SetBadInstructionHandler (Platform_SignalHandler handler);
import void Platform_SetMTime (Platform_FileIdentity *target, ADDRESS *target__typ, Platform_FileIdentity source);
import INT16 Platform_Size (INT64 h, INT32 *l);
import INT16 Platform_Sync (INT64 h);
-import INT16 Platform_System (CHAR *cmd, LONGINT cmd__len);
+import INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len);
import INT32 Platform_Time (void);
import BOOLEAN Platform_TimedOut (INT16 e);
import BOOLEAN Platform_TooManyFiles (INT16 e);
import INT16 Platform_Truncate (INT64 h, INT32 limit);
-import INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
+import INT16 Platform_Unlink (CHAR *n, ADDRESS n__len);
import INT16 Platform_Write (INT64 h, INT64 p, INT32 l);
-import BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
+import BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
import void *Platform__init(void);
#define Platform_SetInterruptHandler(h) SystemSetInterruptHandler((ADDRESS)h)
diff --git a/bootstrap/windows-88/Reals.c b/bootstrap/windows-88/Reals.c
index cd4c3c61..512ec2c4 100644
--- a/bootstrap/windows-88/Reals.c
+++ b/bootstrap/windows-88/Reals.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -10,11 +10,11 @@
-static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len);
-export void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len);
-export void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len);
-export void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len);
-export void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len);
+static void Reals_BytesToHex (SYSTEM_BYTE *b, ADDRESS b__len, SYSTEM_BYTE *d, ADDRESS d__len);
+export void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len);
+export void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len);
+export void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len);
+export void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len);
export INT16 Reals_Expo (REAL x);
export INT16 Reals_ExpoL (LONGREAL x);
export void Reals_SetExpo (REAL *x, INT16 ex);
@@ -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)
@@ -79,7 +79,7 @@ INT16 Reals_ExpoL (LONGREAL x)
return __MASK(__ASHR(i, 4), -2048);
}
-void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len)
+void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len)
{
INT32 i, j, k;
if (x < (LONGREAL)0) {
@@ -87,27 +87,27 @@ void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT 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;
}
}
-void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len)
+void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len)
{
Reals_ConvertL(x, n, (void*)d, d__len);
}
@@ -115,14 +115,14 @@ void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT 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;
}
-static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len)
+static void Reals_BytesToHex (SYSTEM_BYTE *b, ADDRESS b__len, SYSTEM_BYTE *d, ADDRESS d__len)
{
INT16 i;
INT32 l;
@@ -137,12 +137,12 @@ static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LO
}
}
-void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len)
+void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len)
{
Reals_BytesToHex((void*)&y, 4, (void*)d, d__len * 1);
}
-void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len)
+void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len)
{
Reals_BytesToHex((void*)&x, 8, (void*)d, d__len * 1);
}
diff --git a/bootstrap/windows-88/Reals.h b/bootstrap/windows-88/Reals.h
index f0c84ab1..93e7fa75 100644
--- a/bootstrap/windows-88/Reals.h
+++ b/bootstrap/windows-88/Reals.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -8,10 +8,10 @@
-import void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len);
-import void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len);
-import void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len);
-import void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len);
+import void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len);
+import void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len);
+import void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len);
+import void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len);
import INT16 Reals_Expo (REAL x);
import INT16 Reals_ExpoL (LONGREAL x);
import void Reals_SetExpo (REAL *x, INT16 ex);
diff --git a/bootstrap/windows-88/Strings.c b/bootstrap/windows-88/Strings.c
index b5707327..4b18812f 100644
--- a/bootstrap/windows-88/Strings.c
+++ b/bootstrap/windows-88/Strings.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,22 +6,25 @@
#define SET UINT32
#include "SYSTEM.h"
+#include "Reals.h"
-export void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
-export void Strings_Cap (CHAR *s, LONGINT s__len);
-export void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n);
-export void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len);
-export void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
-export INT16 Strings_Length (CHAR *s, LONGINT s__len);
-export BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len);
-export INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos);
-export void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
+export void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len);
+export void Strings_Cap (CHAR *s, ADDRESS s__len);
+export void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n);
+export void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len);
+export void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len);
+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, LONGINT s__len)
+INT16 Strings_Length (CHAR *s, ADDRESS s__len)
{
INT32 i;
__DUP(s, s__len, CHAR);
@@ -31,7 +34,7 @@ INT16 Strings_Length (CHAR *s, LONGINT s__len)
}
if (i <= 32767) {
__DEL(s);
- return (INT16)i;
+ return __SHORT(i, 32768);
} else {
__DEL(s);
return 32767;
@@ -39,7 +42,7 @@ INT16 Strings_Length (CHAR *s, LONGINT s__len)
__RETCHK;
}
-void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len)
+void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len)
{
INT16 n1, n2, i;
__DUP(extra, extra__len, CHAR);
@@ -56,7 +59,7 @@ void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__
__DEL(extra);
}
-void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
+void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
{
INT16 n1, n2, i;
__DUP(source, source__len, CHAR);
@@ -87,7 +90,7 @@ void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, L
__DEL(source);
}
-void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n)
+void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n)
{
INT16 len, i;
len = Strings_Length(s, s__len);
@@ -110,7 +113,7 @@ void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n)
}
}
-void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
+void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
{
__DUP(source, source__len, CHAR);
Strings_Delete((void*)dest, dest__len, pos, pos + Strings_Length(source, source__len));
@@ -118,12 +121,12 @@ void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest,
__DEL(source);
}
-void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len)
+void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len)
{
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;
}
@@ -143,7 +146,7 @@ void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHA
__DEL(source);
}
-INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos)
+INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos)
{
INT16 n1, n2, i, j;
__DUP(pattern, pattern__len, CHAR);
@@ -175,7 +178,7 @@ INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len,
return -1;
}
-void Strings_Cap (CHAR *s, LONGINT s__len)
+void Strings_Cap (CHAR *s, ADDRESS s__len)
{
INT16 i;
i = 0;
@@ -191,9 +194,9 @@ static struct Match__7 {
struct Match__7 *lnk;
} *Match__7_s;
-static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m);
+static BOOLEAN M__8 (CHAR *name, ADDRESS name__len, CHAR *mask, ADDRESS mask__len, INT16 n, INT16 m);
-static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__len, INT16 n, INT16 m)
+static BOOLEAN M__8 (CHAR *name, ADDRESS name__len, CHAR *mask, ADDRESS mask__len, INT16 n, INT16 m)
{
while ((((n >= 0 && m >= 0)) && mask[__X(m, mask__len)] != '*')) {
if (name[__X(n, name__len)] != mask[__X(m, mask__len)]) {
@@ -220,7 +223,7 @@ static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT mask__le
return 0;
}
-BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len)
+BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len)
{
struct Match__7 _s;
BOOLEAN __retval;
@@ -236,10 +239,135 @@ BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT
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 c987af8d..f0e3ae34 100644
--- a/bootstrap/windows-88/Strings.h
+++ b/bootstrap/windows-88/Strings.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -8,15 +8,17 @@
-import void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len);
-import void Strings_Cap (CHAR *s, LONGINT s__len);
-import void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n);
-import void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len);
-import void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
-import INT16 Strings_Length (CHAR *s, LONGINT s__len);
-import BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len);
-import INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos);
-import void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len);
+import void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len);
+import void Strings_Cap (CHAR *s, ADDRESS s__len);
+import void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n);
+import void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len);
+import void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len);
+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 ae12961b..77dc1bac 100644
--- a/bootstrap/windows-88/Texts.c
+++ b/bootstrap/windows-88/Texts.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -187,20 +187,20 @@ export void Texts_Append (Texts_Text T, Texts_Buffer B);
export void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
static Texts_Elem Texts_CloneElem (Texts_Elem e);
static Texts_Piece Texts_ClonePiece (Texts_Piece p);
-export void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
+export void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len);
export void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
export void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
export void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
export Texts_Text Texts_ElemBase (Texts_Elem E);
export INT32 Texts_ElemPos (Texts_Elem E);
static void Texts_Find (Texts_Text T, INT32 *pos, Texts_Run *u, INT32 *org, INT32 *off);
-static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len);
+static Texts_FontsFont Texts_FontsThis (CHAR *name, ADDRESS name__len);
static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__typ);
export void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
export void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
static void Texts_Load0 (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
static void Texts_Merge (Texts_Text T, Texts_Run u, Texts_Run *v);
-export void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
+export void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len);
export void Texts_OpenBuf (Texts_Buffer B);
export void Texts_OpenReader (Texts_Reader *R, ADDRESS *R__typ, Texts_Text T, INT32 pos);
export void Texts_OpenScanner (Texts_Scanner *S, ADDRESS *S__typ, Texts_Text T, INT32 pos);
@@ -229,10 +229,10 @@ export void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x
export void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
export void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
export void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
-export void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
+export void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len);
-static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT name__len)
+static Texts_FontsFont Texts_FontsThis (CHAR *name, ADDRESS name__len)
{
Texts_FontsFont F = NIL;
__NEW(F, Texts_FontDesc);
@@ -390,27 +390,27 @@ static void Texts_HandleAlien (Texts_Elem E, Texts_ElemMsg *msg, ADDRESS *msg__t
if (__IS(msg__typ, Texts_CopyMsg, 1)) {
Texts_CopyMsg *msg__ = (void*)msg;
__NEW(e, Texts__1);
- Texts_CopyElem((void*)((Texts_Alien)E), (void*)e);
- e->file = ((Texts_Alien)E)->file;
- e->org = ((Texts_Alien)E)->org;
- e->span = ((Texts_Alien)E)->span;
- __COPY(((Texts_Alien)E)->mod, e->mod, 32);
- __COPY(((Texts_Alien)E)->proc, e->proc, 32);
+ Texts_CopyElem((void*)(*(Texts_Alien*)&E), (void*)e);
+ e->file = (*(Texts_Alien*)&E)->file;
+ e->org = (*(Texts_Alien*)&E)->org;
+ e->span = (*(Texts_Alien*)&E)->span;
+ __MOVE((*(Texts_Alien*)&E)->mod, e->mod, 32);
+ __MOVE((*(Texts_Alien*)&E)->proc, e->proc, 32);
(*msg__).e = (Texts_Elem)e;
} else __WITHCHK;
} else if (__IS(msg__typ, Texts_IdentifyMsg, 1)) {
if (__IS(msg__typ, Texts_IdentifyMsg, 1)) {
Texts_IdentifyMsg *msg__ = (void*)msg;
- __COPY(((Texts_Alien)E)->mod, (*msg__).mod, 32);
- __COPY(((Texts_Alien)E)->proc, (*msg__).proc, 32);
+ __COPY((*(Texts_Alien*)&E)->mod, (*msg__).mod, 32);
+ __COPY((*(Texts_Alien*)&E)->proc, (*msg__).proc, 32);
(*msg__).mod[31] = 0x01;
} else __WITHCHK;
} else if (__IS(msg__typ, Texts_FileMsg, 1)) {
if (__IS(msg__typ, Texts_FileMsg, 1)) {
Texts_FileMsg *msg__ = (void*)msg;
if ((*msg__).id == 1) {
- Files_Set(&r, Files_Rider__typ, ((Texts_Alien)E)->file, ((Texts_Alien)E)->org);
- i = ((Texts_Alien)E)->span;
+ Files_Set(&r, Files_Rider__typ, (*(Texts_Alien*)&E)->file, (*(Texts_Alien*)&E)->org);
+ i = (*(Texts_Alien*)&E)->span;
while (i > 0) {
Files_Read(&r, Files_Rider__typ, (void*)&ch);
Files_Write(&(*msg__).r, Files_Rider__typ, ch);
@@ -646,7 +646,7 @@ void Texts_Read (Texts_Reader *R, ADDRESS *R__typ, CHAR *ch)
u = u->next;
if (__ISP(u, Texts_PieceDesc, 1)) {
if (__ISP(u, Texts_PieceDesc, 1)) {
- Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
+ Files_Set(&(*R).rider, Files_Rider__typ, (*(Texts_Piece*)&u)->file, (*(Texts_Piece*)&u)->org);
} else __WITHCHK;
}
(*R).run = u;
@@ -673,7 +673,7 @@ void Texts_ReadElem (Texts_Reader *R, ADDRESS *R__typ)
(*R).elem = __GUARDP(u, Texts_ElemDesc, 1);
if (__ISP(un, Texts_PieceDesc, 1)) {
if (__ISP(un, Texts_PieceDesc, 1)) {
- Files_Set(&(*R).rider, Files_Rider__typ, ((Texts_Piece)un)->file, ((Texts_Piece)un)->org);
+ Files_Set(&(*R).rider, Files_Rider__typ, (*(Texts_Piece*)&un)->file, (*(Texts_Piece*)&un)->org);
} else __WITHCHK;
}
} else {
@@ -812,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;
}
@@ -1027,7 +1027,7 @@ void Texts_WriteLn (Texts_Writer *W, ADDRESS *W__typ)
Texts_Write(&*W, W__typ, 0x0d);
}
-void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len)
+void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
@@ -1046,7 +1046,7 @@ void Texts_WriteInt (Texts_Writer *W, ADDRESS *W__typ, INT64 x, INT64 n)
CHAR a[24];
i = 0;
if (x < 0) {
- if (x == (-9223372036854775807-1)) {
+ if (x == (-9223372036854775807LL-1)) {
Texts_WriteString(&*W, W__typ, (CHAR*)" -9223372036854775808", 22);
return;
} else {
@@ -1057,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));
@@ -1084,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;
@@ -1162,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));
}
}
@@ -1313,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 {
@@ -1344,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));
}
}
@@ -1374,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)
@@ -1406,8 +1406,8 @@ static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span
static void LoadElem__17 (Files_Rider *r, ADDRESS *r__typ, INT32 pos, INT32 span, Texts_Elem *e)
{
- Modules_Module M = NIL;
- Modules_Command Cmd;
+ Heap_Module M = NIL;
+ Heap_Command Cmd;
Texts_Alien a = NIL;
INT32 org, ew, eh;
INT8 eno;
@@ -1539,7 +1539,7 @@ void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
Texts_Load0(&*r, r__typ, T);
}
-void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len)
+void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
Files_Rider r;
@@ -1715,9 +1715,9 @@ void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
while (u != T->head) {
if (__ISP(u, Texts_PieceDesc, 1)) {
if (__ISP(u, Texts_PieceDesc, 1)) {
- if (((Texts_Piece)u)->ascii) {
- Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
- delta = ((Texts_Piece)u)->len;
+ if ((*(Texts_Piece*)&u)->ascii) {
+ Files_Set(&r1, Files_Rider__typ, (*(Texts_Piece*)&u)->file, (*(Texts_Piece*)&u)->org);
+ delta = (*(Texts_Piece*)&u)->len;
while (delta > 0) {
Files_Read(&r1, Files_Rider__typ, (void*)&ch);
delta -= 1;
@@ -1728,8 +1728,8 @@ void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
}
}
} else {
- Files_Set(&r1, Files_Rider__typ, ((Texts_Piece)u)->file, ((Texts_Piece)u)->org);
- delta = ((Texts_Piece)u)->len;
+ Files_Set(&r1, Files_Rider__typ, (*(Texts_Piece*)&u)->file, (*(Texts_Piece*)&u)->org);
+ delta = (*(Texts_Piece*)&u)->len;
while (delta > 1024) {
Files_ReadBytes(&r1, Files_Rider__typ, (void*)block, 1024, 1024);
Files_WriteBytes(&msg.r, Files_Rider__typ, (void*)block, 1024, 1024);
@@ -1755,7 +1755,7 @@ void Texts_Store (Files_Rider *r, ADDRESS *r__typ, Texts_Text T)
Store__39_s = _s.lnk;
}
-void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len)
+void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len)
{
Files_File f = NIL;
Files_Rider r;
diff --git a/bootstrap/windows-88/Texts.h b/bootstrap/windows-88/Texts.h
index 61a97dda..081eec2c 100644
--- a/bootstrap/windows-88/Texts.h
+++ b/bootstrap/windows-88/Texts.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -131,7 +131,7 @@ import ADDRESS *Texts_Writer__typ;
import void Texts_Append (Texts_Text T, Texts_Buffer B);
import void Texts_ChangeLooks (Texts_Text T, INT32 beg, INT32 end, UINT32 sel, Texts_FontsFont fnt, INT8 col, INT8 voff);
-import void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
+import void Texts_Close (Texts_Text T, CHAR *name, ADDRESS name__len);
import void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
import void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
import void Texts_Delete (Texts_Text T, INT32 beg, INT32 end);
@@ -139,7 +139,7 @@ import Texts_Text Texts_ElemBase (Texts_Elem E);
import INT32 Texts_ElemPos (Texts_Elem E);
import void Texts_Insert (Texts_Text T, INT32 pos, Texts_Buffer B);
import void Texts_Load (Files_Rider *r, ADDRESS *r__typ, Texts_Text T);
-import void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
+import void Texts_Open (Texts_Text T, CHAR *name, ADDRESS name__len);
import void Texts_OpenBuf (Texts_Buffer B);
import void Texts_OpenReader (Texts_Reader *R, ADDRESS *R__typ, Texts_Text T, INT32 pos);
import void Texts_OpenScanner (Texts_Scanner *S, ADDRESS *S__typ, Texts_Text T, INT32 pos);
@@ -166,7 +166,7 @@ import void Texts_WriteLongRealHex (Texts_Writer *W, ADDRESS *W__typ, LONGREAL x
import void Texts_WriteReal (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n);
import void Texts_WriteRealFix (Texts_Writer *W, ADDRESS *W__typ, REAL x, INT16 n, INT16 k);
import void Texts_WriteRealHex (Texts_Writer *W, ADDRESS *W__typ, REAL x);
-import void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
+import void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, ADDRESS s__len);
import void *Texts__init(void);
diff --git a/bootstrap/windows-88/VT100.c b/bootstrap/windows-88/VT100.c
index f69fd90e..346fb37b 100644
--- a/bootstrap/windows-88/VT100.c
+++ b/bootstrap/windows-88/VT100.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -27,23 +27,24 @@ export void VT100_DECTCEMl (void);
export void VT100_DSR (INT16 n);
export void VT100_ED (INT16 n);
export void VT100_EL (INT16 n);
-static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len);
-static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len);
-static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len);
-static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len);
+static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len);
+static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len);
+static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len);
+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, LONGINT str__len);
+export void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len);
export void VT100_RCP (void);
-static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end);
+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);
export void VT100_SGR (INT16 n);
export void VT100_SGR2 (INT16 n, INT16 m);
export void VT100_SU (INT16 n);
-export void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
+export void VT100_SetAttr (CHAR *attr, ADDRESS attr__len);
-static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end)
+static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end)
{
CHAR h;
while (start < end) {
@@ -55,7 +56,7 @@ static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end)
}
}
-void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
+void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len)
{
CHAR b[21];
INT16 s, e;
@@ -74,7 +75,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT 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));
@@ -84,7 +85,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
__COPY(b, str, str__len);
}
-static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len)
+static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len)
{
CHAR cmd[9];
__DUP(letter, letter__len, CHAR);
@@ -94,7 +95,7 @@ static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len)
__DEL(letter);
}
-static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len)
+static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len)
{
CHAR nstr[2];
CHAR cmd[7];
@@ -107,7 +108,7 @@ static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len)
__DEL(letter);
}
-static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len)
+static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len)
{
CHAR nstr[2];
CHAR cmd[7];
@@ -120,7 +121,7 @@ static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len)
__DEL(letter);
}
-static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len)
+static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len)
{
CHAR nstr[5], mstr[5];
CHAR cmd[12];
@@ -136,6 +137,15 @@ static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT 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);
@@ -236,7 +246,7 @@ void VT100_DECTCEMh (void)
VT100_EscSeq0((CHAR*)"\?25h", 5);
}
-void VT100_SetAttr (CHAR *attr, LONGINT attr__len)
+void VT100_SetAttr (CHAR *attr, ADDRESS attr__len)
{
CHAR tmpstr[16];
__DUP(attr, attr__len, CHAR);
@@ -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 d99406ec..4e708647 100644
--- a/bootstrap/windows-88/VT100.h
+++ b/bootstrap/windows-88/VT100.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -23,14 +23,15 @@ import void VT100_DSR (INT16 n);
import void VT100_ED (INT16 n);
import void VT100_EL (INT16 n);
import void VT100_HVP (INT16 n, INT16 m);
-import void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len);
+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);
import void VT100_SGR2 (INT16 n, INT16 m);
import void VT100_SU (INT16 n);
-import void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
+import void VT100_SetAttr (CHAR *attr, ADDRESS attr__len);
import void *VT100__init(void);
diff --git a/bootstrap/windows-88/extTools.c b/bootstrap/windows-88/extTools.c
index 37630d23..ce2fc413 100644
--- a/bootstrap/windows-88/extTools.c
+++ b/bootstrap/windows-88/extTools.c
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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,33 +7,40 @@
#include "SYSTEM.h"
#include "Configuration.h"
+#include "Heap.h"
#include "Modules.h"
#include "OPM.h"
#include "Out.h"
#include "Platform.h"
#include "Strings.h"
-
-static CHAR extTools_CFLAGS[1023];
+typedef
+ CHAR extTools_CommandString[4096];
-export void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len);
-static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT s__len);
-export void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len);
-static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len);
+static extTools_CommandString extTools_CFLAGS;
-static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT cmd__len)
+export void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__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);
+
+
+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, LONGINT title__len, CHAR *cmd, LONGIN
__DEL(cmd);
}
-static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT 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, LONGINT moduleName__len)
+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*)"Assemble: ", 11, 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, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len)
+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", 8, (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((CHAR*)"", 1, (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*)"Assemble and link: ", 20, 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 63e5df15..686f0b4e 100644
--- a/bootstrap/windows-88/extTools.h
+++ b/bootstrap/windows-88/extTools.h
@@ -1,4 +1,4 @@
-/* voc 1.95 [2016/11/24]. 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
@@ -8,8 +8,8 @@
-import void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len);
-import void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len);
+import void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len);
+import void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len);
import void *extTools__init(void);
diff --git a/doc/Compiling.md b/doc/Compiling.md
new file mode 100644
index 00000000..ebb84ce9
--- /dev/null
+++ b/doc/Compiling.md
@@ -0,0 +1,84 @@
+## Compiling
+
+An Oberon command line program is built from one or more modules. One module must be designated a main module.
+
+### Files generated
+
+From each non-main module the following files are generated in the current directory:
+
+| Filename | Purpose |
+| ---------- | --------------------------------------------------------------------- |
+| ```module.sym``` | Oberon symbols required to ```IMPORT``` this module in another compilation.|
+| ```module.c``` | C source code for compilation by gcc, clang or msc. |
+| ```module.h``` | C header files required by C compiler when importing this module. |
+
+Note that the filename of the .sym, .c and .h files is the name of the module from the ```MODULE``` statement at the start of the source file. It is not the name of the .mod file.
+
+If the compilation is successful, the Oberon compiler will automatically invoke the C compiler. The compiler option ```-V``` will cause the compiler to display the C compiler command used.
+
+### Successful compilation report
+
+For a successful compilation, the compiler displays a single line comprising
+
+ * The name of the file being compiled
+ * The name of the module from the ```MODULE``` statment
+ * Compiler configuration (only if the ```-V``` verbose option is selected)
+ * A possible symbol update status message
+ * The number of characters compiled
+
+If a symbols file already exists, the compiler will check whether the new compilation changes the symbols, and if so whether the change is just an extension, or a more serious compatability threatening modification. If there is a change the compiler displays either ```Extended symbol file``` or ```New symbol file```.
+
+For example:
+
+```
+$ voc test.mod
+test.mod Compiling test. New symbol file. 364 chars.
+```
+
+### Symbol file changes
+
+By default the compiler will refuse to compile a module if its symbols are different from those in the .sym file present from a previous compilation. To allow the compiler to change the symbols, one of the following options must be used.
+
+| Compiler option | Use |
+| :-------------: | --------------------------- |
+| ```-e``` | Allow extension of symbols. Do not allow changes to existing symbols. |
+| ```-s``` | Allow changes to and extensions of symbols. |
+| ```-F``` | Force generation of new symbol file.* |
+
+\* A new symbol file may be forced to guarantee that a symbol file is generated for a module that has the same name as an installed library module.
+
+### Main module
+
+The main module should be the last module compiled as it imports all other modules.
+
+The program logic should be started from the main module's initialisation code.
+
+The following options designate the main module:
+
+| Compiler option | Use |
+| :-------------: | --------------------------- |
+| ```-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.
+
+Multiple modules may be compiled on a single compiler command line.
+
+Options on the command line that preceed all module file names will be used as global settings: each module will be compiled with these settings except as overriden on a per file basis.
+
+Options on the command line that follow a module file name are specific to that module.
+
+For example:
+
+```
+ voc -s alpha.mod beta.mod main.mod -m
+```
+
+Will apply the ```-s``` option to all modules (allow changes to and extension of symbols), and will apply the ```-m``` option (main program) only to ```main.mod```.
+
diff --git a/doc/Features.md b/doc/Features.md
index e597732c..ffcb4a93 100644
--- a/doc/Features.md
+++ b/doc/Features.md
@@ -1,4 +1,4 @@
-### Features
+## Features
#### 32 bit and 64 bit systems vs integer, set and address size.
@@ -136,13 +136,42 @@ The following SYSTEM module predefined functions and procedures now use SYSTEM.A
Note that the standard function LEN() still returns LONGINT.
+#### Files.Mod - Oberon System file semantics on Linux and Windows
+
+The oberon system has a simpler approach to files than most contemporary operating systems: the data part is manipulated entirely independently of the directory of file names. While Linux has inodes and directories, it does not expose them as independently as Oberon does.
+
+In particular a file is created in Oberon without touching the directory. Only when a program is ready to expose it in the directory does it call the OS to 'Register' the file.
+
+In order to mimic this behaviour on Windows and Linux, a new file goes through a number of stages:
+
+ 1. Files.New returns a Files.File, which is an opaque pointer to a file descriptor record. No OS file is created at this stage.
+ 2. As the first data is written to the file, it is buffered. Still no OS file is created at this stage.
+ 3. As more data is written to the file more buffers are allocated. Still no OS file is created.
+ 4. After a limit is reached (currently 4 buffers of 4KB each), a temporary OS file is created, and a buffer reclaimed by flushing it to the temporary file.
+ 5. Data continues to be written to buffers, with buffers being flushed to the temporary file as necessary to maintain the limit of 4 buffers per file.
+ 6. Finally, when the client program calls Register, any active buffers are flushed to disk, and the temporary file is renamed to the client specified registration name.
+
+##### OS file handle lifetime
+
+Once an OS file has been opened, either by Files.Old, or by sufficient data written to a new file, or by Files.Register, it wil remain open. The client program can Files.Set a new rider on the file at any time.
+
+Only if the Files.File becomes inaccessible will the garbage collector (eventually) recover the space used by the file descriptor, and only at this time will the OS file handle be closed.
+
+As in Oberon, Files.Close is only a mechanism to flush buffers, the file remains accessible and may be passed successfully to Files.Set.
+
+##### Rename and Delete
+
+Note that on a real Oberon system, it is possible to call rename and delete on files that are currently accessible through a Files.File pointer. For example a program could register a Files.File, and then call Files.Delete passing the same filename - the Files.File remains valid, containing the same data, only the directory entry is removed.
+
+Such behaviour is not supported on Unix/Windows - an attempt to delete a file that is registered and in use by the program will fail.
+
+
+
#### Runtime error and exit handling
When passed FALSE, ASSERT displays the message 'Assertion failure.'. If a second, nonzero value is passed to ASSERT it will also be displayed. ASSERT then exits to the OS passing the assert value or zero.
HALT displays the message 'Terminated by Halt(n)'. For negative values that correspond to a standard runtime error a descriptive string is also printed. Finally Halt exits to the oprerating system passing the error code.
-Bear in mind that both Linux and Windows generally treat the return code as a signed 8 bit value, ignoring higher order bits. Therefore it is best to restrict HALT and ASSERT codes to the range -128 .. 127.
-
-A client application may register a halt handler by calling Platform.SetHalt(p) where p: PROCEDURE(n: SYSTEM.INT32). This procedure will be called before Halt displays it's message. The procedure may suppress the Halt message by calling Platform.Exit(code: INTEGER) directly.
+Bear in mind that both Unix and Windows generally treat the return code as a signed 8 bit value, ignoring higher order bits. Therefore it is best to restrict HALT and ASSERT codes to the range -128 .. 127.
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/History.md b/doc/History.md
index 6ff44199..26d20bdf 100644
--- a/doc/History.md
+++ b/doc/History.md
@@ -1,9 +1,30 @@
-#### (Work in progress)
-
-
-
### History
+#### Changes from 2.0 to 2.1.0
+
+ - Features
+ - Modules of a multi-module program may now be compiled independently - it is
+ no longer necessary to compile all modules on a single compiler command line.
+ - The file system location of standard libraries is now determined relative to
+ where the compiler binary loads from, rather than a fixed location built
+ into the compiler at install time.
+ - ```make full``` no longer installs the compiler, and can be run without
+ root/administrator priviledges. Optionally use ```make install``` to install.
+ - New warning message to advise of redefinition of standard predefined types.
+ - Supports revised Oberon array assignment. As well as supporting assignments
+ between arrays of identical type and size, also supports assignment of arrays
+ of identical type where the target is larger than the source.
+ - Fixes:
+ - Files.Mod provide Oberon system compatible behaviour when deleting an open file.
+ - The open file will be renamed to a temporary file, remaining accessible and
+ can be (re)registered. If not registered the temporary file will be deleted
+ at exit.
+ - Support allocated memory straddling and above 7FFFFFFFH.
+ - Flush output on assertion failure.
+ - Fix 2 or more dimension open array parameter addressing.
+ - Remove invalid large integer literal warnings on OpenBSD.
+ - Fix incorrect type generation when a record variable of type LONGINT immediately
+ follows a record variable of type SYSTEM.ADDRESS.
#### Changes from 1.2 to 2.0
diff --git a/doc/Installation.md b/doc/Installation.md
index 7c131005..d9ad75cd 100644
--- a/doc/Installation.md
+++ b/doc/Installation.md
@@ -2,10 +2,7 @@
The Oberon compiler and libraries may be built and installed on Linux based, BSD based or Windows based systems.
-Building on Linux and BSD based systems is reasonably straightforward. First make sure you have the right pre-requites like a C compiler and static libraries installed, then clone the repository and run `make full`.
-
-Full instructions for a Linux/BSD based build follow in the next section.
-
+### Windows systems
Bulding on Windows is not so simple largely because there is more than one way to do it:
@@ -30,8 +27,6 @@ Bulding on Windows is not so simple largely because there is more than one way t
For full details about building with Cygwin or native Microsoft C environments see [**Cygwin and MSC Installation**](/doc/Winstallation.md)
-The following sections provide more details for Linux based builds.
-
### Building the Oberon compiler and libraries on a Linux or BSD based system
@@ -42,6 +37,7 @@ This approach is for
- All BSD based systems
- includes macOS (Darwin)
+
#### 1. Install pre-requisites
The build process has the following pre-requisites:
@@ -58,11 +54,13 @@ 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.
+
#### 2. Clone the Oberon compiler repository
Create and change to a directory in which to make the compiler and clone with this command:
@@ -79,12 +77,12 @@ This will create a subdirectory 'voc' which includes the following files and dir
| makefile | Makefile for all BSD- and Linux- like environments. Includes tests. |
| 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:
@@ -96,12 +94,9 @@ The makefile will:
link the final Oberon compiler. This compiler is then used for the remaining steps.
- Build the .sym file browser command `showdef`.
- Build all the libraries in -O2 mode, and a subset in -OC mode.
- - Install the compiler and libraries by copying them to an appropriate location for your OS.
+ - Create an installation directory structure local to your copy of the repository.
- Run a set of confidence tests.
-Since installation directories are not generally write accessible to normal users, is is necessary to run
-the `make full` command from a root shell, or by using `sudo`.
-
The makefile will use either gcc or clang, whichever is installed. If you have both installed you can specify which to use by running either `export CC=gcc` or `export CC=clang` before the `make full` command.
@@ -110,15 +105,28 @@ The makefile will use either gcc or clang, whichever is installed. If you have b
If the makefile succeeds it will end with instructions on how to set your path variable so that the
compiler (voc) is found.
-The installation will be found at:
+
+#### Installing to system directories
+
+You may optionally install to system directories such as /opt or /usr/local/share.
+
+First be sure to have completed `make full` successfully.
+
+Then from a root prompt, or using sudo, run `make install`
+
+The installation will be made to:
| System | Install dir |
| ----------------------- | -------------------------------------- |
| All types of Linux | /opt/voc |
| BSD (including Darwin) | /usr/local/share/voc |
-| Termux (android) | /data/data/com.termux/files/opt/voc | |
+| Termux (android) | /data/data/com.termux/files/opt/voc |
-The installation directory contains:
+As with `make full`, `make install` will exit with instructions on how to set
+your PATH.
+
+
+#### Installation directory contentains:
| Directory | Content |
| --- | --- |
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 12924600..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)
#
@@ -73,14 +74,16 @@ usage:
@echo ""
@echo " make full"
@echo ""
- @echo " Does a full, clean build, installs it, and runs confidence tests."
- @echo " Requires root access (for the install) except on cygwin."
+ @echo " Does a full, clean build, and runs confidence tests."
+ @echo " An installation directory image is left in the local repository install directory."
@echo ""
@echo "Targets for building and installation:"
@echo " make clean - Clean out the build directory"
@echo " make compiler - Build the compiler but not the library"
@echo " make browsercmd - Build the symbol browser (showdef)"
@echo " make library - Build all library files and make library"
+ @echo " make 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:
@@ -134,8 +140,6 @@ clean: configuration
# full: Full build of compiler and libarary.
full: configuration
- @make -f src/tools/make/oberon.mk -s installable
- @-make -f src/tools/make/oberon.mk -s uninstall
@make -f src/tools/make/oberon.mk -s clean
# Make bootstrap compiler from source suitable for current data model
@printf "\n\n--- Compiler build started ---\n\n"
@@ -153,10 +157,10 @@ full: configuration
@make -f src/tools/make/oberon.mk -s library MODEL=C
@printf "\n\n--- Library build successfull ---\n\n"
@make -f src/tools/make/oberon.mk -s sourcechanges
- @make -f src/tools/make/oberon.mk -s install
+ @make -f src/tools/make/oberon.mk -s makeinstalldir
@printf "\n\n--- Confidence tests started ---\n\n"
@make -f src/tools/make/oberon.mk -s confidence MODEL=2
- @make -f src/tools/make/oberon.mk -s showpath
+ @make -f src/tools/make/oberon.mk -s instructions
assemble:
@@ -221,14 +225,16 @@ s3: configuration
+# makeinstalldir: Copy built files to local install directory
+makeinstalldir:
+ @make -f src/tools/make/oberon.mk -s makeinstalldir
+
+
# install: Copy built files to install directory
install: configuration
- @make -f src/tools/make/oberon.mk -s installable
- @make -f src/tools/make/oberon.mk -s install MODEL=2
- @make -f src/tools/make/oberon.mk -s showpath MODEL=2
+ @make -f src/tools/make/oberon.mk -s install
uninstall: configuration
- @make -f src/tools/make/oberon.mk -s installable
@make -f src/tools/make/oberon.mk -s uninstall
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 0a373e7a..5855a008
--- a/src/compiler/Compiler.Mod
+++ b/src/compiler/Compiler.Mod
@@ -6,9 +6,6 @@ MODULE Compiler; (* J. Templ 3.2.95 *)
OPV, OPC, OPM,
extTools, Strings, VT100;
- VAR mname: ARRAY 256 OF CHAR; (* noch *)
-
-
PROCEDURE Module*(VAR done: BOOLEAN);
VAR ext, new: BOOLEAN; p: OPT.Node;
BEGIN
@@ -20,11 +17,12 @@ MODULE Compiler; (* J. Templ 3.2.95 *)
OPT.Export(ext, new);
IF OPM.noerr THEN
OPM.OpenFiles(OPT.SelfName);
+ OPM.DeleteObj(OPT.SelfName); (* Make sure old object file isn't left hanging around. *)
OPC.Init;
OPV.Module(p);
IF OPM.noerr THEN
IF (OPM.mainprog IN OPM.Options) & (OPM.modName # "SYSTEM") THEN
- OPM.DeleteNewSym;
+ OPM.DeleteSym(OPT.SelfName);
OPM.LogVT100(VT100.Green); OPM.LogWStr(" Main program."); OPM.LogVT100(VT100.ResetAll);
ELSE
IF new THEN
@@ -36,7 +34,7 @@ MODULE Compiler; (* J. Templ 3.2.95 *)
END
END;
ELSE
- OPM.DeleteNewSym
+ OPM.DeleteSym(OPT.SelfName)
END
END
END;
@@ -68,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;
@@ -83,20 +81,51 @@ MODULE Compiler; (* J. Templ 3.2.95 *)
END PropagateElementaryTypeSizes;
+ PROCEDURE FindLocalObjectFiles(VAR objectnames: ARRAY OF CHAR);
+ VAR
+ l: OPT.Link;
+ fn: ARRAY 64 OF CHAR;
+ id: Platform.FileIdentity;
+ BEGIN
+ objectnames[0] := 0X;
+ l := OPT.Links; WHILE l # NIL DO
+ (* Tell linker to link this module as an object file if both a symbol
+ and an object file exist in the current directory. *)
+ COPY(l.name, fn); Strings.Append('.sym', fn);
+ IF Platform.IdentifyByName(fn, id) = 0 THEN
+ COPY(l.name, fn); Strings.Append(Configuration.objext, fn);
+ IF Platform.IdentifyByName(fn, id) = 0 THEN
+ Strings.Append(' ', objectnames);
+ Strings.Append(fn, objectnames)
+ ELSE
+ (* Found symbol file but no object file. *)
+ OPM.LogVT100(VT100.LightRed);
+ OPM.LogWStr("Link warning: a local symbol file is present for module "); OPM.LogWStr(l.name);
+ OPM.LogWStr(", but local object file '"); OPM.LogWStr(fn); OPM.LogWStr("' is missing.");
+ OPM.LogVT100(VT100.ResetAll); OPM.LogWLn
+ END
+ ELSE
+ (* No symbol file present in current directory.
+ Assume this referenced module is in a library. *)
+ END;
+ l := l.next
+ END
+ END FindLocalObjectFiles;
+
+
PROCEDURE Translate*;
VAR
- done: BOOLEAN;
- modulesobj: ARRAY 2048 OF CHAR; (* here we hold all modules name given on the command line, to add corresponding .o files to the external compiler options *)
+ done: BOOLEAN;
+ linkfiles: ARRAY 2048 OF CHAR; (* Object files to be linked into main program. *)
BEGIN
- modulesobj := "";
IF OPM.OpenPar() THEN
(* gclock(); slightly faster translation but may lead to opening "too many files" *)
LOOP
- OPM.Init(done, mname); (* Get next module name from command line *)
+ OPM.Init(done); (* Get next module name from command line *)
IF ~done THEN RETURN END ;
- OPM.InitOptions; (* Get options ofr this module *)
+ OPM.InitOptions; (* Get options for this module *)
PropagateElementaryTypeSizes;
(* Compile source to .c and .h files *)
@@ -116,12 +145,10 @@ MODULE Compiler; (* J. Templ 3.2.95 *)
IF ~(OPM.mainprog IN OPM.Options) THEN
(* Assemble non main program and add object name to link list *)
extTools.Assemble(OPM.modName);
- Strings.Append(" ", modulesobj);
- Strings.Append(OPM.modName, modulesobj);
- Strings.Append(Configuration.objext, modulesobj)
ELSE
(* Assemble and link main program *)
- extTools.LinkMain(OPM.modName, OPM.mainlinkstat IN OPM.Options, modulesobj)
+ FindLocalObjectFiles(linkfiles);
+ extTools.LinkMain(OPM.modName, OPM.mainlinkstat IN OPM.Options, linkfiles)
END
END
END
diff --git a/src/compiler/OPB.Mod b/src/compiler/OPB.Mod
index 91576fd3..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;
@@ -891,20 +891,34 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
IF x^.comp = OPT.Array THEN
IF (ynode^.class = OPT.Nconst) & (g = OPT.Char) THEN CharToString(ynode); y := ynode^.typ; g := OPT.String END ;
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
- ELSIF (y.comp IN {OPT.DynArr, OPT.Array}) & (y.BaseTyp = OPT.chartyp) THEN
- (* Assignment from ARRAY OF CHAR is good.*)
ELSE err(113)
END
ELSE err(113)
END
- ELSIF (x.comp = OPT.DynArr) & (x^.BaseTyp = OPT.chartyp) THEN (* Assign to dynamic ARRAY OF CHAR*)
- IF (y.comp IN {OPT.DynArr, OPT.Array}) & (y.BaseTyp = OPT.chartyp) THEN
- (* Assignment from ARRAY OF CHAR is good.*)
- ELSE err(113)
- END
ELSIF x^.comp = OPT.Record THEN
IF x = y THEN (* ok *)
ELSIF y^.comp = OPT.Record THEN
@@ -913,7 +927,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
IF q = NIL THEN err(113) END
ELSE err(113)
END
- ELSE err(113)
+ ELSE (* Assign to dynamic array *) err(113)
END
ELSE OPM.LogWStr("unhandled case in OPB.CheckAssign, f = "); OPM.LogWNum(f, 0); OPM.LogWLn;
END ;
@@ -1464,7 +1478,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END Return;
PROCEDURE Assign*(VAR x: OPT.Node; y: OPT.Node);
- VAR z: OPT.Node; subcl: SHORTINT;
+ VAR z: OPT.Node;
BEGIN
IF x^.class >= OPT.Nconst THEN err(56) END ;
CheckAssign(x^.typ, y);
@@ -1481,15 +1495,9 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
(y^.typ^.form = OPT.String) & (y^.conval^.intval2 = 1) THEN (* replace array := "" with array[0] := 0X *)
y^.typ := OPT.chartyp; y^.conval^.intval := 0;
Index(x, NewIntConst(0))
- END ;
- IF (x.typ.comp IN {OPT.Array, OPT.DynArr}) & (x.typ.BaseTyp = OPT.chartyp)
- & (y.typ.comp IN {OPT.Array, OPT.DynArr}) & (y.typ.BaseTyp = OPT.chartyp) THEN
- subcl := OPT.copyfn
- ELSE
- subcl := OPT.assign
END;
BindNodes(OPT.Nassign, OPT.notyp, x, y);
- x^.subcl := subcl;
+ x^.subcl := OPT.assign;
END Assign;
PROCEDURE Inittd*(VAR inittd, last: OPT.Node; typ: OPT.Struct);
diff --git a/src/compiler/OPC.Mod b/src/compiler/OPC.Mod
index a8681e32..80e6bd66 100644
--- a/src/compiler/OPC.Mod
+++ b/src/compiler/OPC.Mod
@@ -248,7 +248,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
typ := typ^.BaseTyp^.BaseTyp; nofdims := 1;
WHILE typ^.comp = OPT.DynArr DO INC(nofdims); typ := typ^.BaseTyp END ;
OPM.WriteString('struct '); BegBlk;
- BegStat; Str1("LONGINT len[#]", nofdims); EndStat;
+ BegStat; Str1("ADDRESS len[#]", nofdims); EndStat;
BegStat; NEW(obj); NEW(obj.typ); (* aux. object for easy declaration *)
obj.typ.form := OPT.Comp; obj.typ.comp := OPT.Array; obj.typ.n := 1; obj.typ.BaseTyp := typ; obj.mode := OPT.Fld; obj.name := "data";
obj.linkadr := UndefinedType; DeclareBase(obj); OPM.Write(' '); DeclareObj(obj, FALSE);
@@ -335,7 +335,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
IF showParamName THEN Ident(par); OPM.WriteString(LenExt) END ;
dim := 1; typ := par^.typ^.BaseTyp;
WHILE typ^.comp = OPT.DynArr DO
- IF ansiDefine THEN OPM.WriteString(", LONGINT ") ELSE OPM.WriteString(', ') END ;
+ IF ansiDefine THEN OPM.WriteString(", ADDRESS ") ELSE OPM.WriteString(', ') END ;
IF showParamName THEN Ident(par); OPM.WriteString(LenExt); OPM.WriteInt(dim) END ;
typ := typ^.BaseTyp; INC(dim)
END
@@ -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
@@ -655,8 +665,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
DeclareObj(obj, vis = 3);
IF obj^.typ^.comp = OPT.DynArr THEN (* declare len parameter(s) *)
EndStat; BegStat;
- base := OPT.linttyp;
- OPM.WriteString("LONGINT "); LenList(obj, FALSE, TRUE)
+ base := OPT.adrtyp;
+ OPM.WriteString("ADDRESS "); LenList(obj, FALSE, TRUE)
ELSIF (obj^.mode = OPT.VarPar) & (obj^.typ^.comp = OPT.Record) THEN
EndStat; BegStat;
OPM.WriteString("ADDRESS *"); Ident(obj); OPM.WriteString(TagExt);
@@ -684,7 +694,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
COPY(obj^.name, name); obj^.name := ""; DeclareObj(obj, FALSE); COPY(name, obj^.name)
END ;
IF obj^.typ^.comp = OPT.DynArr THEN
- OPM.WriteString(", LONGINT ");
+ OPM.WriteString(", ADDRESS ");
LenList(obj, TRUE, showParamNames)
ELSIF (obj^.mode = OPT.VarPar) & (obj^.typ^.comp = OPT.Record) THEN
OPM.WriteString(", ADDRESS *");
@@ -1091,7 +1101,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
IF obj^.adr = 1 THEN (* WITH-variable *)
IF obj^.typ^.comp = OPT.Record THEN Ident(obj); OPM.WriteString("__")
ELSE (* cast with guard pointer type *)
- OPM.WriteString("(("); Ident(obj^.typ^.strobj); OPM.Write(")"); Ident(obj); OPM.Write(")")
+ OPM.WriteString("(*("); Ident(obj^.typ^.strobj); OPM.WriteString("*)&"); Ident(obj); OPM.Write(")")
END
ELSIF (level # OPM.level) & (level > 0) THEN (* intermediate var *)
comp := obj^.typ^.comp;
@@ -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 fe43393b..ab3d7dae
--- a/src/compiler/OPM.Mod
+++ b/src/compiler/OPM.Mod
@@ -4,10 +4,11 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
31.1.2007 jt synchronized with BlackBox version, in particular PromoteIntConstToLInt added
*)
- IMPORT SYSTEM, Texts, Files, Platform, Out, Configuration, VT100, Strings;
+ IMPORT SYSTEM, Texts, Files, Platform, Modules, Out, Configuration, VT100, Strings;
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 = 082X; (* 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;
@@ -119,6 +121,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
S: INTEGER;
+ InstallDir*: ARRAY 1024 OF CHAR;
ResourceDir*: ARRAY 1024 OF CHAR;
@@ -136,6 +139,45 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
END
END LogVT100;
+ PROCEDURE LogCompiling*(modname: ARRAY OF CHAR);
+ BEGIN
+ LogWStr("Compiling "); LogWStr(modname);
+ IF verbose IN Options THEN
+ LogWStr(", s:"); LogWNum(ShortintSize*8,1);
+ LogWStr( " i:"); LogWNum(IntegerSize*8,1);
+ LogWStr( " l:"); LogWNum(LongintSize*8,1);
+ LogWStr( " adr:"); LogWNum(AddressSize*8,1);
+ LogWStr( " algn:"); LogWNum(Alignment*8,1)
+ END;
+ 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 *)
@@ -206,16 +248,6 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
AddressSize := ORD(s[i+1]) - ORD('0'); Alignment := ORD(s[i+2]) - ORD('0');
INC(i, 2)
END
-
- (* Temporary build control option - remove when makefile updated to new options. *)
- | "B": IF s[i+1] # 0X THEN INC(i); IntegerSize := ORD(s[i]) - ORD('0') END;
- IF s[i+1] # 0X THEN INC(i); AddressSize := ORD(s[i]) - ORD('0') END;
- IF s[i+1] # 0X THEN INC(i); Alignment := ORD(s[i]) - ORD('0') END;
- ASSERT((IntegerSize = 2) OR (IntegerSize = 4));
- ASSERT((AddressSize = 4) OR (AddressSize = 8));
- ASSERT((Alignment = 4) OR (Alignment = 8));
- IF IntegerSize = 2 THEN LongintSize := 4 ELSE LongintSize := 8 END;
- Files.SetSearchPath("")
ELSE
LogWStr(" warning: option ");
LogW(OptionChar);
@@ -233,11 +265,12 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
PROCEDURE OpenPar*(): BOOLEAN; (* prepare for a sequence of translations *)
VAR s: ARRAY 256 OF CHAR;
BEGIN
- IF Platform.ArgCount = 1 THEN
+ IF Modules.ArgCount = 1 THEN
LogWLn;
LogWStr("Oberon-2 compiler v"); LogWStr(Configuration.versionLong); LogW("."); LogWLn;
LogWStr("Based on Ofront by J. Templ and Software Templ OEG."); LogWLn;
LogWStr("Further development by Norayr Chilingarian, David Brown and others."); LogWLn;
+ LogWStr("Loaded from "); LogWStr(Modules.BinaryDir); LogWLn;
LogWLn;
LogWStr("Usage:"); LogWLn;
LogWLn;
@@ -269,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;
@@ -290,10 +323,10 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
Options := {inxchk, typchk, ptrinit, assert}; (* Default options *)
(* Pick up global option changes from start of command line *)
- S:=1; s:=""; Platform.GetArg(S, s);
+ S:=1; s:=""; Modules.GetArg(S, s);
WHILE s[0] = OptionChar DO
ScanOptions(s);
- INC(S); s:=""; Platform.GetArg(S, s)
+ INC(S); s:=""; Modules.GetArg(S, s)
END;
(* Record global option settings for this command line *)
@@ -307,20 +340,6 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
END OpenPar;
- PROCEDURE VerboseListSizes;
- BEGIN
- LogWLn;
- LogWStr("Type Size"); LogWLn;
- LogWStr("SHORTINT "); LogWNum(ShortintSize, 4); LogWLn;
- LogWStr("INTEGER "); LogWNum(IntegerSize, 4); LogWLn;
- LogWStr("LONGINT "); LogWNum(LongintSize, 4); LogWLn;
- LogWStr("SET "); LogWNum(LongintSize, 4); LogWLn;
- LogWStr("ADDRESS "); LogWNum(AddressSize, 4); LogWLn;
- LogWLn;
- LogWStr("Alignment: "); LogWNum(Alignment, 4); LogWLn;
- END VerboseListSizes;
-
-
PROCEDURE InitOptions*; (* get the options for one translation *)
VAR s: ARRAY 256 OF CHAR; searchpath, modules: ARRAY 1024 OF CHAR;
MODULES: ARRAY 1024 OF CHAR;
@@ -328,27 +347,29 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
BEGIN
Options := GlobalOptions; Model:=GlobalModel; Alignment := GlobalAlignment; AddressSize := GlobalAddressSize;
- s:=""; Platform.GetArg(S, s);
+ s:=""; Modules.GetArg(S, s);
WHILE s[0] = OptionChar DO
ScanOptions(s);
- INC(S); s:=""; Platform.GetArg(S, s)
+ INC(S); s:=""; Modules.GetArg(S, s)
END;
IF mainlinkstat IN Options THEN INCL(Options, mainprog) END;
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;
+ (*IF verbose IN Options THEN VerboseListSizes END;*)
- ResourceDir := Configuration.installdir;
- Strings.Append("/", ResourceDir);
- Strings.Append(Model, ResourceDir);
+ ResourceDir := InstallDir;
+ IF ResourceDir[0] # 0X THEN
+ Strings.Append("/", ResourceDir);
+ Strings.Append(Model, ResourceDir);
+ END;
modules := ""; Platform.GetEnv("MODULES", modules);
searchpath := "."; Platform.GetEnv("OBERON", searchpath);
@@ -361,7 +382,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
END InitOptions;
- PROCEDURE Init*(VAR done: BOOLEAN; VAR mname : ARRAY OF CHAR); (* get the source for one translation *)
+ PROCEDURE Init*(VAR done: BOOLEAN); (* get the source for one translation *)
VAR
T: Texts.Text;
beg, end, time: LONGINT;
@@ -369,13 +390,12 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
BEGIN
done := FALSE;
curpos := 0;
- IF S >= Platform.ArgCount THEN RETURN END ;
+ IF S >= Modules.ArgCount THEN RETURN END ;
- s:=""; Platform.GetArg(S, s);
+ s:=""; Modules.GetArg(S, s);
NEW(T); Texts.Open(T, s);
LogWStr(s); LogWStr(" ");
- COPY(s, mname);
COPY(s, SourceFileName); (* to keep it also in this module -- noch *)
IF T.len = 0 THEN
@@ -396,12 +416,12 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
PROCEDURE Get*(VAR ch: CHAR); (* read next character from source text, 0X if eof *)
BEGIN
+ curpos := Texts.Pos(inR);
Texts.Read(inR, ch);
- IF ch = 0DX THEN
- curpos := Texts.Pos(inR); (* supports CR LF mapping *)
- ELSE
- INC(curpos)
- END ;
+
+ (* TODO, remove curpos var, and provide fn returning Texts.Pos(inR) - 1. *)
+ (* Or, better still, record symbol position in OPS. *)
+
IF (ch < 09X) & ~inR.eot THEN ch := " " END
END Get;
@@ -500,8 +520,6 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
WHILE i > 0 DO LogW(" "); DEC(i) END;
LogVT100(VT100.Green); LogW("^"); LogVT100(VT100.ResetAll);
-
- Files.Close(f);
END ShowLine;
@@ -591,13 +609,17 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
END CloseOldSym;
PROCEDURE OldSym*(VAR modName: ARRAY OF CHAR; VAR done: BOOLEAN);
- VAR tag, ver: CHAR; fileName: FileName;
+ VAR tag, ver: CHAR; fileName: FileName; res: INTEGER;
BEGIN
+ oldSFile := NIL; done := FALSE;
MakeFileName(modName, fileName, SFext);
oldSFile := Files.Old(fileName); done := oldSFile # NIL;
IF done THEN
Files.Set(oldSF, oldSFile, 0); Files.Read(oldSF, tag); Files.Read(oldSF, ver);
- IF (tag # SFtag) OR (ver # SFver) THEN err(-306); (*possibly a symbol file from another Oberon implementation, e.g. HP-Oberon*)
+ IF (tag # SFtag) OR (ver # SFver) THEN
+ (* Possibly a symbol file from another Oberon implementation, e.g. HP-Oberon,
+ or from a symbol incompatible version of this Oberon. *)
+ IF ~(newsf IN Options) THEN err(-306) END;
CloseOldSym; done := FALSE
END
END
@@ -637,8 +659,15 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
IF (modName # "SYSTEM") OR (mainprog IN Options) THEN Files.Register(newSFile) END
END RegisterNewSym;
- PROCEDURE DeleteNewSym*;
- END DeleteNewSym;
+ PROCEDURE DeleteSym*(VAR modulename: ARRAY OF CHAR);
+ VAR fn: FileName; res: INTEGER;
+ BEGIN MakeFileName(modulename, fn, SFext); Files.Delete(fn, res)
+ END DeleteSym;
+
+ PROCEDURE DeleteObj*(VAR modulename: ARRAY OF CHAR);
+ VAR fn: FileName; res: INTEGER;
+ BEGIN MakeFileName(modulename, fn, Configuration.objext); Files.Delete(fn, res)
+ END DeleteObj;
PROCEDURE NewSym*(VAR modName: ARRAY OF CHAR);
VAR fileName: FileName;
@@ -686,7 +715,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
END WriteHex;
PROCEDURE WriteInt* (i: SYSTEM.INT64);
- VAR s: ARRAY 24 OF CHAR; i1, k: SYSTEM.INT64;
+ VAR s: ARRAY 26 OF CHAR; i1, k: SYSTEM.INT64;
BEGIN
IF (i = SignedMinimum(2)) OR (i = SignedMinimum(4)) OR (i = SignedMinimum(8)) THEN
(* abs(minint) is one more than maxint, causing problems representing the value as a minus sign
@@ -695,11 +724,12 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
only way to represent MinLInt. *)
Write("("); WriteInt(i+1); WriteString("-1)")
ELSE i1 := ABS(i);
- s[0] := CHR(i1 MOD 10 + ORD("0")); i1 := i1 DIV 10; k := 1;
+ IF i1 <= MAX(SYSTEM.INT32) THEN k := 0 ELSE s := "LL"; k := 2 END;
+ s[k] := CHR(i1 MOD 10 + ORD("0")); i1 := i1 DIV 10; INC(k);
WHILE i1 > 0 DO s[k] := CHR(i1 MOD 10 + ORD("0")); i1 := i1 DIV 10; INC(k) END ;
IF i < 0 THEN s[k] := "-"; INC(k) END ;
- WHILE k > 0 DO DEC(k); Write(s[k]) END
- END ;
+ WHILE k > 0 DO DEC(k); Write(s[k]) END;
+ END;
END WriteInt;
PROCEDURE WriteReal* (r: LONGREAL; suffx: CHAR);
@@ -742,7 +772,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
END Append;
PROCEDURE OpenFiles*(VAR moduleName: ARRAY OF CHAR);
- VAR FName: ARRAY 32 OF CHAR;
+ VAR FName: FileName;
BEGIN
COPY(moduleName, modName);
HFile := Files.New("");
@@ -756,7 +786,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
END OpenFiles;
PROCEDURE CloseFiles*;
- VAR FName: ARRAY 32 OF CHAR; res: INTEGER;
+ VAR FName: FileName; res: INTEGER;
BEGIN
IF noerr THEN LogWStr(" "); LogWNum(Files.Pos(R[BodyFile]), 0); LogWStr(" chars.") END;
IF noerr THEN
@@ -776,6 +806,51 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
END CloseFiles;
+(* === Installation directory discovery === *)
+
+ PROCEDURE IsProbablyInstallDir(s: ARRAY OF CHAR): BOOLEAN;
+ VAR testpath: ARRAY 4096 OF CHAR; identity: Platform.FileIdentity;
+ BEGIN
+ COPY(InstallDir, testpath);
+ Strings.Append("/lib/lib", testpath);
+ Strings.Append(Configuration.name, testpath);
+ Strings.Append("-O2.a", testpath);
+ IF Platform.IdentifyByName(testpath, identity) # 0 THEN RETURN FALSE END;
+
+ COPY(InstallDir, testpath);
+ Strings.Append("/2/include/Oberon.h", testpath);
+ IF Platform.IdentifyByName(testpath, identity) # 0 THEN RETURN FALSE END;
+
+ COPY(InstallDir, testpath);
+ Strings.Append("/2/sym/Files.sym", testpath);
+ IF Platform.IdentifyByName(testpath, identity) # 0 THEN RETURN FALSE END;
+
+ RETURN TRUE;
+ END IsProbablyInstallDir;
+
+ PROCEDURE FindInstallDir;
+ VAR i: INTEGER;
+ BEGIN
+ (* First try location of binary (with .d appended) *)
+ COPY(Modules.BinaryDir, InstallDir);
+ Strings.Append("/", InstallDir);
+ Strings.Append(Configuration.name, InstallDir);
+ Strings.Append(".d", InstallDir);
+ IF IsProbablyInstallDir(InstallDir) THEN RETURN END;
+
+ (* Now test whether binary is in bin directory under install dir. *)
+ COPY(Modules.BinaryDir, InstallDir);
+ i := Strings.Length(InstallDir);
+ WHILE (i > 0) & (InstallDir[i-1] # '/') DO DEC(i) END;
+ IF (i > 0) & (InstallDir[i-1] = '/') THEN
+ InstallDir[i-1] := 0X;
+ IF IsProbablyInstallDir(InstallDir) THEN RETURN END
+ END;
+
+ (* Give up! Use install directory from configuration. *)
+ COPY(Configuration.installdir, InstallDir)
+ END FindInstallDir;
+
BEGIN
@@ -783,4 +858,8 @@ BEGIN
MaxLReal := 1.7976931348623157D307 * 9.999999; (* LONGREAL is 8 bytes, should be 1.7976931348623157D308 *)
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 329d52b4..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
@@ -72,8 +73,8 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
VAR x: OPT.Node; sf: SYSTEM.INT64;
BEGIN
IF sym = OPS.lbrak THEN OPS.Get(sym);
- IF ~OPT.SYSimported THEN err(135) END;
- ConstExpression(x);
+ IF ~OPT.SYSimported THEN err(135) END;
+ ConstExpression(x);
IF x^.typ^.form = OPT.Int THEN sf := x^.conval^.intval;
IF (sf < 0) OR (sf > OPM.MaxSysFlag) THEN err(220); sf := 0 END
ELSE err(51); sf := 0
@@ -218,12 +219,10 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
END
END ;
CheckSym(OPS.colon); Type(typ, OPT.notyp);
-
IF ((typ.comp = OPT.Array) OR (typ.comp = OPT.Record))
& (typ.strobj = NIL) THEN
err(-309)
END;
-
IF mode = OPT.Var THEN typ^.pvused := TRUE END ;
(* typ^.pbused is set when parameter type name is parsed *)
WHILE first # NIL DO first^.typ := typ; first := first^.link END ;
@@ -739,7 +738,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
IF e THEN OPS.Get(sym); StatSeq(y)
ELSE
y := NIL;
- OPM.Mark(-307, OPM.curpos); (* notice about no OPS.else symbol; -- noch *)
+ OPM.Mark(-307, OPM.curpos); (* notice about no OPS.else symbol; -- noch *)
END ;
OPB.Construct(OPT.Ncaselse, cases, y); OPB.Construct(OPT.Ncase, x, cases);
cases^.conval := OPT.NewConst();
@@ -924,7 +923,18 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
OPT.Insert(OPS.name, obj); obj^.mode := OPT.Typ; obj^.typ := OPT.undftyp;
CheckMark(obj^.vis);
IF sym = OPS.eql THEN
- OPS.Get(sym); TypeDecl(obj^.typ, obj^.typ)
+ IF (obj^.name = "SHORTINT") OR
+ (obj^.name = "INTEGER") OR
+ (obj^.name = "LONGINT") OR
+ (obj^.name = "HUGEINT") OR
+ (obj^.name = "REAL") OR
+ (obj^.name = "LONGREAL") OR
+ (obj^.name = "SET") OR
+ (obj^.name = "CHAR") OR
+ (obj^.name = "TRUE") OR (obj^.name = "FALSE") THEN
+ OPM.Mark(-310, OPM.curpos); (* notice about aliasing of predefined type *)
+ END;
+ OPS.Get(sym); TypeDecl(obj^.typ, obj^.typ)
ELSIF (sym = OPS.becomes) OR (sym = OPS.colon) THEN
err(OPS.eql); OPS.Get(sym); TypeDecl(obj^.typ, obj^.typ)
ELSE err(OPS.eql)
@@ -996,19 +1006,9 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
c: LONGINT; done: BOOLEAN;
BEGIN
OPS.Init; LoopLevel := 0; level := 0; OPS.Get(sym);
- IF sym = OPS.module THEN OPS.Get(sym) ELSE
- (* Debug intermittent failure only found on OpenBSD *)
- OPM.LogWLn;
- OPM.LogWStr("Unexpected symbol found when MODULE expected:"); OPM.LogWLn;
- OPM.LogWStr(" sym: "); OPM.LogWNum(sym,1); OPM.LogWLn;
- OPM.LogWStr(" OPS.name: "); OPM.LogWStr(OPS.name); OPM.LogWLn;
- OPM.LogWStr(" OPS.str: "); OPM.LogWStr(OPS.str); OPM.LogWLn;
- OPM.LogWStr(" OPS.numtyp: "); OPM.LogWNum(OPS.numtyp,1); OPM.LogWLn;
- OPM.LogWStr(" OPS.intval: "); OPM.LogWNum(OPS.intval,1); OPM.LogWLn;
- err(16)
- END;
+ IF sym = OPS.module THEN OPS.Get(sym) ELSE err(16) END;
IF sym = OPS.ident THEN
- OPM.LogWStr("compiling "); OPM.LogWStr(OPS.name); OPM.LogW(".");
+ OPM.LogCompiling(OPS.name);
OPT.Init(OPS.name, opt); OPS.Get(sym); CheckSym(OPS.semicolon);
IF sym = OPS.import THEN OPS.Get(sym);
LOOP
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 54975745..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
@@ -176,7 +178,8 @@ CONST
Srvar* = 22; Svalpar* = 23; Svarpar* = 24; Sfld* = 25; Srfld* = 26;
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;
+ Sarr* = 37; Sdarr* = 38; Srec* = 39; Spro* = 40; Slink* = 37;
+ Scomment* = 41;
TYPE
ImpCtxt = RECORD
@@ -207,6 +210,18 @@ VAR
recno: LONGINT; (* number of anonymous record types *)
+(* Linking control - modules whose object files will be required to link a module. *)
+
+TYPE
+ Link* = POINTER TO LinkDesc;
+ LinkDesc* = RECORD
+ name-: OPS.Name;
+ next-: Link
+ END;
+
+VAR
+ Links-: Link;
+
PROCEDURE InitRecno*; BEGIN recno := 0 END InitRecno;
PROCEDURE err(n: INTEGER); BEGIN OPM.err(n) END err;
@@ -354,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;
@@ -392,7 +415,8 @@ BEGIN
topScope := universe; OpenScope(0, NIL); SYSimported := FALSE;
SelfName := name; topScope^.name := name;
GlbMod[0] := topScope; nofGmod := 1;
- newsf := nsf IN opt; findpc := fpc IN opt; extsf := newsf OR (esf IN opt); sfpresent := TRUE
+ newsf := nsf IN opt; findpc := fpc IN opt; extsf := newsf OR (esf IN opt); sfpresent := TRUE;
+ NEW(Links); Links.name := name
END Init;
PROCEDURE Close*;
@@ -454,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
@@ -466,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. *)
@@ -733,6 +776,20 @@ BEGIN
END
END InMod;
+PROCEDURE InLinks; (* Load a list of all modules whose object files we will need to link with *)
+ VAR linkname: OPS.Name; l: Link;
+BEGIN
+ InName(linkname);
+ WHILE linkname[0] # 0X DO
+ l := Links; WHILE (l # NIL) & (l.name # linkname) DO l := l.next END;
+ IF l = NIL THEN
+ l := Links; NEW(Links);
+ Links.next := l; Links.name := linkname
+ END;
+ InName(linkname)
+ END
+END InLinks;
+
PROCEDURE InConstant(f: LONGINT; conval: Const);
VAR ch: CHAR; i: INTEGER; ext: ConstExt; rval: REAL;
BEGIN
@@ -754,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;
@@ -763,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;
@@ -945,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 *)
@@ -958,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);
@@ -970,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 *)
@@ -1012,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
@@ -1020,9 +1150,13 @@ BEGIN
ELSE
impCtxt.nofr := FirstRef(*Comp+1*); impCtxt.minr := maxStruct; impCtxt.nofm := 0;
impCtxt.self := aliasName = "@self"; impCtxt.reffp := 0;
- OPM.OldSym(name, done);
+ IF impCtxt.self & (OPM.forcenewsym IN OPM.Options) THEN
+ OPM.DeleteSym(name); done := FALSE
+ ELSE
+ OPM.OldSym(name, done)
+ END;
IF done THEN
- InMod(mno);
+ InMod(mno); InLinks;
impCtxt.nextTag := OPM.SymRInt();
WHILE ~OPM.eofSF() DO
obj := InObj(mno); impCtxt.nextTag := OPM.SymRInt()
@@ -1057,6 +1191,13 @@ END Import;
END
END OutMod;
+ PROCEDURE OutLinks;
+ VAR l: Link;
+ BEGIN
+ l := Links; WHILE l # NIL DO OutName(l.name); l := l.next END;
+ OPM.SymWCh(0X)
+ END OutLinks;
+
PROCEDURE ^OutStr(typ: Struct);
PROCEDURE ^OutFlds(fld: Object; adr: LONGINT; visible: BOOLEAN);
@@ -1187,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;
@@ -1235,7 +1406,7 @@ END Import;
IF OPM.noerr THEN (* ~OPM.noerr => ~done *)
OPM.NewSym(SelfName);
IF OPM.noerr THEN
- OPM.SymWInt(Smname); OutName(SelfName);
+ OPM.SymWInt(Smname); OutName(SelfName); OutLinks;
expCtxt.reffp := 0; expCtxt.ref := FirstRef(*Comp+1*);
expCtxt.nofm := 1; expCtxt.locmno[0] := 0;
i := 1; WHILE i < maxImps DO expCtxt.locmno[i] := -1; INC(i) END;
@@ -1248,7 +1419,7 @@ END Import;
END;
newsf := FALSE; symNew := FALSE; (* because of call to FPrintErr from OPL *)
IF ~OPM.noerr OR findpc THEN
- OPM.DeleteNewSym
+ OPM.DeleteSym(SelfName)
END
(* OPM.RegisterNewSym is called in OP2 after writing the object file *)
END
@@ -1256,6 +1427,8 @@ END Import;
END Export; (* no new symbol file if ~OPM.noerr or findpc *)
+(*------------------------- Initialise types --------------------------*)
+
PROCEDURE InitStruct(VAR typ: Struct; form: SHORTINT);
BEGIN
typ := NewStr(form, Basic); typ^.ref := form; typ^.size := 1; typ^.allocated := TRUE;
diff --git a/src/compiler/OPV.Mod b/src/compiler/OPV.Mod
index cd3c649c..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 ;
@@ -785,8 +795,17 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
OPM.WriteString(MoveFunc);
expr(r, MinPrec); OPM.WriteString(Comma); expr(l, MinPrec); OPM.WriteString(Comma);
IF r^.typ = OPT.stringtyp THEN OPM.WriteInt(r^.conval^.intval2)
- ELSE OPM.WriteInt(r^.typ^.size)
- END ;
+ ELSIF r.typ.comp = OPT.DynArr THEN
+ (* Dynamic array to array copy *)
+ OPM.WriteString("__X(");
+ OPC.Len(r.obj, r.typ, 0); OPM.WriteString(" * "); OPM.WriteInt(r.typ.BaseTyp.size);
+ OPM.WriteString(", ");
+ OPM.WriteInt(l.typ.size+1); (* _X validates 0 .. n-1 so we need top+1. *)
+ OPM.Write(")")
+ ELSE (* Array to array copy. *)
+ ASSERT(r.typ.comp = OPT.Array); ASSERT(r.typ.size <= l.typ.size);
+ OPM.WriteInt(r^.typ^.size)
+ END;
OPM.Write(CloseParen)
ELSE
IF (l^.typ^.form = OPT.Pointer) & (l^.obj # NIL) & (l^.obj^.adr = 1) & (l^.obj^.mode = OPT.Var) THEN
diff --git a/src/compiler/extTools.Mod b/src/compiler/extTools.Mod
index 2847768e..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,37 +60,64 @@ 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);
- execute("Assemble: ", cmd);
+ execute("C compile: ", cmd);
END Assemble;
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);
- Strings.Append(Configuration.linkflags, cmd);
- Strings.Append(Configuration.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("Assemble and link: ", cmd);
+ 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;
+ 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/ulm/ulmAssertions.Mod b/src/library/ulm/ulmAssertions.Mod
index 0f6fe59e..dcceea08 100644
--- a/src/library/ulm/ulmAssertions.Mod
+++ b/src/library/ulm/ulmAssertions.Mod
@@ -35,7 +35,7 @@ MODULE ulmAssertions;
(* general error handling of library routines *)
- IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, IO := ulmIO, Priorities := ulmPriorities, RelatedEvents := ulmRelatedEvents, Services := ulmServices;
+ IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, IO := ulmIO, Priorities := ulmPriorities, RelatedEvents := ulmRelatedEvents, Services := ulmServices, Types := ulmTypes;
TYPE
Object = Disciplines.Object;
diff --git a/src/library/ulm/ulmAsymmetricCiphers.Mod b/src/library/ulm/ulmAsymmetricCiphers.Mod
index ba8dfdda..069972bd 100644
--- a/src/library/ulm/ulmAsymmetricCiphers.Mod
+++ b/src/library/ulm/ulmAsymmetricCiphers.Mod
@@ -30,13 +30,13 @@ MODULE ulmAsymmetricCiphers; (* Michael Szczuka *)
(* abstraction for the use of public key ciphers *)
- IMPORT BlockCiphers := ulmBlockCiphers, Ciphers := ulmCiphers, NetIO := ulmNetIO, PersistentObjects := ulmPersistentObjects, Services := ulmServices, Streams := ulmStreams;
+ IMPORT BlockCiphers := ulmBlockCiphers, Ciphers := ulmCiphers, NetIO := ulmNetIO, PersistentObjects := ulmPersistentObjects, Services := ulmServices, Streams := ulmStreams, Types := ulmTypes;
CONST
composed* = 0; isPrivateKey* = 1;
TYPE
- CapabilitySet* = SET;
+ CapabilitySet* = Types.Set;
TYPE
Cipher* = POINTER TO CipherRec;
@@ -66,13 +66,13 @@ MODULE ulmAsymmetricCiphers; (* Michael Szczuka *)
(* need to have this in case anyone wants to decrypt something with
a public cipher ... *)
PROCEDURE Identity(in: Streams.Stream; key: Ciphers.Cipher;
- length: INTEGER; out: Streams.Stream) : BOOLEAN;
+ length: Types.Int32; out: Streams.Stream) : BOOLEAN;
BEGIN
RETURN Streams.Copy(in, out, length);
END Identity;
PROCEDURE Init* (key: Cipher; if: Interface;
- cap: CapabilitySet; inLength, outLength: INTEGER);
+ cap: CapabilitySet; inLength, outLength: Types.Int32);
BEGIN
IF if.decrypt = NIL THEN
(* decrypt is not defined, so we have only the public part of a cipher;
@@ -122,7 +122,7 @@ MODULE ulmAsymmetricCiphers; (* Michael Szczuka *)
END ComposedEncrypt;
PROCEDURE ComposedEncryptPart* (in: Streams.Stream; key: Cipher;
- length: INTEGER;
+ length: Types.Int32;
out: Streams.Stream) : BOOLEAN;
BEGIN
RETURN key.asymIf.compencrypt(in, key, length, out);
@@ -131,7 +131,7 @@ MODULE ulmAsymmetricCiphers; (* Michael Szczuka *)
PROCEDURE ComposedEncryptBlock* (in: Streams.Stream; key: Cipher;
out: Streams.Stream) : BOOLEAN;
VAR
- length : INTEGER;
+ length : Types.Int32;
BEGIN
length := BlockCiphers.GetInLength(key);
RETURN key.asymIf.compencrypt(in, key, length, out);
diff --git a/src/library/ulm/ulmBlockCiphers.Mod b/src/library/ulm/ulmBlockCiphers.Mod
index 41e3355c..630b4c91 100644
--- a/src/library/ulm/ulmBlockCiphers.Mod
+++ b/src/library/ulm/ulmBlockCiphers.Mod
@@ -30,7 +30,7 @@ MODULE ulmBlockCiphers; (* Michael Szczuka *)
(* abstraction for the use of block ciphers *)
- IMPORT Ciphers := ulmCiphers, NetIO := ulmNetIO, PersistentObjects := ulmPersistentObjects, Services := ulmServices, Streams := ulmStreams;
+ IMPORT Ciphers := ulmCiphers, NetIO := ulmNetIO, PersistentObjects := ulmPersistentObjects, Services := ulmServices, Streams := ulmStreams, Types := ulmTypes;
TYPE
Cipher* = POINTER TO CipherRec;
@@ -38,8 +38,8 @@ MODULE ulmBlockCiphers; (* Michael Szczuka *)
CipherRec* = RECORD
(Ciphers.CipherRec)
(* private *)
- inLength: INTEGER;
- outLength: INTEGER;
+ inLength: Types.Int32;
+ outLength: Types.Int32;
END;
VAR
@@ -47,7 +47,7 @@ MODULE ulmBlockCiphers; (* Michael Szczuka *)
if : PersistentObjects.Interface;
PROCEDURE Init* (key: Cipher; if: Ciphers.Interface;
- inLength, outLength: INTEGER);
+ inLength, outLength: Types.Int32);
(* init a block cipher with its special interface *)
BEGIN
Ciphers.Init(key, if);
@@ -57,13 +57,13 @@ MODULE ulmBlockCiphers; (* Michael Szczuka *)
key.outLength := outLength;
END Init;
- PROCEDURE GetInLength* (key: Cipher) : INTEGER;
+ PROCEDURE GetInLength* (key: Cipher) : Types.Int32;
(* returns the input block length of a block cipher *)
BEGIN
RETURN key.inLength;
END GetInLength;
- PROCEDURE GetOutLength* (key: Cipher) : INTEGER;
+ PROCEDURE GetOutLength* (key: Cipher) : Types.Int32;
(* returns the output block length of a block cipher *)
BEGIN
RETURN key.outLength;
@@ -72,7 +72,7 @@ MODULE ulmBlockCiphers; (* Michael Szczuka *)
PROCEDURE EncryptBlock* (in: Streams.Stream; key: Cipher;
out: Streams.Stream) : BOOLEAN;
VAR
- length : INTEGER;
+ length : Types.Int32;
BEGIN
length := GetInLength(key);
RETURN Ciphers.EncryptPart(in, key, length, out);
@@ -81,7 +81,7 @@ MODULE ulmBlockCiphers; (* Michael Szczuka *)
PROCEDURE DecryptBlock* (in: Streams.Stream; key: Cipher;
out: Streams.Stream) : BOOLEAN;
VAR
- length : INTEGER;
+ length : Types.Int32;
BEGIN
length := GetOutLength(key);
RETURN Ciphers.DecryptPart(in, key, length, out);
diff --git a/src/library/ulm/ulmCipherOps.Mod b/src/library/ulm/ulmCipherOps.Mod
index f2ef7602..39d951c2 100644
--- a/src/library/ulm/ulmCipherOps.Mod
+++ b/src/library/ulm/ulmCipherOps.Mod
@@ -30,18 +30,18 @@ MODULE ulmCipherOps; (* Michael Szczuka *)
(* useful functions for stream ciphers *)
- IMPORT Streams := ulmStreams, SYS := SYSTEM, Write := ulmWrite;
+ IMPORT Streams := ulmStreams, SYS := SYSTEM, Write := ulmWrite, Types := ulmTypes;
PROCEDURE XorByte* (b1, b2: SYS.BYTE) : SYS.BYTE;
(* adds two bytes bitwise modulo 2 *)
BEGIN
- (*RETURN SYS.VAL(SYS.BYTE, SYS.VAL(SET, LONG(b1)) / SYS.VAL(SET, LONG(b2)))*)
- RETURN SYS.VAL(SYS.BYTE, SYS.VAL(SET, LONG(LONG(SYS.VAL(SHORTINT, b1))))
- / SYS.VAL(SET, LONG(LONG(SYS.VAL(SHORTINT, b2)))))
+ (*RETURN SYS.VAL(SYS.BYTE, SYS.VAL(Types.Set, LONG(b1)) / SYS.VAL(Types.Set, LONG(b2)))*)
+ RETURN SYS.VAL(SYS.BYTE, SYS.VAL(Types.Set, LONG(LONG(SYS.VAL(Types.Int8, b1))))
+ / SYS.VAL(Types.Set, LONG(LONG(SYS.VAL(Types.Int8, b2)))))
END XorByte;
PROCEDURE XorStream* (in1, in2, out: Streams.Stream;
- length: INTEGER) : BOOLEAN;
+ length: Types.Int32) : BOOLEAN;
(* adds two streams bitwise modulo 2; restricted to length bytes *)
VAR
b1, b2, res : SYS.BYTE;
diff --git a/src/library/ulm/ulmCiphers.Mod b/src/library/ulm/ulmCiphers.Mod
index 95d66aa8..fbd97445 100644
--- a/src/library/ulm/ulmCiphers.Mod
+++ b/src/library/ulm/ulmCiphers.Mod
@@ -30,14 +30,14 @@
MODULE ulmCiphers;
IMPORT Objects := ulmObjects, PersistentObjects := ulmPersistentObjects, PersistentDisciplines := ulmPersistentDisciplines, Services := ulmServices,
- Streams := ulmStreams, Write := ulmWrite;
+ Streams := ulmStreams, Write := ulmWrite, Types := ulmTypes;
TYPE
Cipher* = POINTER TO CipherRec;
TYPE
CryptProc* = PROCEDURE (in: Streams.Stream; key: Cipher;
- length: INTEGER; out: Streams.Stream) : BOOLEAN;
+ length: Types.Int32; out: Streams.Stream) : BOOLEAN;
TYPE
Interface* = POINTER TO InterfaceRec;
@@ -77,13 +77,13 @@ BEGIN
END Decrypt;
PROCEDURE EncryptPart*(in: Streams.Stream; key: Cipher;
- length: INTEGER; out: Streams.Stream) : BOOLEAN;
+ length: Types.Int32; out: Streams.Stream) : BOOLEAN;
BEGIN
RETURN key.if.encrypt(in, key, length, out);
END EncryptPart;
PROCEDURE DecryptPart*(in: Streams.Stream; key: Cipher;
- length: INTEGER; out: Streams.Stream) : BOOLEAN;
+ length: Types.Int32; out: Streams.Stream) : BOOLEAN;
BEGIN
RETURN key.if.decrypt(in, key, length, out);
END DecryptPart;
diff --git a/src/library/ulm/ulmClocks.Mod b/src/library/ulm/ulmClocks.Mod
index d0416cfb..6a72d661 100644
--- a/src/library/ulm/ulmClocks.Mod
+++ b/src/library/ulm/ulmClocks.Mod
@@ -37,7 +37,7 @@
MODULE ulmClocks;
IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Op := ulmOperations, Priorities := ulmPriorities,
- RelatedEvents := ulmRelatedEvents, Services := ulmServices, Times := ulmTimes;
+ RelatedEvents := ulmRelatedEvents, Services := ulmServices, Times := ulmTimes, Types := ulmTypes;
TYPE
Clock* = POINTER TO ClockRec;
@@ -45,7 +45,7 @@ MODULE ulmClocks;
CONST
settime* = 0; timer* = 1; passed* = 2;
TYPE
- CapabilitySet* = SET; (* OF [settime..passed] *)
+ CapabilitySet* = Types.Set; (* OF [settime..passed] *)
TYPE
GetTimeProc* = PROCEDURE (clock: Clock; VAR time: Times.Time);
SetTimeProc* = PROCEDURE (clock: Clock; time: Times.Time);
@@ -102,13 +102,13 @@ MODULE ulmClocks;
ErrorEventRec* =
RECORD
(Events.EventRec)
- errorcode*: SHORTINT;
+ errorcode*: Types.Int8;
END;
VAR
errormsg*: ARRAY errorcodes OF Events.Message;
error*: Events.EventType;
- PROCEDURE Error(clock: Clock; code: SHORTINT);
+ PROCEDURE Error(clock: Clock; code: Types.Int8);
VAR
event: ErrorEvent;
BEGIN
diff --git a/src/library/ulm/ulmConclusions.Mod b/src/library/ulm/ulmConclusions.Mod
index 2d0a6ade..7012b15c 100644
--- a/src/library/ulm/ulmConclusions.Mod
+++ b/src/library/ulm/ulmConclusions.Mod
@@ -39,22 +39,22 @@ MODULE ulmConclusions;
*)
IMPORT Errors := ulmErrors, Events := ulmEvents, Process := ulmProcess, RelatedEvents := ulmRelatedEvents, StreamDisciplines := ulmStreamDisciplines,
- Streams := ulmStreams, Strings := ulmStrings, Write := ulmWrite;
+ Streams := ulmStreams, Strings := ulmStrings, Write := ulmWrite, Types := ulmTypes;
VAR
handlerSet*: Errors.HandlerSet;
- errors*: INTEGER; (* number of errors *)
- fatalcode*: INTEGER; (* exit code on fatal events *)
+ errors*: Types.Int32; (* number of errors *)
+ fatalcode*: Types.Int32; (* exit code on fatal events *)
(* private variables *)
cmdName: Process.Name; (* should be sufficient for a base name *)
- cmdNameLen: INTEGER; (* Strings.Len(cmdName) *)
+ cmdNameLen: Types.Int32; (* Strings.Len(cmdName) *)
(* private procedures *)
PROCEDURE GeneralHandler(event: Events.Event; kind: Errors.Kind);
VAR
- width: INTEGER;
+ width: Types.Int32;
BEGIN
IF event # NIL THEN
Write.IndentS(Streams.stderr);
@@ -114,7 +114,7 @@ MODULE ulmConclusions;
text: ARRAY OF CHAR);
VAR
queue: RelatedEvents.Queue;
- width: INTEGER;
+ width: Types.Int32;
PROCEDURE ReverseQueue(VAR queue: RelatedEvents.Queue);
VAR
diff --git a/src/library/ulm/ulmConditions.Mod b/src/library/ulm/ulmConditions.Mod
index 2b983470..101d590c 100644
--- a/src/library/ulm/ulmConditions.Mod
+++ b/src/library/ulm/ulmConditions.Mod
@@ -60,12 +60,12 @@
MODULE ulmConditions;
IMPORT Clocks := ulmClocks, Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Op := ulmOperations,
- Priorities := ulmPriorities, Process := ulmProcess, RelatedEvents := ulmRelatedEvents, Scales := ulmScales, Timers := ulmTimers, Times := ulmTimes, SYSTEM;
+ Priorities := ulmPriorities, Process := ulmProcess, RelatedEvents := ulmRelatedEvents, Scales := ulmScales, Timers := ulmTimers, Times := ulmTimes, SYSTEM, Types := ulmTypes;
CONST
tags = 64;
TYPE
- Tag = INTEGER; (* 0..tags-1 *)
+ Tag = Types.Int32; (* 0..tags-1 *)
(* tags are used for the hashs *)
VAR
nextTag: Tag; (* 0..tags-1, 0..tags-1, ... *)
@@ -95,16 +95,16 @@ MODULE ulmConditions;
ConditionSetRec* =
RECORD
(Objects.ObjectRec)
- cardinality: INTEGER;
+ cardinality: Types.Int32;
bucket: BucketTable;
(* for the iterator *)
- next: ConditionList; i: INTEGER;
+ next: ConditionList; i: Types.Int32;
END;
CONST
select* = 0; timelimit* = 1; async* = 2; timecond* = 3; preconditions* = 4;
TYPE
- CapabilitySet* = SET; (* OF [select..preconditions] *)
+ CapabilitySet* = Types.Set; (* OF [select..preconditions] *)
TYPE
SelectProc* = PROCEDURE (domain: Domain; conditionSet: ConditionSet;
time: Times.Time;
@@ -159,7 +159,7 @@ MODULE ulmConditions;
END;
TYPE
- GetTimeOfNextTryProc* = PROCEDURE (iteration: INTEGER;
+ GetTimeOfNextTryProc* = PROCEDURE (iteration: Types.Int32;
VAR time: Times.Time);
(* return a relative time measure *)
VAR
@@ -188,7 +188,7 @@ MODULE ulmConditions;
getTimeOfNextTry := p;
END SetGetTimeOfNextTryProc;
- PROCEDURE GetTimeOfNextTry(iteration: INTEGER; VAR time: Times.Time);
+ PROCEDURE GetTimeOfNextTry(iteration: Types.Int32; VAR time: Times.Time);
BEGIN
Times.CreateAndSet(time, Times.relative, 0, 1, 0);
iteration := iteration DIV 5;
@@ -203,7 +203,7 @@ MODULE ulmConditions;
PROCEDURE CreateSet*(VAR conditionSet: ConditionSet);
VAR
- i: INTEGER;
+ i: Types.Int32;
cset: ConditionSet;
BEGIN
NEW(cset);
@@ -226,7 +226,7 @@ MODULE ulmConditions;
VAR
listp: ConditionList;
new: ConditionList;
- i: INTEGER;
+ i: Types.Int32;
BEGIN
(* check if condition is already present in conditionSet *)
i := condition.tag;
@@ -245,7 +245,7 @@ MODULE ulmConditions;
PROCEDURE Excl*(conditionSet: ConditionSet; condition: Condition);
VAR
prev, listp: ConditionList;
- i: INTEGER;
+ i: Types.Int32;
BEGIN
i := condition.tag;
listp := conditionSet.bucket[i]; prev := NIL;
@@ -282,8 +282,8 @@ MODULE ulmConditions;
VAR
listp: ConditionList;
newelem, newelems: ConditionList;
- count: INTEGER; (* # of added elements in newelems *)
- i: INTEGER;
+ count: Types.Int32; (* # of added elements in newelems *)
+ i: Types.Int32;
BEGIN
count := 0;
i := 0;
@@ -320,7 +320,7 @@ MODULE ulmConditions;
CreateSet(result); Union(result, set1); Union(result, set2);
END Union3;
- PROCEDURE Card*(conditionSet: ConditionSet) : INTEGER;
+ PROCEDURE Card*(conditionSet: ConditionSet) : Types.Int32;
BEGIN
RETURN conditionSet.cardinality
END Card;
@@ -334,7 +334,7 @@ MODULE ulmConditions;
PROCEDURE GetNextCondition*(conditionSet: ConditionSet;
VAR condition: Condition) : BOOLEAN;
VAR
- i: INTEGER;
+ i: Types.Int32;
BEGIN
IF conditionSet.next = NIL THEN
i := conditionSet.i;
@@ -380,7 +380,7 @@ MODULE ulmConditions;
VAR domain: Domain) : BOOLEAN;
VAR
dom: Domain;
- i: INTEGER;
+ i: Types.Int32;
listp: ConditionList;
BEGIN
dom := NIL;
@@ -448,7 +448,7 @@ MODULE ulmConditions;
VAR
listp: ConditionList;
- i: INTEGER;
+ i: Types.Int32;
PROCEDURE CreateList(VAR list: List);
BEGIN
@@ -555,7 +555,7 @@ MODULE ulmConditions;
PROCEDURE SetupAsyncEvents(list: List) : BOOLEAN;
VAR
elp: Element;
- listp: ConditionList; i: INTEGER;
+ listp: ConditionList; i: Types.Int32;
wakeupEvent: WakeupEvent;
sendevent: SendEventProc;
anythingTrue: BOOLEAN;
@@ -603,7 +603,7 @@ MODULE ulmConditions;
queue: RelatedEvents.Queue; (* queue of waitErrors *)
busyLoop: BOOLEAN; (* TRUE if we have to resort to a busy loop *)
wakeupEvent: Events.Event; (* iteration event for busy loops *)
- loopCnt: INTEGER; (* number of iterations *)
+ loopCnt: Types.Int32; (* number of iterations *)
nextTime: Times.Time;
minTime: Times.Time;
minTimeCond: Condition;
@@ -679,7 +679,7 @@ MODULE ulmConditions;
VAR setOfTrueConditions: ConditionSet;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
- listp: ConditionList; i: INTEGER;
+ listp: ConditionList; i: Types.Int32;
condition: Condition;
anythingTrue: BOOLEAN;
BEGIN (* TestAndSelect *)
@@ -728,7 +728,7 @@ MODULE ulmConditions;
PROCEDURE TestAsyncList(list: List) : BOOLEAN;
VAR
element: Element;
- listp: ConditionList; i: INTEGER;
+ listp: ConditionList; i: Types.Int32;
condition: Condition;
anythingFound: BOOLEAN;
BEGIN
@@ -872,7 +872,7 @@ MODULE ulmConditions;
VAR setOfTrueConditions: ConditionSet;
errors: RelatedEvents.Object);
VAR
- listp: ConditionList; i: INTEGER;
+ listp: ConditionList; i: Types.Int32;
testSet: ConditionSet;
preconds: ConditionSet;
domain: Domain;
@@ -881,7 +881,7 @@ MODULE ulmConditions;
PROCEDURE PretestClosure(testSet, preconds: ConditionSet);
VAR
- listp: ConditionList; i: INTEGER;
+ listp: ConditionList; i: Types.Int32;
domain: Domain;
morePreconditions: ConditionSet;
evenMorePreconditions: ConditionSet;
diff --git a/src/library/ulm/ulmConstStrings.Mod b/src/library/ulm/ulmConstStrings.Mod
index ae62e3b7..61f73a28 100644
--- a/src/library/ulm/ulmConstStrings.Mod
+++ b/src/library/ulm/ulmConstStrings.Mod
@@ -49,8 +49,7 @@ MODULE ulmConstStrings;
(* WORM-device for strings *)
- IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Process := ulmProcess, Services := ulmServices, Streams := ulmStreams, Strings := ulmStrings,
- Texts := ulmTexts, Types := ulmTypes;
+ IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Process := ulmProcess, Services := ulmServices, Streams := ulmStreams, Strings := ulmStrings, Texts := ulmTexts, Types := ulmTypes;
CONST
tabsize = 1031; (* should be a prime number *)
@@ -65,7 +64,7 @@ MODULE ulmConstStrings;
BufferRec =
RECORD
buf: ARRAY bufsize OF CHAR;
- free: INTEGER; (* buf[free..bufsize-1] is unused *)
+ free: Types.Int32; (* buf[free..bufsize-1] is unused *)
next: Buffer;
END;
@@ -74,17 +73,17 @@ MODULE ulmConstStrings;
RECORD
(Disciplines.ObjectRec)
(* read-only *)
- len-: Streams.Count; (* length of string in bytes *)
- hashval-: LONGINT; (* hash value *)
+ len*: Streams.Count; (* length of string in bytes *)
+ hashval*: Types.Int32; (* hash value *)
(* private part *)
domain: Domain;
length: Streams.Count; (* private copy of length *)
buf: Buffer; (* first buffer containing the string *)
- offset: INTEGER; (* offset into buf *)
+ offset: Types.Int32; (* offset into buf *)
next: String; (* list of strings with same hash value *)
END;
- TYPE
+ TYPE
DomainRec* =
RECORD
(Disciplines.ObjectRec)
@@ -108,7 +107,7 @@ MODULE ulmConstStrings;
(Streams.StreamRec)
string: String;
buf: Buffer; (* current buffer *)
- offset: INTEGER; (* index in current buffer *)
+ offset: Types.Int32; (* index in current buffer *)
pos: Streams.Count; (* current position *)
END;
@@ -121,7 +120,7 @@ MODULE ulmConstStrings;
(* === internal procedures =========================================== *)
PROCEDURE HashVal(s: Streams.Stream; len: Streams.Count;
- VAR hashval, orighashval: LONGINT);
+ VAR hashval, orighashval: Types.Int32);
(* compute the hash value of the first `len' bytes of `s';
the hash value is returned in two variants:
hashval: hash value MOD tabsize
@@ -130,7 +129,7 @@ MODULE ulmConstStrings;
CONST
shift = 4;
VAR
- ordval: INTEGER;
+ ordval: Types.Int32;
ch: CHAR;
index: Streams.Count;
@@ -159,7 +158,7 @@ MODULE ulmConstStrings;
*)
VAR
ch: CHAR;
- buf: Buffer; offset: INTEGER;
+ buf: Buffer; offset: Types.Int32;
index: Streams.Count;
BEGIN
Streams.SetPos(s, 0);
@@ -183,7 +182,7 @@ MODULE ulmConstStrings;
END Equal;
PROCEDURE Allocate(domain: Domain; len: Streams.Count;
- VAR buf: Buffer; VAR offset: INTEGER);
+ VAR buf: Buffer; VAR offset: Types.Int32);
(* allocate space for `len' bytes;
`buf' and `offset' are returned, designating the
begin of the allocated area; note that
@@ -214,9 +213,9 @@ MODULE ulmConstStrings;
offset := buf.free;
WHILE len > 0 DO
IF len <= bufsize - domain.tail.free THEN
- INC(domain.tail.free, SHORT(len)); len := 0;
+ INC(domain.tail.free, len); len := 0;
ELSE
- DEC(len, bufsize - LONG(domain.tail.free));
+ DEC(len, bufsize - domain.tail.free);
domain.tail.free := bufsize;
NewBuffer;
END;
@@ -224,7 +223,7 @@ MODULE ulmConstStrings;
END Allocate;
PROCEDURE CopyString(s: Streams.Stream; length: Streams.Count;
- buf: Buffer; offset: INTEGER);
+ buf: Buffer; offset: Types.Int32);
(* copy `length' bytes from `s' to `buf' at the given offset
and its subsequent buffers
*)
@@ -254,7 +253,7 @@ MODULE ulmConstStrings;
VAR string: String);
(* common part of CloseD and CreateD *)
VAR
- orighashval, hashval: LONGINT;
+ orighashval, hashval: Types.Int32;
str: String;
BEGIN
HashVal(s, length, hashval, orighashval);
@@ -358,7 +357,7 @@ MODULE ulmConstStrings;
s := rs;
END Open;
- PROCEDURE Compare*(string1, string2: String) : INTEGER;
+ PROCEDURE Compare*(string1, string2: String) : Types.Int32;
(* returns < 0: if string1 < string2
= 0: if string1 = string2 (see note above)
> 0: if string1 > string2
@@ -366,10 +365,10 @@ MODULE ulmConstStrings;
VAR
ch1, ch2: CHAR;
buf1, buf2: Buffer;
- offset1, offset2: INTEGER;
+ offset1, offset2: Types.Int32;
len1, len2: Streams.Count;
- PROCEDURE Next(VAR buf: Buffer; VAR offset: INTEGER; VAR ch: CHAR);
+ PROCEDURE Next(VAR buf: Buffer; VAR offset: Types.Int32; VAR ch: CHAR);
BEGIN
ch := buf.buf[offset];
INC(offset);
@@ -409,7 +408,7 @@ MODULE ulmConstStrings;
VAR
len: Streams.Count;
buf: Buffer;
- offset: INTEGER;
+ offset: Types.Int32;
count: Streams.Count;
bytes: Streams.Count;
BEGIN
@@ -427,7 +426,7 @@ MODULE ulmConstStrings;
INC(count, s.count);
EXIT
END;
- INC(count, bytes); DEC(len, bytes); INC(offset, SHORT(bytes));
+ INC(count, bytes); DEC(len, bytes); INC(offset, bytes);
IF offset >= bufsize THEN
buf := buf.next;
offset := 0;
@@ -441,7 +440,7 @@ MODULE ulmConstStrings;
VAR
len: Streams.Count;
buf: Buffer;
- offset: INTEGER;
+ offset: Types.Int32;
index: Streams.Count;
BEGIN
len := string.length;
@@ -480,7 +479,7 @@ MODULE ulmConstStrings;
END;
END ReadByte;
- PROCEDURE ReadBuf(s: Streams.Stream; VAR buf: ARRAY OF Types.Byte(*BYTE*);
+ PROCEDURE ReadBuf(s: Streams.Stream; VAR buf: ARRAY OF Types.Byte;
off, cnt: Streams.Count) : Streams.Count;
VAR
bytes, max: Streams.Count;
@@ -520,7 +519,6 @@ MODULE ulmConstStrings;
| Streams.fromStart: realpos := cnt;
| Streams.fromPos: realpos := s.pos + cnt;
| Streams.fromEnd: realpos := s.string.length + cnt;
- ELSE
END;
IF (realpos < 0) OR (realpos > s.string.length) THEN
RETURN FALSE
@@ -531,10 +529,10 @@ MODULE ulmConstStrings;
END;
WHILE s.pos < realpos DO
IF realpos - s.pos < bufsize - s.offset THEN
- INC(s.offset, SHORT(realpos - s.pos));
+ INC(s.offset, realpos - s.pos);
s.pos := realpos;
ELSE
- INC(s.pos, LONG(bufsize - s.offset));
+ INC(s.pos, bufsize - s.offset);
s.offset := 0;
s.buf := s.buf.next;
END;
diff --git a/src/library/ulm/ulmEvents.Mod b/src/library/ulm/ulmEvents.Mod
index 52695762..07deb129 100644
--- a/src/library/ulm/ulmEvents.Mod
+++ b/src/library/ulm/ulmEvents.Mod
@@ -39,7 +39,7 @@
MODULE ulmEvents;
- IMPORT Objects := ulmObjects, Priorities := ulmPriorities, Services := ulmServices, SYS := ulmSYSTEM;
+ IMPORT Objects := ulmObjects, Priorities := ulmPriorities, Services := ulmServices, SYS := ulmSYSTEM, Types := ulmTypes;
TYPE
EventType* = POINTER TO EventTypeRec;
@@ -51,7 +51,7 @@ MODULE ulmEvents;
funcs* = 2; (* call associated event handlers *)
TYPE
- Reaction* = INTEGER; (* one of default, ignore, or funcs *)
+ Reaction* = Types.Int32; (* one of default, ignore, or funcs *)
Message* = ARRAY 80 OF CHAR;
Event* = POINTER TO EventRec;
EventRec* =
@@ -69,7 +69,7 @@ MODULE ulmEvents;
*)
EventManager = PROCEDURE (type: EventType; reaction: Reaction);
- Priority = INTEGER; (* must be non-negative *)
+ Priority = Types.Int32; (* must be non-negative *)
(* every event with reaction `funcs' has a handler list;
the list is in calling order which is reverse to
@@ -104,7 +104,7 @@ MODULE ulmEvents;
Queue = POINTER TO QueueRec;
QueueRec =
RECORD
- priority: INTEGER; (* queue for this priority *)
+ priority: Types.Int32; (* queue for this priority *)
head, tail: Event;
next: Queue; (* queue with lower priority *)
END;
@@ -125,8 +125,8 @@ MODULE ulmEvents;
(* private part *)
currentPriority: Priority;
priotab: ARRAY priotabsize OF Priority;
- priotop: INTEGER;
- overflow: INTEGER; (* of priority table *)
+ priotop: Types.Int32;
+ overflow: Types.Int32; (* of priority table *)
END;
CONST
@@ -141,7 +141,7 @@ MODULE ulmEvents;
ErrorEventRec* =
RECORD
(EventRec)
- errorcode*: SHORTINT;
+ errorcode*: Types.Int8;
END;
VAR
@@ -151,7 +151,7 @@ MODULE ulmEvents;
VAR
(* private part *)
abort, log, queueHandler: EventHandler;
- nestlevel: INTEGER; (* of Raise calls *)
+ nestlevel: Types.Int32; (* of Raise calls *)
queue: Queue;
lock: BOOLEAN; (* lock critical operations *)
psys: PrioritySystem; (* current priority system *)
@@ -173,7 +173,7 @@ MODULE ulmEvents;
"negative priority given to Events.SetPriority";
END InitErrorHandling;
- PROCEDURE Error(code: SHORTINT);
+ PROCEDURE Error(code: Types.Int8);
VAR event: ErrorEvent;
BEGIN
NEW(event); event.type := error;
@@ -301,10 +301,10 @@ MODULE ulmEvents;
(* now QueueHandler will translate partly like
BOOLEAN b;
handler_EventHandler tmphandler;
- LONGINT i, j;
- i = (LONGINT)handler;
+ Types.Int32 i, j;
+ i = (Types.Int32)handler;
tmphandler = handler_NilHandler;
- j = (LONGINT)tmphandler;
+ j = (Types.Int32)tmphandler;
b = i != j;
*)
(* changed because voc cannot compara handler and NilHandler -- noch *)
@@ -316,12 +316,12 @@ MODULE ulmEvents;
*)
VAR b : BOOLEAN; (* noch *)
tmphandler : EventHandler;
- (*i,j : LONGINT;*)
+ (*i,j : Types.Int32;*)
BEGIN
- (*i := SYSTEM.VAL(LONGINT, handler);*)
+ (*i := SYSTEM.VAL(Types.Int32, handler);*)
tmphandler := NilHandler;
(*b := tmphandler = handler;*)
- (*j := SYSTEM.VAL(LONGINT, tmphandler);
+ (*j := SYSTEM.VAL(Types.Int32, tmphandler);
b := i # j;*)
b := handler # tmphandler;
(*ASSERT (handler # NilHandler);*)
diff --git a/src/library/ulm/ulmIO.Mod b/src/library/ulm/ulmIO.Mod
index 162aa127..31aedf8a 100644
--- a/src/library/ulm/ulmIO.Mod
+++ b/src/library/ulm/ulmIO.Mod
@@ -1,6 +1,6 @@
MODULE ulmIO;
- IMPORT SYS := ulmSYSTEM, SYSTEM, Platform;
+ IMPORT SYS := ulmSYSTEM, SYSTEM, Platform, Types := ulmTypes;
CONST nl = 0AX;
@@ -11,7 +11,7 @@ MODULE ulmIO;
dec = 1;
hex = 2;
TYPE
- Basetype = SHORTINT; (* oct..hex *)
+ Basetype = Types.Int8; (* oct..hex *)
(* basic IO *)
@@ -22,7 +22,7 @@ MODULE ulmIO;
(* ==================== conversions ================================= *)
- PROCEDURE ConvertNumber(num, len: LONGINT; btyp: Basetype; neg: BOOLEAN;
+ PROCEDURE ConvertNumber(num, len: Types.Int32; btyp: Basetype; neg: BOOLEAN;
VAR str: ARRAY OF CHAR);
(* conversion of a number into a string of characters *)
@@ -36,13 +36,13 @@ MODULE ulmIO;
VAR
(*digits : ARRAY NumberLen+1 OF CHAR;*)
digits : POINTER TO ARRAY OF CHAR;
- base : INTEGER;
- cnt, ix : INTEGER;
- maxlen : LONGINT;
- dig : LONGINT;
- NumberLen : SHORTINT;
+ base : Types.Int32;
+ cnt, ix : Types.Int32;
+ maxlen : Types.Int32;
+ dig : Types.Int32;
+ NumberLen : Types.Int8;
BEGIN
- IF SIZE(LONGINT) = 8 THEN
+ IF SIZE(Types.Int32) = 8 THEN
NumberLen := 21
ELSE
NumberLen := 11 (* default value, corresponds to 32 bit *)
@@ -107,7 +107,7 @@ MODULE ulmIO;
END;
END ConvertNumber;
- PROCEDURE ConvertInteger(num: LONGINT; len: INTEGER; VAR str: ARRAY OF
+ PROCEDURE ConvertInteger(num: Types.Int32; len: Types.Int32; VAR str: ARRAY OF
CHAR);
(* conversion of an integer decimal number to a string *)
BEGIN
@@ -119,8 +119,8 @@ MODULE ulmIO;
(*
PROCEDURE ReadChar(VAR ch: CHAR) : BOOLEAN;
CONST read = 3;
- (*VAR r0, r1: INTEGER;*)
- VAR r0, r1: LONGINT; (* in ulm system INTEGER and LONGINT have the same 4 byte size; -- noch *)
+ (*VAR r0, r1: Types.Int32;*)
+ VAR r0, r1: Types.Int32; (* in ulm system Types.Int32 and Types.Int32 have the same 4 byte size; -- noch *)
BEGIN
RETURN SYS.UNIXCALL(read, r0, r1, 0, SYSTEM.ADR(ch), 1) & (r0 > 0)
END ReadChar;
@@ -128,7 +128,7 @@ MODULE ulmIO;
PROCEDURE ReadChar(VAR ch: CHAR) : BOOLEAN;
(* Read one byte, returning success flag *)
- VAR error: Platform.ErrorCode; readcount: LONGINT;
+ VAR error: Platform.ErrorCode; readcount: Types.Int32;
BEGIN
error := Platform.ReadBuf(Platform.StdIn, ch, readcount);
RETURN readcount > 0
@@ -137,8 +137,8 @@ MODULE ulmIO;
(*
PROCEDURE WriteChar(ch: CHAR) : BOOLEAN;
CONST write = 4;
- (*VAR r0, r1: INTEGER;*)
- VAR r0, r1: LONGINT; (* same here *)
+ (*VAR r0, r1: Types.Int32;*)
+ VAR r0, r1: Types.Int32; (* same here *)
BEGIN
RETURN SYS.UNIXCALL(write, r0, r1, 1, SYSTEM.ADR(ch), 1)
END WriteChar;
@@ -186,7 +186,7 @@ MODULE ulmIO;
END WriteLn;
PROCEDURE WriteString*(s: ARRAY OF CHAR);
- VAR i: INTEGER;
+ VAR i: Types.Int32;
BEGIN
i := 0;
WHILE (i < LEN(s)) & (s[i] # 0X) DO
@@ -201,14 +201,14 @@ MODULE ulmIO;
Done := TRUE;
END InitIO;
- PROCEDURE WriteInt*(arg: LONGINT);
+ PROCEDURE WriteInt*(arg: Types.Int32);
VAR field: ARRAY 23 OF CHAR;
BEGIN (* the field size should be big enough to hold the long number. it was 12 to hold just 32 bit numbers, now it can hold 64 bit numbers; need to be more for 128bit numbers; -- noch *)
ConvertInteger(arg, 1, field);
WriteString(field);
END WriteInt;
- PROCEDURE ReadInt*(VAR arg: LONGINT);
+ PROCEDURE ReadInt*(VAR arg: Types.Int32);
VAR ch: CHAR;
minus: BOOLEAN;
BEGIN
@@ -236,7 +236,7 @@ MODULE ulmIO;
PROCEDURE ReadLine*(VAR string: ARRAY OF CHAR);
VAR
- index: INTEGER;
+ index: Types.Int32;
ch: CHAR;
ok: BOOLEAN;
BEGIN
diff --git a/src/library/ulm/ulmIntOperations.Mod b/src/library/ulm/ulmIntOperations.Mod
index 3f1799aa..739bb5a4 100644
--- a/src/library/ulm/ulmIntOperations.Mod
+++ b/src/library/ulm/ulmIntOperations.Mod
@@ -43,16 +43,16 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
TYPE
CapabilitySet* = Operations.CapabilitySet;
- (* SET of [Operations.add..shift] *)
+ (* Types.Set of [Operations.add..shift] *)
IsLargeEnoughForProc* = PROCEDURE (op: Operations.Operand;
- n: LONGINT): BOOLEAN;
+ n: Types.Int32): BOOLEAN;
UnsignedProc* = PROCEDURE (op: Operations.Operand): BOOLEAN;
IntToOpProc* = PROCEDURE (int32: Types.Int32; VAR op: Operations.Operand);
OpToIntProc* = PROCEDURE (op: Operations.Operand; VAR int32: Types.Int32);
- Log2Proc* = PROCEDURE (op: Operations.Operand): LONGINT;
+ Log2Proc* = PROCEDURE (op: Operations.Operand): Types.Int32;
OddProc* = PROCEDURE (op: Operations.Operand): BOOLEAN;
ShiftProc* = PROCEDURE (op: Operations.Operand;
- n: INTEGER): Operations.Operand;
+ n: Types.Int32): Operations.Operand;
IntOperatorProc* = PROCEDURE(op: Operation;
op1, op2, op3: Operations.Operand;
VAR result: Operations.Operand);
@@ -95,7 +95,7 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
END Capabilities;
- PROCEDURE IsLargeEnoughFor*(op: Operations.Operand; n: LONGINT): BOOLEAN;
+ PROCEDURE IsLargeEnoughFor*(op: Operations.Operand; n: Types.Int32): BOOLEAN;
BEGIN
WITH op: Operand DO
RETURN op.if.isLargeEnoughFor(op, n)
@@ -130,7 +130,7 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
END OpToInt;
- PROCEDURE Log2*(op: Operations.Operand): LONGINT;
+ PROCEDURE Log2*(op: Operations.Operand): Types.Int32;
BEGIN
WITH op: Operand DO
RETURN op.if.log2(op)
@@ -167,7 +167,7 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
END Op;
- PROCEDURE Shift*(op1: Operations.Operand; n: INTEGER): Operations.Operand;
+ PROCEDURE Shift*(op1: Operations.Operand; n: Types.Int32): Operations.Operand;
BEGIN
WITH op1: Operand DO
ASSERT(shift IN op1.caps);
@@ -176,14 +176,14 @@ MODULE ulmIntOperations; (* Frank B.J. Fischer *)
END Shift;
- PROCEDURE Shift2*(VAR op1: Operations.Operand; n: INTEGER);
+ PROCEDURE Shift2*(VAR op1: Operations.Operand; n: Types.Int32);
BEGIN
op1 := Shift(op1, n);
END Shift2;
PROCEDURE Shift3*(VAR result: Operations.Operand; op1: Operations.Operand;
- n : INTEGER);
+ n : Types.Int32);
VAR
tmpresult: Operations.Operand;
BEGIN
diff --git a/src/library/ulm/ulmMC68881.Mod b/src/library/ulm/ulmMC68881.Mod
index 4bcf69a0..fc3986d0 100644
--- a/src/library/ulm/ulmMC68881.Mod
+++ b/src/library/ulm/ulmMC68881.Mod
@@ -5,7 +5,7 @@ MODULE ulmMC68881;
(* library interface to MC68881 instructions *)
- IMPORT SYS := SYSTEM;
+ IMPORT SYS := SYSTEM, Types := ulmTypes;
CONST
available* = FALSE; (* TRUE if MC68881 present *)
@@ -36,130 +36,130 @@ MODULE ulmMC68881;
(* monadic operations *)
- PROCEDURE FACOS*(x: LONGREAL) : LONGREAL;
+ PROCEDURE FACOS*(x: Types.Real64) : Types.Real64;
BEGIN
RETURN ABS(x)
END FACOS;
- PROCEDURE FASIN*(x: LONGREAL) : LONGREAL;
+ PROCEDURE FASIN*(x: Types.Real64) : Types.Real64;
BEGIN
RETURN ABS(x)
END FASIN;
- PROCEDURE FATAN*(x: LONGREAL) : LONGREAL;
+ PROCEDURE FATAN*(x: Types.Real64) : Types.Real64;
BEGIN
RETURN ABS(x)
END FATAN;
- PROCEDURE FATANH*(x: LONGREAL) : LONGREAL;
+ PROCEDURE FATANH*(x: Types.Real64) : Types.Real64;
BEGIN
RETURN ABS(x)
END FATANH;
- PROCEDURE FCOS*(x: LONGREAL) : LONGREAL;
+ PROCEDURE FCOS*(x: Types.Real64) : Types.Real64;
BEGIN
RETURN ABS(x)
END FCOS;
- PROCEDURE FCOSH*(x: LONGREAL) : LONGREAL;
+ PROCEDURE FCOSH*(x: Types.Real64) : Types.Real64;
BEGIN
RETURN ABS(x)
END FCOSH;
- PROCEDURE FETOX*(x: LONGREAL) : LONGREAL;
+ PROCEDURE FETOX*(x: Types.Real64) : Types.Real64;
BEGIN
RETURN ABS(x)
END FETOX;
- PROCEDURE FETOXM1*(x: LONGREAL) : LONGREAL;
+ PROCEDURE FETOXM1*(x: Types.Real64) : Types.Real64;
BEGIN
RETURN ABS(x)
END FETOXM1;
- PROCEDURE FGETEXP*(x: LONGREAL) : LONGREAL;
+ PROCEDURE FGETEXP*(x: Types.Real64) : Types.Real64;
BEGIN
RETURN ABS(x)
END FGETEXP;
- PROCEDURE FGETMAN*(x: LONGREAL) : LONGREAL;
+ PROCEDURE FGETMAN*(x: Types.Real64) : Types.Real64;
BEGIN
RETURN ABS(x)
END FGETMAN;
- PROCEDURE FLOG10*(x: LONGREAL) : LONGREAL;
+ PROCEDURE FLOG10*(x: Types.Real64) : Types.Real64;
BEGIN
RETURN ABS(x)
END FLOG10;
- PROCEDURE FLOG2*(x: LONGREAL) : LONGREAL;
+ PROCEDURE FLOG2*(x: Types.Real64) : Types.Real64;
BEGIN
RETURN ABS(x)
END FLOG2;
- PROCEDURE FLOGN*(x: LONGREAL) : LONGREAL;
+ PROCEDURE FLOGN*(x: Types.Real64) : Types.Real64;
BEGIN
RETURN ABS(x)
END FLOGN;
- PROCEDURE FLOGNP1*(x: LONGREAL) : LONGREAL;
+ PROCEDURE FLOGNP1*(x: Types.Real64) : Types.Real64;
BEGIN
RETURN ABS(x)
END FLOGNP1;
- PROCEDURE FSIN*(x: LONGREAL) : LONGREAL;
+ PROCEDURE FSIN*(x: Types.Real64) : Types.Real64;
BEGIN
RETURN ABS(x)
END FSIN;
- PROCEDURE FSINH*(x: LONGREAL) : LONGREAL;
+ PROCEDURE FSINH*(x: Types.Real64) : Types.Real64;
BEGIN
RETURN ABS(x)
END FSINH;
- PROCEDURE FSQRT*(x: LONGREAL) : LONGREAL;
+ PROCEDURE FSQRT*(x: Types.Real64) : Types.Real64;
BEGIN
RETURN ABS(x)
END FSQRT;
- PROCEDURE FTAN*(x: LONGREAL) : LONGREAL;
+ PROCEDURE FTAN*(x: Types.Real64) : Types.Real64;
BEGIN
RETURN ABS(x)
END FTAN;
- PROCEDURE FTANH*(x: LONGREAL) : LONGREAL;
+ PROCEDURE FTANH*(x: Types.Real64) : Types.Real64;
BEGIN
RETURN ABS(x)
END FTANH;
- PROCEDURE FTENTOX*(x: LONGREAL) : LONGREAL;
+ PROCEDURE FTENTOX*(x: Types.Real64) : Types.Real64;
BEGIN
RETURN ABS(x)
END FTENTOX;
- PROCEDURE FTWOTOX*(x: LONGREAL) : LONGREAL;
+ PROCEDURE FTWOTOX*(x: Types.Real64) : Types.Real64;
BEGIN
RETURN ABS(x)
END FTWOTOX;
- PROCEDURE GetExceptionEnable*(VAR exceptions: SET);
+ PROCEDURE GetExceptionEnable*(VAR exceptions: Types.Set);
BEGIN
exceptions := {};
END GetExceptionEnable;
- PROCEDURE SetExceptionEnable*(exceptions: SET);
+ PROCEDURE SetExceptionEnable*(exceptions: Types.Set);
BEGIN
exceptions := {};
END SetExceptionEnable;
- PROCEDURE GetRoundingMode*(VAR precision, mode: INTEGER);
+ PROCEDURE GetRoundingMode*(VAR precision, mode: Types.Int32);
BEGIN
precision := 1;
mode := 2;
END GetRoundingMode;
- PROCEDURE SetRoundingMode*(precision, mode: INTEGER);
+ PROCEDURE SetRoundingMode*(precision, mode: Types.Int32);
BEGIN
precision := 1;
mode := 2;
@@ -170,12 +170,12 @@ MODULE ulmMC68881;
float must consist of at least floatlen bytes
*)
- PROCEDURE RealToFloat*(real: LONGREAL; VAR float: ARRAY OF SYS.BYTE);
+ PROCEDURE RealToFloat*(real: Types.Real64; VAR float: ARRAY OF SYS.BYTE);
BEGIN
(*SYS.WMOVE(SYS.ADR(real), SYS.ADR(float), floatlen DIV 4);*)
END RealToFloat;
- PROCEDURE FloatToReal*(float: ARRAY OF SYS.BYTE; VAR real: LONGREAL);
+ PROCEDURE FloatToReal*(float: ARRAY OF SYS.BYTE; VAR real: Types.Real64);
BEGIN
(*SYS.WMOVE(SYS.ADR(float), SYS.ADR(real), floatlen DIV 4);*)
END FloatToReal;
diff --git a/src/library/ulm/ulmNetIO.Mod b/src/library/ulm/ulmNetIO.Mod
index b9741f30..3db6887b 100644
--- a/src/library/ulm/ulmNetIO.Mod
+++ b/src/library/ulm/ulmNetIO.Mod
@@ -64,17 +64,17 @@ MODULE ulmNetIO;
ReadBooleanProc* =
PROCEDURE (s: Streams.Stream; VAR boolean: BOOLEAN) : BOOLEAN;
ReadShortIntProc* =
- PROCEDURE (s: Streams.Stream; VAR shortint: SHORTINT) : BOOLEAN;
+ PROCEDURE (s: Streams.Stream; VAR shortint: Types.Int8) : BOOLEAN;
ReadIntegerProc* =
- PROCEDURE (s: Streams.Stream; VAR integer: INTEGER) : BOOLEAN;
+ PROCEDURE (s: Streams.Stream; VAR integer: Types.Int32) : BOOLEAN;
ReadLongIntProc* =
- PROCEDURE (s: Streams.Stream; VAR longint: LONGINT) : BOOLEAN;
+ PROCEDURE (s: Streams.Stream; VAR longint: Types.Int32) : BOOLEAN;
ReadRealProc* =
- PROCEDURE (s: Streams.Stream; VAR real: REAL) : BOOLEAN;
+ PROCEDURE (s: Streams.Stream; VAR real: Types.Real32) : BOOLEAN;
ReadLongRealProc* =
- PROCEDURE (s: Streams.Stream; VAR longreal: LONGREAL) : BOOLEAN;
+ PROCEDURE (s: Streams.Stream; VAR longreal: Types.Real64) : BOOLEAN;
ReadSetProc* =
- PROCEDURE (s: Streams.Stream; VAR set: SET) : BOOLEAN;
+ PROCEDURE (s: Streams.Stream; VAR set: Types.Set) : BOOLEAN;
ReadStringProc* =
PROCEDURE (s: Streams.Stream; VAR string: ARRAY OF CHAR) : BOOLEAN;
ReadConstStringProc* =
@@ -88,17 +88,17 @@ MODULE ulmNetIO;
WriteBooleanProc* =
PROCEDURE (s: Streams.Stream; boolean: BOOLEAN) : BOOLEAN;
WriteShortIntProc* =
- PROCEDURE (s: Streams.Stream; shortint: SHORTINT) : BOOLEAN;
+ PROCEDURE (s: Streams.Stream; shortint: Types.Int8) : BOOLEAN;
WriteIntegerProc* =
- PROCEDURE (s: Streams.Stream; integer: INTEGER) : BOOLEAN;
+ PROCEDURE (s: Streams.Stream; integer: Types.Int32) : BOOLEAN;
WriteLongIntProc* =
- PROCEDURE (s: Streams.Stream; longint: LONGINT) : BOOLEAN;
+ PROCEDURE (s: Streams.Stream; longint: Types.Int32) : BOOLEAN;
WriteRealProc* =
- PROCEDURE (s: Streams.Stream; real: REAL) : BOOLEAN;
+ PROCEDURE (s: Streams.Stream; real: Types.Real32) : BOOLEAN;
WriteLongRealProc* =
- PROCEDURE (s: Streams.Stream; longreal: LONGREAL) : BOOLEAN;
+ PROCEDURE (s: Streams.Stream; longreal: Types.Real64) : BOOLEAN;
WriteSetProc* =
- PROCEDURE (s: Streams.Stream; set: SET) : BOOLEAN;
+ PROCEDURE (s: Streams.Stream; set: Types.Set) : BOOLEAN;
WriteStringProc* =
PROCEDURE (s: Streams.Stream; string: ARRAY OF CHAR) : BOOLEAN;
WriteConstStringProc* =
@@ -154,7 +154,7 @@ MODULE ulmNetIO;
PROCEDURE Swap (VAR a : ARRAY OF SYS.BYTE);
VAR
- i,j : LONGINT;
+ i,j : Types.Int32;
tmp : SYS.BYTE;
BEGIN
i := 0; j := LEN (a) - 1;
@@ -166,8 +166,8 @@ MODULE ulmNetIO;
PROCEDURE BitSwap (VAR a : ARRAY OF SYS.BYTE);
VAR
- i,old, bit : LONGINT;
- new : LONGINT;
+ i,old, bit : Types.Int32;
+ new : Types.Int32;
BEGIN
i := 0;
@@ -266,7 +266,7 @@ MODULE ulmNetIO;
END;
END ReadBoolean;
- PROCEDURE ReadShortInt*(s: Streams.Stream; VAR shortint: SHORTINT) : BOOLEAN;
+ PROCEDURE ReadShortInt*(s: Streams.Stream; VAR shortint: Types.Int8) : BOOLEAN;
VAR
disc: Discipline;
BEGIN
@@ -277,7 +277,7 @@ MODULE ulmNetIO;
END;
END ReadShortInt;
- PROCEDURE ReadInteger*(s: Streams.Stream; VAR integer: INTEGER) : BOOLEAN;
+ PROCEDURE ReadInteger*(s: Streams.Stream; VAR integer: Types.Int32) : BOOLEAN;
VAR
disc: Discipline;
ret : BOOLEAN;
@@ -293,7 +293,7 @@ MODULE ulmNetIO;
END;
END ReadInteger;
- PROCEDURE ReadLongInt*(s: Streams.Stream; VAR longint: LONGINT) : BOOLEAN;
+ PROCEDURE ReadLongInt*(s: Streams.Stream; VAR longint: Types.Int32) : BOOLEAN;
VAR
disc: Discipline;
ret : BOOLEAN;
@@ -309,7 +309,7 @@ MODULE ulmNetIO;
END;
END ReadLongInt;
- PROCEDURE ReadReal*(s: Streams.Stream; VAR real: REAL) : BOOLEAN;
+ PROCEDURE ReadReal*(s: Streams.Stream; VAR real: Types.Real32) : BOOLEAN;
VAR
disc: Discipline;
BEGIN
@@ -320,7 +320,7 @@ MODULE ulmNetIO;
END;
END ReadReal;
- PROCEDURE ReadLongReal*(s: Streams.Stream; VAR longreal: LONGREAL) : BOOLEAN;
+ PROCEDURE ReadLongReal*(s: Streams.Stream; VAR longreal: Types.Real64) : BOOLEAN;
VAR
disc: Discipline;
BEGIN
@@ -331,7 +331,7 @@ MODULE ulmNetIO;
END;
END ReadLongReal;
- PROCEDURE ReadSet*(s: Streams.Stream; VAR set: SET) : BOOLEAN;
+ PROCEDURE ReadSet*(s: Streams.Stream; VAR set: Types.Set) : BOOLEAN;
VAR
disc: Discipline;
ret : BOOLEAN;
@@ -350,7 +350,7 @@ MODULE ulmNetIO;
PROCEDURE ReadString*(s: Streams.Stream; VAR string: ARRAY OF CHAR) : BOOLEAN;
VAR
disc: Discipline;
- ch: CHAR; index: LONGINT;
+ ch: CHAR; index: Types.Int32;
BEGIN
IF Seek(s, discID, disc) THEN
RETURN disc.if.readString(s, string)
@@ -372,7 +372,7 @@ MODULE ulmNetIO;
CONST
bufsize = 512;
VAR
- length: LONGINT;
+ length: Types.Int32;
buf: Streams.Stream;
ch: CHAR;
disc: Discipline;
@@ -442,7 +442,7 @@ MODULE ulmNetIO;
END;
END WriteBoolean;
- PROCEDURE WriteShortInt*(s: Streams.Stream; shortint: SHORTINT) : BOOLEAN;
+ PROCEDURE WriteShortInt*(s: Streams.Stream; shortint: Types.Int8) : BOOLEAN;
VAR
disc: Discipline;
BEGIN
@@ -453,7 +453,7 @@ MODULE ulmNetIO;
END;
END WriteShortInt;
- PROCEDURE WriteInteger*(s: Streams.Stream; integer: INTEGER) : BOOLEAN;
+ PROCEDURE WriteInteger*(s: Streams.Stream; integer: Types.Int32) : BOOLEAN;
VAR
disc: Discipline;
BEGIN
@@ -467,7 +467,7 @@ MODULE ulmNetIO;
END;
END WriteInteger;
- PROCEDURE WriteLongInt*(s: Streams.Stream; longint: LONGINT) : BOOLEAN;
+ PROCEDURE WriteLongInt*(s: Streams.Stream; longint: Types.Int32) : BOOLEAN;
VAR
disc: Discipline;
BEGIN
@@ -481,7 +481,7 @@ MODULE ulmNetIO;
END;
END WriteLongInt;
- PROCEDURE WriteReal*(s: Streams.Stream; real: REAL) : BOOLEAN;
+ PROCEDURE WriteReal*(s: Streams.Stream; real: Types.Real32) : BOOLEAN;
VAR
disc: Discipline;
BEGIN
@@ -492,7 +492,7 @@ MODULE ulmNetIO;
END;
END WriteReal;
- PROCEDURE WriteLongReal*(s: Streams.Stream; longreal: LONGREAL) : BOOLEAN;
+ PROCEDURE WriteLongReal*(s: Streams.Stream; longreal: Types.Real64) : BOOLEAN;
VAR
disc: Discipline;
BEGIN
@@ -503,7 +503,7 @@ MODULE ulmNetIO;
END;
END WriteLongReal;
- PROCEDURE WriteSet*(s: Streams.Stream; set: SET) : BOOLEAN;
+ PROCEDURE WriteSet*(s: Streams.Stream; set: Types.Set) : BOOLEAN;
VAR
disc: Discipline;
BEGIN
diff --git a/src/library/ulm/ulmOperations.Mod b/src/library/ulm/ulmOperations.Mod
index 617b9808..317b42d8 100644
--- a/src/library/ulm/ulmOperations.Mod
+++ b/src/library/ulm/ulmOperations.Mod
@@ -44,22 +44,22 @@ MODULE ulmOperations;
(* generic support of arithmetic operations *)
- IMPORT Events := ulmEvents, Objects := ulmObjects, PersistentDisciplines := ulmPersistentDisciplines, PersistentObjects := ulmPersistentObjects, Services := ulmServices;
+ IMPORT Events := ulmEvents, Objects := ulmObjects, PersistentDisciplines := ulmPersistentDisciplines, PersistentObjects := ulmPersistentObjects, Services := ulmServices, Types := ulmTypes;
CONST
add* = 0; sub* = 1; mul* = 2; div* = 3; cmp* = 4;
TYPE
- Operation* = SHORTINT; (* add..cmp *)
+ Operation* = Types.Int8; (* add..cmp *)
Operand* = POINTER TO OperandRec;
TYPE
- CapabilitySet* = SET; (* SET OF [add..cmp] *)
+ CapabilitySet* = Types.Set; (* Types.Set OF [add..cmp] *)
CreateProc* = PROCEDURE (VAR op: Operand);
(* should call Operations.Init for op *)
OperatorProc* = PROCEDURE (op: Operation; op1, op2: Operand;
VAR result: Operand);
AssignProc* = PROCEDURE (VAR target: Operand; source: Operand);
- CompareProc* = PROCEDURE (op1, op2: Operand) : INTEGER;
+ CompareProc* = PROCEDURE (op1, op2: Operand) : Types.Int32;
Interface* = POINTER TO InterfaceRec;
InterfaceRec* =
RECORD
@@ -194,7 +194,7 @@ MODULE ulmOperations;
Op(div, op1, op2, result);
END Div3;
- PROCEDURE Compare*(op1, op2: Operand) : INTEGER;
+ PROCEDURE Compare*(op1, op2: Operand) : Types.Int32;
BEGIN
ASSERT(op1.if = op2.if);
ASSERT(cmp IN op1.caps);
diff --git a/src/library/ulm/ulmPersistentObjects.Mod b/src/library/ulm/ulmPersistentObjects.Mod
index c64b4fc0..b34b3645 100644
--- a/src/library/ulm/ulmPersistentObjects.Mod
+++ b/src/library/ulm/ulmPersistentObjects.Mod
@@ -72,7 +72,7 @@ MODULE ulmPersistentObjects;
IMPORT ASCII := ulmASCII, ConstStrings := ulmConstStrings, Disciplines := ulmDisciplines, Errors := ulmErrors, Events := ulmEvents, Forwarders := ulmForwarders,
IndirectDisciplines := ulmIndirectDisciplines, Loader := ulmLoader, NetIO := ulmNetIO, Objects := ulmObjects, Priorities := ulmPriorities,
- RelatedEvents := ulmRelatedEvents, Services := ulmServices, StreamDisciplines := ulmStreamDisciplines, Streams := ulmStreams, Strings := ulmStrings, Texts := ulmTexts, SYS := SYSTEM;
+ RelatedEvents := ulmRelatedEvents, Services := ulmServices, StreamDisciplines := ulmStreamDisciplines, Streams := ulmStreams, Strings := ulmStrings, Texts := ulmTexts, SYS := SYSTEM, Types := ulmTypes;
CONST
maxNameLen = 128; (* max length of data type names *)
@@ -123,8 +123,8 @@ MODULE ulmPersistentObjects;
maxF = 13; (* maximal valid form code *)
TYPE
- Mode* = SHORTINT;
- Form = SHORTINT;
+ Mode* = Types.Int8;
+ Form = Types.Int8;
Object* = POINTER TO ObjectRec;
Type = POINTER TO TypeRec;
@@ -160,7 +160,7 @@ MODULE ulmPersistentObjects;
TypeEntry = POINTER TO TypeEntryRec;
TypeEntryRec =
RECORD
- code: LONGINT;
+ code: Types.Int32;
type: Type;
next: TypeEntry;
END;
@@ -185,7 +185,7 @@ MODULE ulmPersistentObjects;
baseType: Type; (* the next non-abstract base type *)
if: Interface; (* may be = NIL for abstract types *)
ifs: InterfaceList; (* list of interfaces in reverse order *)
- code: LONGINT; (* unique number *)
+ code: Types.Int32; (* unique number *)
END;
(* this list is used for storing the base type list of an object during
@@ -201,7 +201,7 @@ MODULE ulmPersistentObjects;
(* each error causes an event; the error number is stored in
event.errorcode; the associated text can be taken from event.message
*)
- ErrorCode = SHORTINT;
+ ErrorCode = Types.Int8;
Event = POINTER TO EventRec;
EventRec* =
RECORD
@@ -230,7 +230,7 @@ MODULE ulmPersistentObjects;
VAR
id: Disciplines.Identifier;
- nextTypeCode: LONGINT; (* for the generation of unique numbers *)
+ nextTypeCode: Types.Int32; (* for the generation of unique numbers *)
potype: Services.Type;
errormsg*: ARRAY errorcodes OF Events.Message;
@@ -298,7 +298,7 @@ MODULE ulmPersistentObjects;
PROCEDURE WriteLn(s: Streams.Stream) : BOOLEAN;
VAR
lineterm: StreamDisciplines.LineTerminator;
- width: INTEGER;
+ width: Types.Int32;
BEGIN
StreamDisciplines.GetLineTerm(s, lineterm);
IF ~WriteString(s, lineterm) THEN RETURN FALSE END;
@@ -383,7 +383,7 @@ MODULE ulmPersistentObjects;
(* encoding scheme:
Object = Form Type Size ObjectInfo .
- Form = SHORTINT;
+ Form = Types.Int8;
Type = Code (* codeF *) |
Code TypeName (* incrF *) |
TypeName (* nameF *) |
@@ -397,8 +397,8 @@ MODULE ulmPersistentObjects;
PROCEDURE DecodeForm(form: Form;
VAR nameGiven, codeGiven, hier, size: BOOLEAN);
VAR
- typeform: SHORTINT;
- sizeform: SHORTINT;
+ typeform: Types.Int8;
+ sizeform: Types.Int8;
BEGIN
typeform := form MOD maskF; sizeform := form DIV maskF;
nameGiven := typeform IN {incrF, nameF, hierF, incrhierF};
@@ -410,7 +410,7 @@ MODULE ulmPersistentObjects;
PROCEDURE GetModule(name: ARRAY OF CHAR; VAR module: ARRAY OF CHAR);
(* get the name of the module where 'name' was defined *)
VAR
- index: INTEGER;
+ index: Types.Int32;
BEGIN
index := 0;
WHILE (name[index] # ".") & (name[index] # 0X) &
@@ -471,7 +471,7 @@ MODULE ulmPersistentObjects;
PROCEDURE ReadType(s: Streams.Stream; VAR type: Type;
VAR sentinelFound, unknownTypeFound: BOOLEAN) : BOOLEAN;
VAR
- code: LONGINT;
+ code: Types.Int32;
entry: TypeEntry;
typeName: TypeName;
btype: Type;
@@ -755,7 +755,7 @@ MODULE ulmPersistentObjects;
baseType: Services.Type;
member: InterfaceList;
bt: Type;
- ifval: INTEGER;
+ ifval: Types.Int32;
BEGIN
(* check the parameters *)
ASSERT(name[0] # 0X);
diff --git a/src/library/ulm/ulmPlotters.Mod b/src/library/ulm/ulmPlotters.Mod
index 59ee292d..58d1fda6 100644
--- a/src/library/ulm/ulmPlotters.Mod
+++ b/src/library/ulm/ulmPlotters.Mod
@@ -28,7 +28,7 @@
MODULE ulmPlotters;
- IMPORT Events := ulmEvents, Objects := ulmObjects, Resources := ulmResources, Services := ulmServices, SYS := ulmSYSTEM;
+ IMPORT Events := ulmEvents, Objects := ulmObjects, Resources := ulmResources, Services := ulmServices, SYS := ulmSYSTEM, Types := ulmTypes;
TYPE
Plotter* = POINTER TO PlotterRec;
@@ -41,7 +41,7 @@ MODULE ulmPlotters;
longdashed* = 4;
lineModes* = 5;
TYPE
- LineMode* = SHORTINT; (* solid ... *)
+ LineMode* = Types.Int8; (* solid ... *)
CONST
setspace* = 0;
@@ -50,34 +50,34 @@ MODULE ulmPlotters;
linemodes* = 3;
linewidth* = 4;
TYPE
- CapabilitySet* = SET; (* OF setspace, erase ... *)
+ CapabilitySet* = Types.Set; (* OF setspace, erase ... *)
TYPE
Description* = POINTER TO DescriptionRec;
DescriptionRec* =
RECORD
(Objects.ObjectRec)
- xmin*, ymin, xmax, ymax: INTEGER; (* maximal supported range *)
+ xmin*, ymin, xmax, ymax: Types.Int32; (* maximal supported range *)
END;
TYPE
GetSpaceProc* = PROCEDURE (
plotter: Plotter;
- VAR xmin, ymin, xmax, ymax: INTEGER);
+ VAR xmin, ymin, xmax, ymax: Types.Int32);
SetSpaceProc* = PROCEDURE (
plotter: Plotter;
- xmin, ymin, xmax, ymax: INTEGER);
+ xmin, ymin, xmax, ymax: Types.Int32);
EraseProc* = PROCEDURE (plotter: Plotter);
- MoveProc* = PROCEDURE (plotter: Plotter; xto, yto: INTEGER);
- LineProc* = PROCEDURE (plotter: Plotter; xfrom, yfrom, xto, yto: INTEGER);
+ MoveProc* = PROCEDURE (plotter: Plotter; xto, yto: Types.Int32);
+ LineProc* = PROCEDURE (plotter: Plotter; xfrom, yfrom, xto, yto: Types.Int32);
ArcProc* = PROCEDURE (
plotter: Plotter;
- xcenter, ycenter, xstart, ystart, xend, yend: INTEGER);
+ xcenter, ycenter, xstart, ystart, xend, yend: Types.Int32);
CircleProc* = PROCEDURE (
- plotter: Plotter; xcenter, ycenter, radius: INTEGER);
+ plotter: Plotter; xcenter, ycenter, radius: Types.Int32);
StringProc* = PROCEDURE (plotter: Plotter; str: ARRAY OF CHAR);
SetLineModeProc* = PROCEDURE (plotter: Plotter; mode: LineMode);
- SetLineWidthProc* = PROCEDURE (plotter: Plotter; width: INTEGER);
+ SetLineWidthProc* = PROCEDURE (plotter: Plotter; width: Types.Int32);
CloseProc* = PROCEDURE (plotter: Plotter);
TYPE
Interface* = POINTER TO InterfaceRec;
@@ -105,7 +105,7 @@ MODULE ulmPlotters;
if: Interface;
caps: CapabilitySet;
desc: Description;
- xmin, ymin, xmax, ymax: INTEGER; (* current range *)
+ xmin, ymin, xmax, ymax: Types.Int32; (* current range *)
terminated: BOOLEAN;
END;
VAR
@@ -162,7 +162,7 @@ MODULE ulmPlotters;
PROCEDURE GetSpace*(plotter: Plotter;
VAR xmin, ymin,
- xmax, ymax: INTEGER);
+ xmax, ymax: Types.Int32);
BEGIN
xmin := plotter.xmin;
xmax := plotter.xmax;
@@ -172,7 +172,7 @@ MODULE ulmPlotters;
PROCEDURE GetMaxSpace*(plotter: Plotter;
VAR xmin, ymin,
- xmax, ymax: INTEGER);
+ xmax, ymax: Types.Int32);
BEGIN
xmin := plotter.desc.xmin;
xmax := plotter.desc.xmax;
@@ -182,7 +182,7 @@ MODULE ulmPlotters;
PROCEDURE SetSpace*(plotter: Plotter;
xmin, ymin,
- xmax, ymax: INTEGER);
+ xmax, ymax: Types.Int32);
BEGIN
ASSERT((xmin < xmax) & (ymin < ymax));
ASSERT((xmin >= plotter.desc.xmin) &
@@ -203,33 +203,33 @@ MODULE ulmPlotters;
plotter.if.erase(plotter);
END Erase;
- PROCEDURE Move*(plotter: Plotter; xto, yto: INTEGER);
+ PROCEDURE Move*(plotter: Plotter; xto, yto: Types.Int32);
BEGIN
plotter.if.move(plotter, xto, yto);
END Move;
- PROCEDURE Cont*(plotter: Plotter; xto, yto: INTEGER);
+ PROCEDURE Cont*(plotter: Plotter; xto, yto: Types.Int32);
BEGIN
plotter.if.cont(plotter, xto, yto);
END Cont;
- PROCEDURE Point*(plotter: Plotter; xpoint, ypoint: INTEGER);
+ PROCEDURE Point*(plotter: Plotter; xpoint, ypoint: Types.Int32);
BEGIN
plotter.if.point(plotter, xpoint, ypoint);
END Point;
- PROCEDURE Line*(plotter: Plotter; xfrom, yfrom, xto, yto: INTEGER);
+ PROCEDURE Line*(plotter: Plotter; xfrom, yfrom, xto, yto: Types.Int32);
BEGIN
plotter.if.line(plotter, xfrom, yfrom, xto, yto);
END Line;
PROCEDURE Arc*(plotter: Plotter;
- xcenter, ycenter, xstart, ystart, xend, yend: INTEGER);
+ xcenter, ycenter, xstart, ystart, xend, yend: Types.Int32);
BEGIN
plotter.if.arc(plotter, xcenter, ycenter, xstart, ystart, xend, yend);
END Arc;
- PROCEDURE Circle*(plotter: Plotter; xcenter, ycenter, radius: INTEGER);
+ PROCEDURE Circle*(plotter: Plotter; xcenter, ycenter, radius: Types.Int32);
BEGIN
plotter.if.circle(plotter, xcenter, ycenter, radius);
END Circle;
@@ -246,7 +246,7 @@ MODULE ulmPlotters;
plotter.if.setLineMode(plotter, mode);
END SetLineMode;
- PROCEDURE SetLineWidth*(plotter: Plotter; width: INTEGER);
+ PROCEDURE SetLineWidth*(plotter: Plotter; width: Types.Int32);
BEGIN
ASSERT((linewidth IN plotter.caps) & (width > 0));
plotter.if.setLineWidth(plotter, width);
diff --git a/src/library/ulm/ulmPrint.Mod b/src/library/ulm/ulmPrint.Mod
index 756a3813..a2fb35e0 100644
--- a/src/library/ulm/ulmPrint.Mod
+++ b/src/library/ulm/ulmPrint.Mod
@@ -44,7 +44,7 @@ MODULE ulmPrint;
*)
IMPORT Events := ulmEvents, IEEE := ulmIEEE, Priorities := ulmPriorities, Reals := ulmReals, RelatedEvents := ulmRelatedEvents, StreamDisciplines := ulmStreamDisciplines,
- Streams := ulmStreams, SYS := SYSTEM;
+ Streams := ulmStreams, SYS := SYSTEM, Types := ulmTypes;
CONST
tooManyArgs* = 0; (* too many arguments given *)
@@ -54,16 +54,16 @@ MODULE ulmPrint;
errors* = 4;
TYPE
FormatString* = ARRAY 128 OF CHAR;
- ErrorCode* = SHORTINT;
+ ErrorCode* = Types.Int8;
ErrorEvent* = POINTER TO ErrorEventRec;
ErrorEventRec* =
- RECORD
- (Events.EventRec)
- errorcode*: ErrorCode;
- format*: FormatString;
- errpos*: LONGINT;
- nargs*: INTEGER;
- END;
+ RECORD
+ (Events.EventRec)
+ errorcode*: ErrorCode;
+ format*: FormatString;
+ errpos*: Types.Int32;
+ nargs*: Types.Int32;
+ END;
VAR
error*: Events.EventType;
errormsg*: ARRAY errors OF Events.Message;
@@ -77,887 +77,887 @@ MODULE ulmPrint;
errormsg[tooFewArgs] := "too few arguments given";
errormsg[badFormat] := "syntax error in format string";
errormsg[badArgumentSize] :=
- "size of argument doesn't conform to the corresponding format element";
+ "size of argument doesn't conform to the corresponding format element";
END InitErrorHandling;
- PROCEDURE Out(out: Streams.Stream; VAR fmt: ARRAY OF CHAR; nargs: INTEGER;
- VAR p1,p2,p3,p4,p5,p6,p7,p8,p9: ARRAY OF SYS.BYTE;
- errors: RelatedEvents.Object);
+ PROCEDURE Out(out: Streams.Stream; VAR fmt: ARRAY OF CHAR; nargs: Types.Int32;
+ VAR p1,p2,p3,p4,p5,p6,p7,p8,p9: ARRAY OF SYS.BYTE;
+ errors: RelatedEvents.Object);
CONST
- maxargs = 9; (* maximal number of arguments *)
- maxargsize = SIZE(LONGREAL); (* maximal arg size (except strings) *)
- fmtcmd = "%";
- escape = "\";
+ maxargs = 9; (* maximal number of arguments *)
+ maxargsize = SIZE(Types.Real64); (* maximal arg size (except strings) *)
+ fmtcmd = "%";
+ escape = "\";
VAR
- arglen: ARRAY maxargs OF LONGINT;
- nextarg: INTEGER;
- fmtindex: LONGINT;
- fmtchar: CHAR;
- hexcharval: LONGINT;
+ arglen: ARRAY maxargs OF Types.Int32;
+ nextarg: Types.Int32;
+ fmtindex: Types.Int32;
+ fmtchar: CHAR;
+ hexcharval: Types.Int32;
PROCEDURE Error(errorcode: ErrorCode);
- VAR
- event: ErrorEvent;
+ VAR
+ event: ErrorEvent;
BEGIN
- NEW(event);
- event.type := error;
- event.message := errormsg[errorcode];
- event.errorcode := errorcode;
- COPY(fmt, event.format);
- event.errpos := fmtindex;
- event.nargs := nargs;
- RelatedEvents.Raise(errors, event);
+ NEW(event);
+ event.type := error;
+ event.message := errormsg[errorcode];
+ event.errorcode := errorcode;
+ COPY(fmt, event.format);
+ event.errpos := fmtindex;
+ event.nargs := nargs;
+ RelatedEvents.Raise(errors, event);
END Error;
PROCEDURE Next() : BOOLEAN;
BEGIN
- IF fmtindex < LEN(fmt) THEN
- fmtchar := fmt[fmtindex]; INC(fmtindex);
- IF fmtchar = 0X THEN
- fmtindex := LEN(fmt);
- RETURN FALSE
- ELSE
- RETURN TRUE
- END;
- ELSE
- RETURN FALSE
- END;
+ IF fmtindex < LEN(fmt) THEN
+ fmtchar := fmt[fmtindex]; INC(fmtindex);
+ IF fmtchar = 0X THEN
+ fmtindex := LEN(fmt);
+ RETURN FALSE
+ ELSE
+ RETURN TRUE
+ END;
+ ELSE
+ RETURN FALSE
+ END;
END Next;
PROCEDURE Unget;
BEGIN
- IF (fmtindex > 0) & (fmtindex < LEN(fmt)) THEN
- DEC(fmtindex); fmtchar := fmt[fmtindex];
- ELSE
- fmtchar := 0X;
- END;
+ IF (fmtindex > 0) & (fmtindex < LEN(fmt)) THEN
+ DEC(fmtindex); fmtchar := fmt[fmtindex];
+ ELSE
+ fmtchar := 0X;
+ END;
END Unget;
PROCEDURE Write(byte: SYS.BYTE);
BEGIN
- IF Streams.WriteByte(out, byte) THEN
- INC(out.count);
- END;
+ IF Streams.WriteByte(out, byte) THEN
+ INC(out.count);
+ END;
END Write;
PROCEDURE WriteLn;
- VAR
- lineterm: StreamDisciplines.LineTerminator;
- i: INTEGER;
+ VAR
+ lineterm: StreamDisciplines.LineTerminator;
+ i: Types.Int32;
BEGIN
- StreamDisciplines.GetLineTerm(out, lineterm);
- Write(lineterm[0]);
- i := 1;
- WHILE (i < LEN(lineterm)) & (lineterm[i] # 0X) DO
- Write(lineterm[i]); INC(i);
- END;
+ StreamDisciplines.GetLineTerm(out, lineterm);
+ Write(lineterm[0]);
+ i := 1;
+ WHILE (i < LEN(lineterm)) & (lineterm[i] # 0X) DO
+ Write(lineterm[i]); INC(i);
+ END;
END WriteLn;
- PROCEDURE Int(VAR int: LONGINT; base: INTEGER) : BOOLEAN;
+ PROCEDURE Int(VAR int: Types.Int32; base: Types.Int32) : BOOLEAN;
- PROCEDURE ValidDigit(ch: CHAR) : BOOLEAN;
- BEGIN
- RETURN (ch >= "0") & (ch <= "9") OR
- (base = 16) & (CAP(ch) >= "A") & (CAP(ch) <= "F")
- END ValidDigit;
+ PROCEDURE ValidDigit(ch: CHAR) : BOOLEAN;
+ BEGIN
+ RETURN (ch >= "0") & (ch <= "9") OR
+ (base = 16) & (CAP(ch) >= "A") & (CAP(ch) <= "F")
+ END ValidDigit;
BEGIN
- int := 0;
- REPEAT
- int := int * base;
- IF (fmtchar >= "0") & (fmtchar <= "9") THEN
- INC(int, LONG(ORD(fmtchar) - ORD("0")));
- ELSIF (base = 16) &
- (CAP(fmtchar) >= "A") & (CAP(fmtchar) <= "F") THEN
- INC(int, LONG(10 + ORD(CAP(fmtchar)) - ORD("A")));
- ELSE
- RETURN FALSE
- END;
- UNTIL ~Next() OR ~ValidDigit(fmtchar);
- RETURN TRUE
+ int := 0;
+ REPEAT
+ int := int * base;
+ IF (fmtchar >= "0") & (fmtchar <= "9") THEN
+ INC(int, ORD(fmtchar) - ORD("0"));
+ ELSIF (base = 16) &
+ (CAP(fmtchar) >= "A") & (CAP(fmtchar) <= "F") THEN
+ INC(int, 10 + ORD(CAP(fmtchar)) - ORD("A"));
+ ELSE
+ RETURN FALSE
+ END;
+ UNTIL ~Next() OR ~ValidDigit(fmtchar);
+ RETURN TRUE
END Int;
PROCEDURE SetSize;
- VAR
- index: INTEGER;
+ VAR
+ index: Types.Int32;
BEGIN
- index := 0;
- WHILE index < nargs DO
- CASE index OF
- | 0: arglen[index] := LEN(p1);
- | 1: arglen[index] := LEN(p2);
- | 2: arglen[index] := LEN(p3);
- | 3: arglen[index] := LEN(p4);
- | 4: arglen[index] := LEN(p5);
- | 5: arglen[index] := LEN(p6);
- | 6: arglen[index] := LEN(p7);
- | 7: arglen[index] := LEN(p8);
- | 8: arglen[index] := LEN(p9);
- ELSE
- END;
- INC(index);
- END;
+ index := 0;
+ WHILE index < nargs DO
+ CASE index OF
+ | 0: arglen[index] := LEN(p1);
+ | 1: arglen[index] := LEN(p2);
+ | 2: arglen[index] := LEN(p3);
+ | 3: arglen[index] := LEN(p4);
+ | 4: arglen[index] := LEN(p5);
+ | 5: arglen[index] := LEN(p6);
+ | 6: arglen[index] := LEN(p7);
+ | 7: arglen[index] := LEN(p8);
+ | 8: arglen[index] := LEN(p9);
+ ELSE
+ END;
+ INC(index);
+ END;
END SetSize;
- PROCEDURE Access(par: INTEGER; at: LONGINT) : SYS.BYTE;
+ PROCEDURE Access(par: Types.Int32; at: Types.Int32) : SYS.BYTE;
BEGIN
- CASE par OF
- | 0: RETURN p1[at]
- | 1: RETURN p2[at]
- | 2: RETURN p3[at]
- | 3: RETURN p4[at]
- | 4: RETURN p5[at]
- | 5: RETURN p6[at]
- | 6: RETURN p7[at]
- | 7: RETURN p8[at]
- | 8: RETURN p9[at]
- ELSE
- END;
+ CASE par OF
+ | 0: RETURN p1[at]
+ | 1: RETURN p2[at]
+ | 2: RETURN p3[at]
+ | 3: RETURN p4[at]
+ | 4: RETURN p5[at]
+ | 5: RETURN p6[at]
+ | 6: RETURN p7[at]
+ | 7: RETURN p8[at]
+ | 8: RETURN p9[at]
+ ELSE
+ END;
END Access;
- PROCEDURE Convert(from: INTEGER; VAR to: ARRAY OF SYS.BYTE);
- VAR i: INTEGER;
+ PROCEDURE Convert(from: Types.Int32; VAR to: ARRAY OF SYS.BYTE);
+ VAR i: Types.Int32;
BEGIN
- i := 0;
- WHILE i < arglen[from] DO
- to[i] := Access(from, i); INC(i);
- END;
+ i := 0;
+ WHILE i < arglen[from] DO
+ to[i] := Access(from, i); INC(i);
+ END;
END Convert;
- PROCEDURE GetInt(index: INTEGER; VAR long: LONGINT) : BOOLEAN;
- (* access index-th parameter (counted from 0);
- fails if arglen[index] > SIZE(LONGINT)
- *)
- VAR
- short: SHORTINT;
- (*int16: SYS.INT16;*)
- int: INTEGER;
-
+ PROCEDURE GetInt(index: Types.Int32; VAR long: Types.Int32) : BOOLEAN;
+ (* access index-th parameter (counted from 0);
+ fails if arglen[index] > SYS.SIZE(Types.Int32)
+ *)
+ VAR
+ short: Types.Int8;
+ int16: SYS.INT16;
+ int: Types.Int32;
+
BEGIN
- IF arglen[index] = SIZE(SHORTINT) THEN
- Convert(index, short); long := short;
- (*ELSIF arglen[index] = SIZE(SYS.INT16) THEN
- Convert(index, int16); long := int16;*)
- ELSIF arglen[index] = SIZE(INTEGER) THEN
- Convert(index, int); long := int;
- ELSIF arglen[index] = SIZE(LONGINT) THEN
- Convert(index, long);
- ELSE
- Error(badArgumentSize);
- RETURN FALSE
- END;
- RETURN TRUE
+ IF arglen[index] = SIZE(Types.Int8) THEN
+ Convert(index, short); long := short;
+ ELSIF arglen[index] = SIZE(SYS.INT16) THEN
+ Convert(index, int16); long := int16;
+ ELSIF arglen[index] = SIZE(Types.Int32) THEN
+ Convert(index, int); long := int;
+ ELSIF arglen[index] = SIZE(Types.Int32) THEN
+ Convert(index, long);
+ ELSE
+ Error(badArgumentSize);
+ RETURN FALSE
+ END;
+ RETURN TRUE
END GetInt;
PROCEDURE Format() : BOOLEAN;
- VAR
- fillch: CHAR; (* filling character *)
- insert: BOOLEAN; (* insert between sign and 1st digit *)
- sign: BOOLEAN; (* sign even positive values *)
- leftaligned: BOOLEAN; (* output left aligned *)
- width, scale: LONGINT;
+ VAR
+ fillch: CHAR; (* filling character *)
+ insert: BOOLEAN; (* insert between sign and 1st digit *)
+ sign: BOOLEAN; (* sign even positive values *)
+ leftaligned: BOOLEAN; (* output left aligned *)
+ width, scale: Types.Int32;
- PROCEDURE NextArg(VAR index: INTEGER) : BOOLEAN;
- BEGIN
- IF nextarg < nargs THEN
- index := nextarg; INC(nextarg); RETURN TRUE
- ELSE
- RETURN FALSE
- END;
- END NextArg;
+ PROCEDURE NextArg(VAR index: Types.Int32) : BOOLEAN;
+ BEGIN
+ IF nextarg < nargs THEN
+ index := nextarg; INC(nextarg); RETURN TRUE
+ ELSE
+ RETURN FALSE
+ END;
+ END NextArg;
- PROCEDURE Flags() : BOOLEAN;
- BEGIN
- fillch := " "; insert := FALSE; sign := FALSE;
- leftaligned := FALSE;
- REPEAT
- CASE fmtchar OF
- | "+": sign := TRUE;
- | "0": fillch := "0"; insert := TRUE;
- | "-": leftaligned := TRUE;
- | "^": insert := TRUE;
- | "\": IF ~Next() THEN RETURN FALSE END; fillch := fmtchar;
- ELSE
- RETURN TRUE
- END;
- UNTIL ~Next();
- Error(badFormat);
- RETURN FALSE (* unexpected end *)
- END Flags;
+ PROCEDURE Flags() : BOOLEAN;
+ BEGIN
+ fillch := " "; insert := FALSE; sign := FALSE;
+ leftaligned := FALSE;
+ REPEAT
+ CASE fmtchar OF
+ | "+": sign := TRUE;
+ | "0": fillch := "0"; insert := TRUE;
+ | "-": leftaligned := TRUE;
+ | "^": insert := TRUE;
+ | "\": IF ~Next() THEN RETURN FALSE END; fillch := fmtchar;
+ ELSE
+ RETURN TRUE
+ END;
+ UNTIL ~Next();
+ Error(badFormat);
+ RETURN FALSE (* unexpected end *)
+ END Flags;
- PROCEDURE FetchInt(VAR int: LONGINT) : BOOLEAN;
- VAR
- index: INTEGER;
- BEGIN
- RETURN (fmtchar = "*") & Next() &
- NextArg(index) & GetInt(index, int) OR
- Int(int, 10) & (int >= 0)
- END FetchInt;
+ PROCEDURE FetchInt(VAR int: Types.Int32) : BOOLEAN;
+ VAR
+ index: Types.Int32;
+ BEGIN
+ RETURN (fmtchar = "*") & Next() &
+ NextArg(index) & GetInt(index, int) OR
+ Int(int, 10) & (int >= 0)
+ END FetchInt;
- PROCEDURE Width() : BOOLEAN;
- BEGIN
- IF (fmtchar >= "0") & (fmtchar <= "9") OR (fmtchar = "*") THEN
- IF FetchInt(width) THEN
- RETURN TRUE
- END;
- Error(badFormat); RETURN FALSE
- ELSE
- width := 0;
- RETURN TRUE
- END;
- END Width;
+ PROCEDURE Width() : BOOLEAN;
+ BEGIN
+ IF (fmtchar >= "0") & (fmtchar <= "9") OR (fmtchar = "*") THEN
+ IF FetchInt(width) THEN
+ RETURN TRUE
+ END;
+ Error(badFormat); RETURN FALSE
+ ELSE
+ width := 0;
+ RETURN TRUE
+ END;
+ END Width;
- PROCEDURE Scale() : BOOLEAN;
- BEGIN
- IF fmtchar = "." THEN
- IF Next() & FetchInt(scale) THEN
- RETURN TRUE
- ELSE
- Error(badFormat); RETURN FALSE
- END;
- ELSE
- scale := -1; RETURN TRUE
- END;
- END Scale;
+ PROCEDURE Scale() : BOOLEAN;
+ BEGIN
+ IF fmtchar = "." THEN
+ IF Next() & FetchInt(scale) THEN
+ RETURN TRUE
+ ELSE
+ Error(badFormat); RETURN FALSE
+ END;
+ ELSE
+ scale := -1; RETURN TRUE
+ END;
+ END Scale;
- PROCEDURE Conversion() : BOOLEAN;
+ PROCEDURE Conversion() : BOOLEAN;
- PROCEDURE Fill(cnt: LONGINT);
- (* cnt: space used by normal output *)
- VAR i: LONGINT;
- BEGIN
- IF cnt < width THEN
- i := width - cnt;
- WHILE i > 0 DO
- Write(fillch);
- DEC(i);
- END;
- END;
- END Fill;
+ PROCEDURE Fill(cnt: Types.Int32);
+ (* cnt: space used by normal output *)
+ VAR i: Types.Int32;
+ BEGIN
+ IF cnt < width THEN
+ i := width - cnt;
+ WHILE i > 0 DO
+ Write(fillch);
+ DEC(i);
+ END;
+ END;
+ END Fill;
- PROCEDURE FillLeft(cnt: LONGINT);
- BEGIN
- IF ~leftaligned THEN
- Fill(cnt);
- END;
- END FillLeft;
+ PROCEDURE FillLeft(cnt: Types.Int32);
+ BEGIN
+ IF ~leftaligned THEN
+ Fill(cnt);
+ END;
+ END FillLeft;
- PROCEDURE FillRight(cnt: LONGINT);
- BEGIN
- IF leftaligned THEN
- Fill(cnt);
- END;
- END FillRight;
+ PROCEDURE FillRight(cnt: Types.Int32);
+ BEGIN
+ IF leftaligned THEN
+ Fill(cnt);
+ END;
+ END FillRight;
- PROCEDURE WriteBool(true, false: ARRAY OF CHAR) : BOOLEAN;
- VAR index: INTEGER; val: LONGINT;
+ PROCEDURE WriteBool(true, false: ARRAY OF CHAR) : BOOLEAN;
+ VAR index: Types.Int32; val: Types.Int32;
- PROCEDURE WriteString(VAR s: ARRAY OF CHAR);
- VAR i, len: INTEGER;
- BEGIN
- len := 0;
- WHILE (len < LEN(s)) & (s[len] # 0X) DO
- INC(len);
- END;
- FillLeft(len);
- i := 0;
- WHILE i < len DO
- Write(s[i]); INC(i);
- END;
- FillRight(len);
- END WriteString;
+ PROCEDURE WriteString(VAR s: ARRAY OF CHAR);
+ VAR i, len: Types.Int32;
+ BEGIN
+ len := 0;
+ WHILE (len < LEN(s)) & (s[len] # 0X) DO
+ INC(len);
+ END;
+ FillLeft(len);
+ i := 0;
+ WHILE i < len DO
+ Write(s[i]); INC(i);
+ END;
+ FillRight(len);
+ END WriteString;
- BEGIN
- IF NextArg(index) & GetInt(index, val) THEN
- IF val = 0 THEN
- WriteString(false); RETURN TRUE
- ELSIF val = 1 THEN
- WriteString(true); RETURN TRUE
- END;
- END;
- RETURN FALSE
- END WriteBool;
+ BEGIN
+ IF NextArg(index) & GetInt(index, val) THEN
+ IF val = 0 THEN
+ WriteString(false); RETURN TRUE
+ ELSIF val = 1 THEN
+ WriteString(true); RETURN TRUE
+ END;
+ END;
+ RETURN FALSE
+ END WriteBool;
- PROCEDURE WriteChar() : BOOLEAN;
- VAR
- val: LONGINT;
- index: INTEGER;
- BEGIN
- IF NextArg(index) & GetInt(index, val) &
- (val >= 0) & (val <= ORD(MAX(CHAR))) THEN
- FillLeft(1);
- Write(CHR(val));
- FillRight(1);
- RETURN TRUE
- END;
- RETURN FALSE
- END WriteChar;
+ PROCEDURE WriteChar() : BOOLEAN;
+ VAR
+ val: Types.Int32;
+ index: Types.Int32;
+ BEGIN
+ IF NextArg(index) & GetInt(index, val) &
+ (val >= 0) & (val <= ORD(MAX(CHAR))) THEN
+ FillLeft(1);
+ Write(CHR(val));
+ FillRight(1);
+ RETURN TRUE
+ END;
+ RETURN FALSE
+ END WriteChar;
- PROCEDURE WriteInt(base: INTEGER) : BOOLEAN;
- VAR
- index: INTEGER;
- val: LONGINT;
- neg: BOOLEAN; (* set by Convert *)
- buf: ARRAY 12 OF CHAR; (* filled by Convert *)
- i: INTEGER;
- len: INTEGER; (* space needed for val *)
- signcnt: INTEGER; (* =1 if sign printed; else 0 *)
- signch: CHAR;
+ PROCEDURE WriteInt(base: Types.Int32) : BOOLEAN;
+ VAR
+ index: Types.Int32;
+ val: Types.Int32;
+ neg: BOOLEAN; (* set by Convert *)
+ buf: ARRAY 12 OF CHAR; (* filled by Convert *)
+ i: Types.Int32;
+ len: Types.Int32; (* space needed for val *)
+ signcnt: Types.Int32; (* =1 if sign printed; else 0 *)
+ signch: CHAR;
- PROCEDURE Convert;
- VAR
- index: INTEGER;
- digit: LONGINT;
- BEGIN
- neg := val < 0;
- index := 0;
- REPEAT
- digit := val MOD base;
- val := val DIV base;
- IF neg & (digit > 0) THEN
- digit := base - digit;
- INC(val);
- END;
- IF digit < 10 THEN
- buf[index] := CHR(ORD("0") + digit);
- ELSE
- buf[index] := CHR(ORD("A") + digit - 10);
- END;
- INC(index);
- UNTIL val = 0;
- len := index;
- END Convert;
+ PROCEDURE Convert;
+ VAR
+ index: Types.Int32;
+ digit: Types.Int32;
+ BEGIN
+ neg := val < 0;
+ index := 0;
+ REPEAT
+ digit := val MOD base;
+ val := val DIV base;
+ IF neg & (digit > 0) THEN
+ digit := base - digit;
+ INC(val);
+ END;
+ IF digit < 10 THEN
+ buf[index] := CHR(ORD("0") + digit);
+ ELSE
+ buf[index] := CHR(ORD("A") + digit - 10);
+ END;
+ INC(index);
+ UNTIL val = 0;
+ len := index;
+ END Convert;
- BEGIN (* WriteInt *)
- IF NextArg(index) & GetInt(index, val) THEN
- Convert;
- IF sign OR neg THEN
- signcnt := 1;
- IF neg THEN
- signch := "-";
- ELSE
- signch := "+";
- END;
- ELSE
- signcnt := 0;
- END;
- IF insert & (signcnt = 1) THEN
- Write(signch);
- END;
- FillLeft(len+signcnt);
- IF ~insert & (signcnt = 1) THEN
- Write(signch);
- END;
- i := len;
- WHILE i > 0 DO
- DEC(i); Write(buf[i]);
- END;
- FillRight(len+signcnt);
- RETURN TRUE
- END;
- RETURN FALSE
- END WriteInt;
+ BEGIN (* WriteInt *)
+ IF NextArg(index) & GetInt(index, val) THEN
+ Convert;
+ IF sign OR neg THEN
+ signcnt := 1;
+ IF neg THEN
+ signch := "-";
+ ELSE
+ signch := "+";
+ END;
+ ELSE
+ signcnt := 0;
+ END;
+ IF insert & (signcnt = 1) THEN
+ Write(signch);
+ END;
+ FillLeft(len+signcnt);
+ IF ~insert & (signcnt = 1) THEN
+ Write(signch);
+ END;
+ i := len;
+ WHILE i > 0 DO
+ DEC(i); Write(buf[i]);
+ END;
+ FillRight(len+signcnt);
+ RETURN TRUE
+ END;
+ RETURN FALSE
+ END WriteInt;
- PROCEDURE WriteReal(format: CHAR) : BOOLEAN;
- (* format either "f", "e", or "g" *)
- CONST
- defaultscale = 6;
- VAR
- index: INTEGER;
- lr: LONGREAL;
- r: REAL;
- shortint: SHORTINT; int: INTEGER; longint: LONGINT;
- (*int16: SYS.INT16;*)
- long: BOOLEAN;
- exponent: INTEGER;
- mantissa: LONGREAL;
- digits: ARRAY Reals.maxlongdignum OF CHAR;
- neg: BOOLEAN;
- ndigits: INTEGER;
- decpt: INTEGER;
+ PROCEDURE WriteReal(format: CHAR) : BOOLEAN;
+ (* format either "f", "e", or "g" *)
+ CONST
+ defaultscale = 6;
+ VAR
+ index: Types.Int32;
+ lr: Types.Real64;
+ r: Types.Real32;
+ shortint: Types.Int8; int: Types.Int32; longint: Types.Int32;
+ int16: SYS.INT16;
+ long: BOOLEAN;
+ exponent: Types.Int32;
+ mantissa: Types.Real64;
+ digits: ARRAY Reals.maxlongdignum OF CHAR;
+ neg: BOOLEAN;
+ ndigits: Types.Int32;
+ decpt: Types.Int32;
- PROCEDURE Print(decpt: INTEGER; withexp: BOOLEAN; exp: INTEGER);
- (* decpt: position of decimal point
- = 0: just before the digits
- > 0: after decpt digits
- < 0: ABS(decpt) zeroes before digits needed
- *)
- VAR
- needed: INTEGER; (* space needed *)
- index: INTEGER;
- count: LONGINT;
+ PROCEDURE Print(decpt: Types.Int32; withexp: BOOLEAN; exp: Types.Int32);
+ (* decpt: position of decimal point
+ = 0: just before the digits
+ > 0: after decpt digits
+ < 0: ABS(decpt) zeroes before digits needed
+ *)
+ VAR
+ needed: Types.Int32; (* space needed *)
+ index: Types.Int32;
+ count: Types.Int32;
- PROCEDURE WriteExp(exp: INTEGER);
- CONST
- base = 10;
- VAR
- power: INTEGER;
- digit: INTEGER;
- BEGIN
- IF long THEN
- Write("D");
- ELSE
- Write("E");
- END;
- IF exp < 0 THEN
- Write("-"); exp := - exp;
- ELSE
- Write("+");
- END;
- IF long THEN
- power := 1000;
- ELSE
- power := 100;
- END;
- WHILE power > 0 DO
- digit := (exp DIV power) MOD base;
- Write(CHR(digit+ORD("0")));
- power := power DIV base;
- END;
- END WriteExp;
+ PROCEDURE WriteExp(exp: Types.Int32);
+ CONST
+ base = 10;
+ VAR
+ power: Types.Int32;
+ digit: Types.Int32;
+ BEGIN
+ IF long THEN
+ Write("D");
+ ELSE
+ Write("E");
+ END;
+ IF exp < 0 THEN
+ Write("-"); exp := - exp;
+ ELSE
+ Write("+");
+ END;
+ IF long THEN
+ power := 1000;
+ ELSE
+ power := 100;
+ END;
+ WHILE power > 0 DO
+ digit := (exp DIV power) MOD base;
+ Write(CHR(digit+ORD("0")));
+ power := power DIV base;
+ END;
+ END WriteExp;
- BEGIN (* Print *)
- (* leading digits *)
- IF decpt > 0 THEN
- needed := decpt;
- ELSE
- needed := 1;
- END;
- IF neg OR sign THEN
- INC(needed);
- END;
- IF withexp OR (scale # 0) THEN
- INC(needed); (* decimal point *)
- END;
- IF withexp THEN
- INC(needed, 2); (* E[+-] *)
- IF long THEN
- INC(needed, 4);
- ELSE
- INC(needed, 3);
- END;
- END;
- INC(needed, SHORT(scale));
+ BEGIN (* Print *)
+ (* leading digits *)
+ IF decpt > 0 THEN
+ needed := decpt;
+ ELSE
+ needed := 1;
+ END;
+ IF neg OR sign THEN
+ INC(needed);
+ END;
+ IF withexp OR (scale # 0) THEN
+ INC(needed); (* decimal point *)
+ END;
+ IF withexp THEN
+ INC(needed, 2); (* E[+-] *)
+ IF long THEN
+ INC(needed, 4);
+ ELSE
+ INC(needed, 3);
+ END;
+ END;
+ INC(needed, scale);
- FillLeft(needed);
- IF neg THEN
- Write("-");
- ELSIF sign THEN
- Write("+");
- END;
- IF decpt <= 0 THEN
- Write("0");
- ELSE
- index := 0;
- WHILE index < decpt DO
- IF index < ndigits THEN
- Write(digits[index]);
- ELSE
- Write("0");
- END;
- INC(index);
- END;
- END;
- IF withexp OR (scale > 0) THEN
- Write(".");
- END;
- IF scale > 0 THEN
- count := scale;
- index := decpt;
- WHILE (index < 0) & (count > 0) DO
- Write("0"); INC(index); DEC(count);
- END;
- WHILE (index < ndigits) & (count > 0) DO
- Write(digits[index]); INC(index); DEC(count);
- END;
- WHILE count > 0 DO
- Write("0"); DEC(count);
- END;
- END;
- IF withexp THEN
- WriteExp(exp);
- END;
- FillRight(needed);
- END Print;
+ FillLeft(needed);
+ IF neg THEN
+ Write("-");
+ ELSIF sign THEN
+ Write("+");
+ END;
+ IF decpt <= 0 THEN
+ Write("0");
+ ELSE
+ index := 0;
+ WHILE index < decpt DO
+ IF index < ndigits THEN
+ Write(digits[index]);
+ ELSE
+ Write("0");
+ END;
+ INC(index);
+ END;
+ END;
+ IF withexp OR (scale > 0) THEN
+ Write(".");
+ END;
+ IF scale > 0 THEN
+ count := scale;
+ index := decpt;
+ WHILE (index < 0) & (count > 0) DO
+ Write("0"); INC(index); DEC(count);
+ END;
+ WHILE (index < ndigits) & (count > 0) DO
+ Write(digits[index]); INC(index); DEC(count);
+ END;
+ WHILE count > 0 DO
+ Write("0"); DEC(count);
+ END;
+ END;
+ IF withexp THEN
+ WriteExp(exp);
+ END;
+ FillRight(needed);
+ END Print;
- BEGIN (* WriteReal *)
- IF NextArg(index) THEN
- IF arglen[index] = SIZE(LONGREAL) THEN
- long := TRUE;
- Convert(index, lr);
- ELSIF arglen[index] = SIZE(REAL) THEN
- long := FALSE;
- Convert(index, r);
- lr := r;
- ELSIF arglen[index] = SIZE(LONGINT) THEN
- long := FALSE;
- Convert(index, longint);
- lr := longint;
- ELSIF arglen[index] = SIZE(INTEGER) THEN
- long := FALSE;
- Convert(index, int);
- lr := int;
- (*ELSIF arglen[index] = SIZE(SYS.INT16) THEN
- long := FALSE;
- Convert(index, int16);
- lr := int16;*)
- ELSIF arglen[index] = SIZE(SHORTINT) THEN
- long := FALSE;
- Convert(index, shortint);
- lr := shortint;
- ELSE
- Error(badArgumentSize); RETURN FALSE
- END;
- IF scale = -1 THEN
- scale := defaultscale;
- END;
- (* check for NaNs and other invalid numbers *)
- IF ~IEEE.Valid(lr) THEN
- IF IEEE.NotANumber(lr) THEN
- Write("N"); Write("a"); Write("N");
- RETURN TRUE
- ELSE
- IF lr < 0 THEN
- Write("-");
- ELSE
- Write("+");
- END;
- Write("i"); Write("n"); Write("f");
- END;
- RETURN TRUE
- END;
- (* real value in `lr' *)
- Reals.ExpAndMan(lr, long, 10, exponent, mantissa);
- CASE format OF
- | "e": ndigits := SHORT(scale)+1;
- | "f": ndigits := SHORT(scale)+exponent+1;
- IF ndigits <= 0 THEN
- ndigits := 1;
- END;
- | "g": ndigits := SHORT(scale);
- ELSE
- END;
- Reals.Digits(mantissa, 10, digits, neg,
- (* force = *) format # "g", ndigits);
- decpt := 1;
- CASE format OF
- | "e": Print(decpt, (* withexp = *) TRUE, exponent);
- | "f": INC(decpt, exponent);
- Print(decpt, (* withexp = *) FALSE, 0);
- | "g": IF (exponent < -4) OR (exponent > scale) THEN
- scale := ndigits-1;
- Print(decpt, (* withexp = *) TRUE, exponent);
- ELSE
- INC(decpt, exponent);
- scale := ndigits-1;
- DEC(scale, LONG(exponent));
- IF scale < 0 THEN
- scale := 0;
- END;
- Print(decpt, (* withexp = *) FALSE, 0);
- END;
- ELSE
- END;
- RETURN TRUE
- ELSE
- RETURN FALSE
- END;
- END WriteReal;
+ BEGIN (* WriteReal *)
+ IF NextArg(index) THEN
+ IF arglen[index] = SIZE(Types.Real64) THEN
+ long := TRUE;
+ Convert(index, lr);
+ ELSIF arglen[index] = SIZE(Types.Real32) THEN
+ long := FALSE;
+ Convert(index, r);
+ lr := r;
+ ELSIF arglen[index] = SIZE(Types.Int32) THEN
+ long := FALSE;
+ Convert(index, longint);
+ lr := longint;
+ ELSIF arglen[index] = SIZE(Types.Int32) THEN
+ long := FALSE;
+ Convert(index, int);
+ lr := int;
+ ELSIF arglen[index] = SIZE(SYS.INT16) THEN
+ long := FALSE;
+ Convert(index, int16);
+ lr := int16;
+ ELSIF arglen[index] = SIZE(Types.Int8) THEN
+ long := FALSE;
+ Convert(index, shortint);
+ lr := shortint;
+ ELSE
+ Error(badArgumentSize); RETURN FALSE
+ END;
+ IF scale = -1 THEN
+ scale := defaultscale;
+ END;
+ (* check for NaNs and other invalid numbers *)
+ IF ~IEEE.Valid(lr) THEN
+ IF IEEE.NotANumber(lr) THEN
+ Write("N"); Write("a"); Write("N");
+ RETURN TRUE
+ ELSE
+ IF lr < 0 THEN
+ Write("-");
+ ELSE
+ Write("+");
+ END;
+ Write("i"); Write("n"); Write("f");
+ END;
+ RETURN TRUE
+ END;
+ (* real value in `lr' *)
+ Reals.ExpAndMan(lr, long, 10, exponent, mantissa);
+ CASE format OF
+ | "e": ndigits := SHORT(scale)+1;
+ | "f": ndigits := SHORT(scale)+exponent+1;
+ IF ndigits <= 0 THEN
+ ndigits := 1;
+ END;
+ | "g": ndigits := SHORT(scale);
+ ELSE
+ END;
+ Reals.Digits(mantissa, 10, digits, neg,
+ (* force = *) format # "g", ndigits);
+ decpt := 1;
+ CASE format OF
+ | "e": Print(decpt, (* withexp = *) TRUE, exponent);
+ | "f": INC(decpt, exponent);
+ Print(decpt, (* withexp = *) FALSE, 0);
+ | "g": IF (exponent < -4) OR (exponent > scale) THEN
+ scale := ndigits-1;
+ Print(decpt, (* withexp = *) TRUE, exponent);
+ ELSE
+ INC(decpt, exponent);
+ scale := ndigits-1;
+ DEC(scale, exponent);
+ IF scale < 0 THEN
+ scale := 0;
+ END;
+ Print(decpt, (* withexp = *) FALSE, 0);
+ END;
+ ELSE
+ END;
+ RETURN TRUE
+ ELSE
+ RETURN FALSE
+ END;
+ END WriteReal;
- PROCEDURE WriteString() : BOOLEAN;
- VAR
- index: INTEGER;
- i: LONGINT;
- byte: SYS.BYTE;
- len: LONGINT;
- BEGIN
- IF NextArg(index) THEN
- len := 0;
- WHILE (len < arglen[index]) &
- ((scale = -1) OR (len < scale)) &
- ((*CHR*)SYS.VAL(CHAR, (Access(index, len))) # 0X) DO
- INC(len);
- END;
- FillLeft(len);
- i := 0;
- WHILE i < len DO
- byte := Access(index, i);
- Write(byte);
- INC(i);
- END;
- FillRight(len);
- RETURN TRUE
- END;
- RETURN FALSE
- END WriteString;
+ PROCEDURE WriteString() : BOOLEAN;
+ VAR
+ index: Types.Int32;
+ i: Types.Int32;
+ byte: SYS.BYTE;
+ len: Types.Int32;
+ BEGIN
+ IF NextArg(index) THEN
+ len := 0;
+ WHILE (len < arglen[index]) &
+ ((scale = -1) OR (len < scale)) &
+ ((*CHR*)SYS.VAL(CHAR, Access(index, len)) # 0X) DO
+ INC(len);
+ END;
+ FillLeft(len);
+ i := 0;
+ WHILE i < len DO
+ byte := Access(index, i);
+ Write(byte);
+ INC(i);
+ END;
+ FillRight(len);
+ RETURN TRUE
+ END;
+ RETURN FALSE
+ END WriteString;
- BEGIN (* Conversion *)
- CASE fmtchar OF
- | "b": RETURN WriteBool("TRUE", "FALSE")
- | "c": RETURN WriteChar()
- | "d": RETURN WriteInt(10)
- | "e",
- "f",
- "g": RETURN WriteReal(fmtchar)
- | "j": RETURN WriteBool("ja", "nein")
- | "o": RETURN WriteInt(8)
- | "s": RETURN WriteString()
- | "x": RETURN WriteInt(16)
- | "y": RETURN WriteBool("yes", "no")
- ELSE
- Error(badFormat); RETURN FALSE
- END;
- END Conversion;
+ BEGIN (* Conversion *)
+ CASE fmtchar OF
+ | "b": RETURN WriteBool("TRUE", "FALSE")
+ | "c": RETURN WriteChar()
+ | "d": RETURN WriteInt(10)
+ | "e",
+ "f",
+ "g": RETURN WriteReal(fmtchar)
+ | "j": RETURN WriteBool("ja", "nein")
+ | "o": RETURN WriteInt(8)
+ | "s": RETURN WriteString()
+ | "x": RETURN WriteInt(16)
+ | "y": RETURN WriteBool("yes", "no")
+ ELSE
+ Error(badFormat); RETURN FALSE
+ END;
+ END Conversion;
BEGIN
- IF ~Next() THEN RETURN FALSE END;
- IF fmtchar = fmtcmd THEN Write(fmtcmd); RETURN TRUE END;
- RETURN Flags() & Width() & Scale() & Conversion()
+ IF ~Next() THEN RETURN FALSE END;
+ IF fmtchar = fmtcmd THEN Write(fmtcmd); RETURN TRUE END;
+ RETURN Flags() & Width() & Scale() & Conversion()
END Format;
-
+
BEGIN
out.count := 0; out.error := FALSE;
SetSize;
nextarg := 0;
fmtindex := 0;
WHILE Next() DO
- IF fmtchar = fmtcmd THEN
- IF ~Format() THEN
- RETURN
- END;
- ELSIF (fmtchar = "\") & Next() THEN
- CASE fmtchar OF
- | "0".."9", "A".."F":
- IF ~Int(hexcharval, 16) THEN
- (* Error(s, BadFormat); *) RETURN
- END;
- Unget;
- Write(CHR(hexcharval));
- | "b": Write(08X); (* back space *)
- | "e": Write(1BX); (* escape *)
- | "f": Write(0CX); (* form feed *)
- | "n": WriteLn;
- | "q": Write("'");
- | "Q": Write(22X); (* double quote: " *)
- | "r": Write(0DX); (* carriage return *)
- | "t": Write(09X); (* horizontal tab *)
- | "&": Write(07X); (* bell *)
- ELSE
- Write(fmtchar);
- END;
- ELSE
- Write(fmtchar);
- END;
+ IF fmtchar = fmtcmd THEN
+ IF ~Format() THEN
+ RETURN
+ END;
+ ELSIF (fmtchar = "\") & Next() THEN
+ CASE fmtchar OF
+ | "0".."9", "A".."F":
+ IF ~Int(hexcharval, 16) THEN
+ (* Error(s, BadFormat); *) RETURN
+ END;
+ Unget;
+ Write(CHR(hexcharval));
+ | "b": Write(08X); (* back space *)
+ | "e": Write(1BX); (* escape *)
+ | "f": Write(0CX); (* form feed *)
+ | "n": WriteLn;
+ | "q": Write("'");
+ | "Q": Write(22X); (* double quote: " *)
+ | "r": Write(0DX); (* carriage return *)
+ | "t": Write(09X); (* horizontal tab *)
+ | "&": Write(07X); (* bell *)
+ ELSE
+ Write(fmtchar);
+ END;
+ ELSE
+ Write(fmtchar);
+ END;
END;
IF nextarg < nargs THEN
- Error(tooManyArgs);
+ Error(tooManyArgs);
ELSIF nextarg > nargs THEN
- Error(tooFewArgs);
+ Error(tooFewArgs);
END;
END Out;
(* === public part ============================================== *)
PROCEDURE F*(fmt: ARRAY OF CHAR);
- VAR x: INTEGER;
+ VAR x: Types.Int32;
BEGIN
Out(Streams.stdout, fmt, 0, x,x,x,x,x,x,x,x,x, NIL);
END F;
PROCEDURE F1*(fmt: ARRAY OF CHAR; p1: ARRAY OF SYS.BYTE);
- VAR x: INTEGER;
+ VAR x: Types.Int32;
BEGIN
Out(Streams.stdout, fmt, 1, p1, x,x,x,x,x,x,x,x, NIL);
END F1;
PROCEDURE F2*(fmt: ARRAY OF CHAR; p1, p2: ARRAY OF SYS.BYTE);
- VAR x: INTEGER;
+ VAR x: Types.Int32;
BEGIN
Out(Streams.stdout, fmt, 2, p1,p2, x,x,x,x,x,x,x, NIL);
END F2;
PROCEDURE F3*(fmt: ARRAY OF CHAR; p1, p2, p3: ARRAY OF SYS.BYTE);
- VAR x: INTEGER;
+ VAR x: Types.Int32;
BEGIN
Out(Streams.stdout, fmt, 3, p1,p2,p3, x,x,x,x,x,x, NIL);
END F3;
PROCEDURE F4*(fmt: ARRAY OF CHAR; p1, p2, p3, p4: ARRAY OF SYS.BYTE);
- VAR x: INTEGER;
+ VAR x: Types.Int32;
BEGIN
Out(Streams.stdout, fmt, 4, p1,p2,p3,p4, x,x,x,x,x, NIL);
END F4;
PROCEDURE F5*(fmt: ARRAY OF CHAR; p1, p2, p3, p4, p5: ARRAY OF SYS.BYTE);
- VAR x: INTEGER;
+ VAR x: Types.Int32;
BEGIN
Out(Streams.stdout, fmt, 5, p1,p2,p3,p4,p5, x,x,x,x, NIL);
END F5;
PROCEDURE F6*(fmt: ARRAY OF CHAR; p1, p2, p3, p4, p5, p6: ARRAY OF SYS.BYTE);
- VAR x: INTEGER;
+ VAR x: Types.Int32;
BEGIN
Out(Streams.stdout, fmt, 6, p1,p2,p3,p4,p5,p6, x,x,x, NIL);
END F6;
PROCEDURE F7*(fmt: ARRAY OF CHAR; p1, p2, p3, p4, p5, p6, p7: ARRAY OF SYS.BYTE);
- VAR x: INTEGER;
+ VAR x: Types.Int32;
BEGIN
Out(Streams.stdout, fmt, 7, p1,p2,p3,p4,p5,p6,p7, x,x, NIL);
END F7;
PROCEDURE F8*(fmt: ARRAY OF CHAR;
- p1, p2, p3, p4, p5, p6, p7, p8: ARRAY OF SYS.BYTE);
- VAR x: INTEGER;
+ p1, p2, p3, p4, p5, p6, p7, p8: ARRAY OF SYS.BYTE);
+ VAR x: Types.Int32;
BEGIN
Out(Streams.stdout, fmt, 8, p1,p2,p3,p4,p5,p6,p7,p8, x, NIL);
END F8;
PROCEDURE F9*(fmt: ARRAY OF CHAR;
- p1, p2, p3, p4, p5, p6, p7, p8, p9: ARRAY OF SYS.BYTE);
+ p1, p2, p3, p4, p5, p6, p7, p8, p9: ARRAY OF SYS.BYTE);
BEGIN
Out(Streams.stdout, fmt, 9, p1,p2,p3,p4,p5,p6,p7,p8,p9, NIL);
END F9;
PROCEDURE S*(out: Streams.Stream; fmt: ARRAY OF CHAR);
- VAR x: INTEGER;
+ VAR x: Types.Int32;
BEGIN
Out(out, fmt, 0, x,x,x,x,x,x,x,x,x, NIL);
END S;
PROCEDURE S1*(out: Streams.Stream; fmt: ARRAY OF CHAR; p1: ARRAY OF SYS.BYTE);
- VAR x: INTEGER;
+ VAR x: Types.Int32;
BEGIN
Out(out, fmt, 1, p1, x,x,x,x,x,x,x,x, NIL);
END S1;
PROCEDURE S2*(out: Streams.Stream; fmt: ARRAY OF CHAR; p1, p2: ARRAY OF SYS.BYTE);
- VAR x: INTEGER;
+ VAR x: Types.Int32;
BEGIN
Out(out, fmt, 2, p1,p2, x,x,x,x,x,x,x, NIL);
END S2;
PROCEDURE S3*(out: Streams.Stream; fmt: ARRAY OF CHAR; p1, p2, p3: ARRAY OF SYS.BYTE);
- VAR x: INTEGER;
+ VAR x: Types.Int32;
BEGIN
Out(out, fmt, 3, p1,p2,p3, x,x,x,x,x,x, NIL);
END S3;
PROCEDURE S4*(out: Streams.Stream; fmt: ARRAY OF CHAR;
- p1, p2, p3, p4: ARRAY OF SYS.BYTE);
- VAR x: INTEGER;
+ p1, p2, p3, p4: ARRAY OF SYS.BYTE);
+ VAR x: Types.Int32;
BEGIN
Out(out, fmt, 4, p1,p2,p3,p4, x,x,x,x,x, NIL);
END S4;
PROCEDURE S5*(out: Streams.Stream; fmt: ARRAY OF CHAR;
- p1, p2, p3, p4, p5: ARRAY OF SYS.BYTE);
- VAR x: INTEGER;
+ p1, p2, p3, p4, p5: ARRAY OF SYS.BYTE);
+ VAR x: Types.Int32;
BEGIN
Out(out, fmt, 5, p1,p2,p3,p4,p5, x,x,x,x, NIL);
END S5;
PROCEDURE S6*(out: Streams.Stream; fmt: ARRAY OF CHAR;
- p1, p2, p3, p4, p5, p6: ARRAY OF SYS.BYTE);
- VAR x: INTEGER;
+ p1, p2, p3, p4, p5, p6: ARRAY OF SYS.BYTE);
+ VAR x: Types.Int32;
BEGIN
Out(out, fmt, 6, p1,p2,p3,p4,p5,p6, x,x,x, NIL);
END S6;
PROCEDURE S7*(out: Streams.Stream; fmt: ARRAY OF CHAR;
- p1, p2, p3, p4, p5, p6, p7: ARRAY OF SYS.BYTE);
- VAR x: INTEGER;
+ p1, p2, p3, p4, p5, p6, p7: ARRAY OF SYS.BYTE);
+ VAR x: Types.Int32;
BEGIN
Out(out, fmt, 7, p1,p2,p3,p4,p5,p6,p7, x,x, NIL);
END S7;
PROCEDURE S8*(out: Streams.Stream; fmt: ARRAY OF CHAR;
- p1, p2, p3, p4, p5, p6, p7, p8: ARRAY OF SYS.BYTE);
- VAR x: INTEGER;
+ p1, p2, p3, p4, p5, p6, p7, p8: ARRAY OF SYS.BYTE);
+ VAR x: Types.Int32;
BEGIN
Out(out, fmt, 8, p1,p2,p3,p4,p5,p6,p7,p8, x, NIL);
END S8;
PROCEDURE S9*(out: Streams.Stream; fmt: ARRAY OF CHAR;
- p1, p2, p3, p4, p5, p6, p7, p8, p9: ARRAY OF SYS.BYTE);
+ p1, p2, p3, p4, p5, p6, p7, p8, p9: ARRAY OF SYS.BYTE);
BEGIN
Out(out, fmt, 9, p1,p2,p3,p4,p5,p6,p7,p8,p9, NIL);
END S9;
PROCEDURE SE*(out: Streams.Stream; fmt: ARRAY OF CHAR;
- errors: RelatedEvents.Object);
- VAR x: INTEGER;
+ errors: RelatedEvents.Object);
+ VAR x: Types.Int32;
BEGIN
Out(out, fmt, 0, x,x,x,x,x,x,x,x,x, NIL);
END SE;
PROCEDURE SE1*(out: Streams.Stream; fmt: ARRAY OF CHAR; p1: ARRAY OF SYS.BYTE;
errors: RelatedEvents.Object);
- VAR x: INTEGER;
+ VAR x: Types.Int32;
BEGIN
Out(out, fmt, 1, p1, x,x,x,x,x,x,x,x, errors);
END SE1;
PROCEDURE SE2*(out: Streams.Stream; fmt: ARRAY OF CHAR; p1, p2: ARRAY OF SYS.BYTE;
errors: RelatedEvents.Object);
- VAR x: INTEGER;
+ VAR x: Types.Int32;
BEGIN
Out(out, fmt, 2, p1,p2, x,x,x,x,x,x,x, errors);
END SE2;
PROCEDURE SE3*(out: Streams.Stream; fmt: ARRAY OF CHAR;
- p1, p2, p3: ARRAY OF SYS.BYTE;
+ p1, p2, p3: ARRAY OF SYS.BYTE;
errors: RelatedEvents.Object);
- VAR x: INTEGER;
+ VAR x: Types.Int32;
BEGIN
Out(out, fmt, 3, p1,p2,p3, x,x,x,x,x,x, errors);
END SE3;
PROCEDURE SE4*(out: Streams.Stream; fmt: ARRAY OF CHAR;
- p1, p2, p3, p4: ARRAY OF SYS.BYTE;
+ p1, p2, p3, p4: ARRAY OF SYS.BYTE;
errors: RelatedEvents.Object);
- VAR x: INTEGER;
+ VAR x: Types.Int32;
BEGIN
Out(out, fmt, 4, p1,p2,p3,p4, x,x,x,x,x, errors);
END SE4;
PROCEDURE SE5*(out: Streams.Stream; fmt: ARRAY OF CHAR;
- p1, p2, p3, p4, p5: ARRAY OF SYS.BYTE;
+ p1, p2, p3, p4, p5: ARRAY OF SYS.BYTE;
errors: RelatedEvents.Object);
- VAR x: INTEGER;
+ VAR x: Types.Int32;
BEGIN
Out(out, fmt, 5, p1,p2,p3,p4,p5, x,x,x,x, errors);
END SE5;
PROCEDURE SE6*(out: Streams.Stream; fmt: ARRAY OF CHAR;
- p1, p2, p3, p4, p5, p6: ARRAY OF SYS.BYTE;
+ p1, p2, p3, p4, p5, p6: ARRAY OF SYS.BYTE;
errors: RelatedEvents.Object);
- VAR x: INTEGER;
+ VAR x: Types.Int32;
BEGIN
Out(out, fmt, 6, p1,p2,p3,p4,p5,p6, x,x,x, errors);
END SE6;
PROCEDURE SE7*(out: Streams.Stream; fmt: ARRAY OF CHAR;
- p1, p2, p3, p4, p5, p6, p7: ARRAY OF SYS.BYTE;
+ p1, p2, p3, p4, p5, p6, p7: ARRAY OF SYS.BYTE;
errors: RelatedEvents.Object);
- VAR x: INTEGER;
+ VAR x: Types.Int32;
BEGIN
Out(out, fmt, 7, p1,p2,p3,p4,p5,p6,p7, x,x, errors);
END SE7;
PROCEDURE SE8*(out: Streams.Stream; fmt: ARRAY OF CHAR;
- p1, p2, p3, p4, p5, p6, p7, p8: ARRAY OF SYS.BYTE;
+ p1, p2, p3, p4, p5, p6, p7, p8: ARRAY OF SYS.BYTE;
errors: RelatedEvents.Object);
- VAR x: INTEGER;
+ VAR x: Types.Int32;
BEGIN
Out(out, fmt, 8, p1,p2,p3,p4,p5,p6,p7,p8, x, errors);
END SE8;
PROCEDURE SE9*(out: Streams.Stream; fmt: ARRAY OF CHAR;
- p1, p2, p3, p4, p5, p6, p7, p8, p9: ARRAY OF SYS.BYTE;
+ p1, p2, p3, p4, p5, p6, p7, p8, p9: ARRAY OF SYS.BYTE;
errors: RelatedEvents.Object);
BEGIN
Out(out, fmt, 9, p1,p2,p3,p4,p5,p6,p7,p8,p9, errors);
diff --git a/src/library/ulm/ulmPriorities.Mod b/src/library/ulm/ulmPriorities.Mod
index e171907a..a308df8f 100644
--- a/src/library/ulm/ulmPriorities.Mod
+++ b/src/library/ulm/ulmPriorities.Mod
@@ -49,7 +49,7 @@ MODULE ulmPriorities;
- gap defines the minimum distance between two priority regions
defined in this module
*)
-
+ IMPORT Types := ulmTypes;
CONST
region* = 10;
gap* = 10;
@@ -59,7 +59,7 @@ MODULE ulmPriorities;
*)
TYPE
- Priority* = INTEGER;
+ Priority* = Types.Int32;
VAR
(* current priority at begin of execution (after init of Events);
diff --git a/src/library/ulm/ulmProcess.Mod b/src/library/ulm/ulmProcess.Mod
index 20bb5186..ce4ce70f 100644
--- a/src/library/ulm/ulmProcess.Mod
+++ b/src/library/ulm/ulmProcess.Mod
@@ -36,7 +36,7 @@
MODULE ulmProcess;
- IMPORT Events := ulmEvents, Priorities := ulmPriorities;
+ IMPORT Events := ulmEvents, Priorities := ulmPriorities, Types := ulmTypes;
(* user readable name of our process *)
TYPE
@@ -48,7 +48,7 @@ MODULE ulmProcess;
(* exit codes *)
TYPE
- ExitCode* = INTEGER;
+ ExitCode* = Types.Int32;
VAR
indicateSuccess*: ExitCode;
indicateFailure*: ExitCode;
@@ -83,7 +83,7 @@ MODULE ulmProcess;
(* private declarations *)
VAR
handlers: Interface;
- nestlevel: INTEGER;
+ nestlevel: Types.Int32;
PROCEDURE SetHandlers*(if: Interface);
BEGIN
diff --git a/src/library/ulm/ulmRandomGenerators.Mod b/src/library/ulm/ulmRandomGenerators.Mod
index f1aa36de..baa0219e 100644
--- a/src/library/ulm/ulmRandomGenerators.Mod
+++ b/src/library/ulm/ulmRandomGenerators.Mod
@@ -74,7 +74,7 @@ MODULE ulmRandomGenerators;
Sequence* = POINTER TO SequenceRec;
Int32ValSProc* = PROCEDURE (sequence: Sequence): Types.Int32;
- LongRealValSProc* = PROCEDURE (sequence: Sequence): LONGREAL;
+ LongRealValSProc* = PROCEDURE (sequence: Sequence): Types.Real64;
RewindSequenceProc* = PROCEDURE (sequence: Sequence);
RestartSequenceProc* = PROCEDURE (sequence, seed: Sequence);
SetValSProc* = PROCEDURE (sequence: Sequence; value: Operations.Operand);
@@ -83,7 +83,7 @@ MODULE ulmRandomGenerators;
int32ValS* = 0; longRealValS* = 1; rewindSequence* = 2; restartSequence* = 3;
TYPE
- CapabilitySet* = SET; (* of [int32ValS..restartSequence] *)
+ CapabilitySet* = Types.Set; (* of [int32ValS..restartSequence] *)
Interface* = POINTER TO InterfaceRec;
InterfaceRec* =
RECORD
@@ -127,8 +127,8 @@ MODULE ulmRandomGenerators;
DefaultSequenceRec =
RECORD
(SequenceRec)
- seed1, seed2: LONGINT;
- value1, value2: LONGINT;
+ seed1, seed2: Types.Int32;
+ value1, value2: Types.Int32;
END;
ServiceDiscipline = POINTER TO ServiceDisciplineRec;
@@ -146,9 +146,9 @@ MODULE ulmRandomGenerators;
(* ----- bug workaround ----- *)
- PROCEDURE Entier(value: LONGREAL): LONGINT;
+ PROCEDURE Entier(value: Types.Real64): Types.Int32;
VAR
- result: LONGINT;
+ result: Types.Int32;
BEGIN
result := ENTIER(value);
IF result > value THEN
@@ -193,12 +193,12 @@ MODULE ulmRandomGenerators;
sequence.if.restartSequence(sequence, seed);
END RestartSequence;
- PROCEDURE ^ LongRealValS*(sequence: Sequence): LONGREAL;
+ PROCEDURE ^ LongRealValS*(sequence: Sequence): Types.Real64;
PROCEDURE Int32ValS*(sequence: Sequence): Types.Int32;
(* get random 32-bit value from sequence *)
VAR
- real: LONGREAL;
+ real: Types.Real64;
BEGIN
IF int32ValS IN sequence.caps THEN
RETURN sequence.if.int32ValS(sequence)
@@ -214,7 +214,7 @@ MODULE ulmRandomGenerators;
RETURN Int32ValS(std);
END Int32Val;
- PROCEDURE LongRealValS*(sequence: Sequence): LONGREAL;
+ PROCEDURE LongRealValS*(sequence: Sequence): Types.Real64;
(* get a uniformly distributed longreal value in [0..1) *)
BEGIN
IF longRealValS IN sequence.caps THEN
@@ -225,32 +225,32 @@ MODULE ulmRandomGenerators;
END;
END LongRealValS;
- PROCEDURE LongRealVal*(): LONGREAL;
+ PROCEDURE LongRealVal*(): Types.Real64;
(* get a uniformly distributed longreal value in [0..1) *)
BEGIN
RETURN LongRealValS(std)
END LongRealVal;
- PROCEDURE RealValS*(sequence: Sequence): REAL;
+ PROCEDURE RealValS*(sequence: Sequence): Types.Real32;
(* get a uniformly distributed real value in [0..1) *)
BEGIN
RETURN SHORT(LongRealValS(sequence))
END RealValS;
- PROCEDURE RealVal*(): REAL;
+ PROCEDURE RealVal*(): Types.Real32;
(* get a uniformly distributed real value in [0..1) *)
BEGIN
RETURN SHORT(LongRealValS(std))
END RealVal;
- PROCEDURE ValS*(sequence: Sequence; low, high: LONGINT): LONGINT;
+ PROCEDURE ValS*(sequence: Sequence; low, high: Types.Int32): Types.Int32;
(* get a uniformly distributed integer in [low..high] *)
BEGIN
ASSERT(low <= high);
RETURN Entier( low + LongRealValS(sequence) * (1. + high - low) )
END ValS;
- PROCEDURE Val*(low, high: LONGINT): LONGINT;
+ PROCEDURE Val*(low, high: Types.Int32): Types.Int32;
(* get a uniformly distributed integer in [low..high] *)
BEGIN
RETURN ValS(std, low, high)
@@ -305,7 +305,7 @@ MODULE ulmRandomGenerators;
(* ----- DefaultSequence ----- *)
- PROCEDURE CongruentialStep(VAR value1, value2: LONGINT);
+ PROCEDURE CongruentialStep(VAR value1, value2: Types.Int32);
BEGIN
value1 :=
factor1 * (value1 MOD quotient1) - remainder1 * (value1 DIV quotient1);
@@ -319,9 +319,9 @@ MODULE ulmRandomGenerators;
END;
END CongruentialStep;
- PROCEDURE DefaultSequenceValue(sequence: Sequence): LONGREAL;
+ PROCEDURE DefaultSequenceValue(sequence: Sequence): Types.Real64;
VAR
- value: LONGINT;
+ value: Types.Int32;
BEGIN
WITH sequence: DefaultSequence DO
CongruentialStep(sequence.value1, sequence.value2);
@@ -357,12 +357,12 @@ MODULE ulmRandomGenerators;
if: Interface;
daytime: Times.Time;
timeval: Times.TimeValueRec;
- count: LONGINT;
+ count: Types.Int32;
- PROCEDURE Hash(str: ARRAY OF CHAR): LONGINT;
+ PROCEDURE Hash(str: ARRAY OF CHAR): Types.Int32;
VAR
index,
- val: LONGINT;
+ val: Types.Int32;
BEGIN
val := 27567352;
index := 0;
diff --git a/src/library/ulm/ulmReals.Mod b/src/library/ulm/ulmReals.Mod
index f941c05a..a646512d 100644
--- a/src/library/ulm/ulmReals.Mod
+++ b/src/library/ulm/ulmReals.Mod
@@ -33,14 +33,14 @@
MODULE ulmReals;
- IMPORT IEEE := ulmIEEE, MC68881 := ulmMC68881;
+ IMPORT IEEE := ulmIEEE, MC68881 := ulmMC68881, Types := ulmTypes;
CONST
- (* for REAL *)
+ (* for Types.Real32 *)
maxexp* = 309;
minexp* = -323;
maxdignum* = 16;
- (* for LONGREAL *)
+ (* for Types.Real64 *)
(*
maxlongexp = 4932;
minlongexp = -4951;
@@ -55,30 +55,30 @@ MODULE ulmReals;
TYPE
PowerRec =
RECORD
- p10: LONGREAL;
- n: INTEGER;
+ p10: Types.Real64;
+ n: Types.Int32;
END;
VAR
powtab: ARRAY powers OF PowerRec;
- sigdigits: ARRAY maxbase+1 OF INTEGER; (* valid range: [2..maxbase] *)
+ sigdigits: ARRAY maxbase+1 OF Types.Int32; (* valid range: [2..maxbase] *)
- PROCEDURE ExpAndMan*(r: LONGREAL; long: BOOLEAN; base: INTEGER;
- VAR exponent: INTEGER; VAR mantissa: LONGREAL);
+ PROCEDURE ExpAndMan*(r: Types.Real64; long: BOOLEAN; base: Types.Int32;
+ VAR exponent: Types.Int32; VAR mantissa: Types.Real64);
(* get exponent and mantissa from `r':
(1.0 >= ABS(mantissa)) & (ABS(mantissa) < base)
r = mantissa * base^exponent
- long should be false if a REAL-value is passed to `r'
+ long should be false if a Types.Real32-value is passed to `r'
valid values of base: 2, 8, 10, and 16
*)
VAR
neg: BOOLEAN;
- index: INTEGER;
- roundoff: LONGREAL;
- i: INTEGER;
- ndigits: INTEGER;
+ index: Types.Int32;
+ roundoff: Types.Real64;
+ i: Types.Int32;
+ ndigits: Types.Int32;
BEGIN
IF r = 0.0 THEN
exponent := 0; mantissa := 0; RETURN
@@ -164,10 +164,10 @@ MODULE ulmReals;
END;
END ExpAndMan;
- PROCEDURE Power*(base: LONGREAL; exp: INTEGER) : LONGREAL;
+ PROCEDURE Power*(base: Types.Real64; exp: Types.Int32) : Types.Real64;
(* efficient calculation of base^exp *)
VAR
- r, res: LONGREAL;
+ r, res: Types.Real64;
neg: BOOLEAN; (* negative exponent? *)
BEGIN
IF MC68881.available & (base = 10) THEN
@@ -197,10 +197,10 @@ MODULE ulmReals;
END;
END Power;
- PROCEDURE Digits*(mantissa: LONGREAL; base: INTEGER;
+ PROCEDURE Digits*(mantissa: Types.Real64; base: Types.Int32;
VAR buf: ARRAY OF CHAR;
VAR neg: BOOLEAN;
- force: BOOLEAN; VAR ndigits: INTEGER);
+ force: BOOLEAN; VAR ndigits: Types.Int32);
(* PRE:
mantissa holds the post-condition of ExpAndMan;
valid values for base are 2, 8, 10, and 16
@@ -216,11 +216,11 @@ MODULE ulmReals;
ndigits is unchanged
*)
VAR
- index: INTEGER; (* of buf *)
- i: INTEGER; roundoff: LONGREAL;
- lastnz: INTEGER; (* last index with buf[index] # "0" *)
+ index: Types.Int32; (* of buf *)
+ i: Types.Int32; roundoff: Types.Real64;
+ lastnz: Types.Int32; (* last index with buf[index] # "0" *)
ch: CHAR;
- digit: LONGINT;
+ digit: Types.Int32;
maxdig: CHAR; (* base-1 converted *)
BEGIN
@@ -269,14 +269,14 @@ MODULE ulmReals;
buf[index] := 0X; ndigits := index;
END Digits;
- PROCEDURE Convert*(digits: ARRAY OF CHAR; base: INTEGER; neg: BOOLEAN;
- VAR mantissa: LONGREAL);
+ PROCEDURE Convert*(digits: ARRAY OF CHAR; base: Types.Int32; neg: BOOLEAN;
+ VAR mantissa: Types.Real64);
(* convert normalized `digits' (decimal point after 1st digit)
into `mantissa'
*)
VAR
- index: INTEGER;
- factor: LONGREAL;
+ index: Types.Int32;
+ factor: Types.Real64;
BEGIN
IF digits = "0" THEN
mantissa := 0;
@@ -304,7 +304,7 @@ BEGIN
powtab[4].p10 := 1.0D2; powtab[4].n := 2;
powtab[5].p10 := 1.0D1; powtab[5].n := 1;
- (* for LONGREAL *)
+ (* for Types.Real64 *)
sigdigits[2] := 64; sigdigits[3] := 40; sigdigits[4] := 32;
sigdigits[5] := 27; sigdigits[6] := 24; sigdigits[7] := 22;
sigdigits[8] := 21; sigdigits[9] := 20; sigdigits[10] := 19;
diff --git a/src/library/ulm/ulmSYSTEM.Mod b/src/library/ulm/ulmSYSTEM.Mod
index ece334a7..f4efb7d5 100644
--- a/src/library/ulm/ulmSYSTEM.Mod
+++ b/src/library/ulm/ulmSYSTEM.Mod
@@ -8,39 +8,37 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
TYPE bytearray* = ARRAY SIZE(LONGINT) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *)
pbytearray* = POINTER TO bytearray;
TYPE longrealarray* = ARRAY SIZE(LONGREAL) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *)
- plongrealarray* = POINTER TO bytearray;
+ plongrealarray* = POINTER TO longrealarray;
PROCEDURE LongToByteArr* ( l : LONGINT; VAR bar : bytearray); (* noch *)
VAR b : SYSTEM.BYTE;
- p : pbytearray;
+ adr : SYSTEM.ADDRESS;
i : LONGINT;
BEGIN
- p := SYSTEM.VAL(pbytearray, SYSTEM.ADR(l));
- FOR i := 0 TO SIZE(LONGINT) -1 DO
- b := p^[i]; bar[i] := b;
- END
+ adr := SYSTEM.ADR(l);
+ i := 0;
+ REPEAT
+ SYSTEM.GET(adr + i, b);
+ bar[i] := b;
+ INC(i)
+ UNTIL i = SIZE(LONGINT)
END LongToByteArr;
PROCEDURE LRealToByteArr* ( l : LONGREAL; VAR lar : longrealarray); (* noch *)
VAR b : SYSTEM.BYTE;
- p : plongrealarray;
+ adr: SYSTEM.ADDRESS;
i : LONGINT;
BEGIN
- p := SYSTEM.VAL(plongrealarray, SYSTEM.ADR(l));
- FOR i := 0 TO SIZE(LONGREAL) -1 DO
- b := p^[i]; lar[i] := b;
- END
+ adr := SYSTEM.ADR(l);
+ i := 0;
+ REPEAT
+ SYSTEM.GET(adr + i, b);
+ lar[i] := b;
+ INC(i)
+ UNTIL i = SIZE(LONGREAL);
END LRealToByteArr;
-(*
- PROCEDURE -Write(adr, n: LONGINT): LONGINT
- "write(1/*stdout*/, adr, n)";
-
- PROCEDURE -read(VAR ch: CHAR): LONGINT
- "read(0/*stdin*/, ch, 1)";
-*)
-
PROCEDURE TAS*(VAR flag:BOOLEAN): BOOLEAN; (* added for compatibility with ulmSYSTEM module; noch *)
VAR oldflag : BOOLEAN;
BEGIN
@@ -140,4 +138,5 @@ TYPE pchar = POINTER TO ARRAY 1 OF CHAR;
BEGIN
SYSTEM.MOVE(from, to, n);
END WMOVE;
+
END ulmSYSTEM.
diff --git a/src/library/ulm/ulmScales.Mod b/src/library/ulm/ulmScales.Mod
index 12cf5363..25af6eac 100644
--- a/src/library/ulm/ulmScales.Mod
+++ b/src/library/ulm/ulmScales.Mod
@@ -39,7 +39,7 @@
MODULE ulmScales;
IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Operations := ulmOperations, PersistentObjects := ulmPersistentObjects,
- RelatedEvents := ulmRelatedEvents, Services := ulmServices, SYS := SYSTEM;
+ RelatedEvents := ulmRelatedEvents, Services := ulmServices, SYS := SYSTEM, Types := ulmTypes;
TYPE
Scale* = POINTER TO ScaleRec;
@@ -88,25 +88,25 @@ MODULE ulmScales;
RECORD
(Operations.OperandRec)
scale: Scale;
- type: SHORTINT; (* absolute or relative? *)
+ type: Types.Int8; (* absolute or relative? *)
END;
VAR
measureType: Services.Type;
TYPE
- Value* = LONGINT;
+ Value* = Types.Int32;
CONST
add* = Operations.add; sub* = Operations.sub;
TYPE
- Operation* = SHORTINT; (* add or sub *)
+ Operation* = Types.Int8; (* add or sub *)
TYPE
CreateProc* = PROCEDURE (scale: Scale; VAR measure: Measure; abs: BOOLEAN);
GetValueProc* = PROCEDURE (measure: Measure; unit: Unit; VAR value: Value);
SetValueProc* = PROCEDURE (measure: Measure; unit: Unit; value: Value);
AssignProc* = PROCEDURE (target: Measure; source: Measure);
OperatorProc* = PROCEDURE (op: Operation; op1, op2, result: Measure);
- CompareProc* = PROCEDURE (op1, op2: Measure) : INTEGER;
+ CompareProc* = PROCEDURE (op1, op2: Measure) : Types.Int32;
ConvertProc* = PROCEDURE (from, to: Measure);
InterfaceRec* =
@@ -183,7 +183,7 @@ MODULE ulmScales;
scale.tail := listp;
END InitUnit;
- PROCEDURE CreateMeasure*(scale: Scale; VAR measure: Measure; type: SHORTINT);
+ PROCEDURE CreateMeasure*(scale: Scale; VAR measure: Measure; type: Types.Int8);
BEGIN
scale.if.create(scale, measure, type = absolute);
Operations.Init(measure, opif, opcaps);
@@ -295,7 +295,7 @@ MODULE ulmScales;
RETURN measure.type = relative
END IsRelative;
- PROCEDURE MeasureType*(measure: Measure) : SHORTINT;
+ PROCEDURE MeasureType*(measure: Measure) : Types.Int8;
BEGIN
RETURN measure.type
END MeasureType;
@@ -372,10 +372,10 @@ MODULE ulmScales;
PROCEDURE Op(op: Operations.Operation; op1, op2: Operations.Operand;
VAR result: Operations.Operand);
VAR
- restype: SHORTINT; (* type of result -- set by CheckTypes *)
+ restype: Types.Int8; (* type of result -- set by CheckTypes *)
m1, m2: Measure;
- PROCEDURE CheckTypes(VAR restype: SHORTINT);
+ PROCEDURE CheckTypes(VAR restype: Types.Int8);
(* check operands for correct typing;
sets restype to the correct result type;
*)
@@ -419,7 +419,7 @@ MODULE ulmScales;
END;
END Op;
- PROCEDURE Compare(op1, op2: Operations.Operand) : INTEGER;
+ PROCEDURE Compare(op1, op2: Operations.Operand) : Types.Int32;
VAR
m1, m2: Measure;
BEGIN
diff --git a/src/library/ulm/ulmServices.Mod b/src/library/ulm/ulmServices.Mod
index 7ec557df..73b80aad 100644
--- a/src/library/ulm/ulmServices.Mod
+++ b/src/library/ulm/ulmServices.Mod
@@ -31,7 +31,7 @@
MODULE ulmServices;
- IMPORT Disciplines := ulmDisciplines, Objects := ulmObjects;
+ IMPORT Disciplines := ulmDisciplines, Objects := ulmObjects, Types := ulmTypes;
TYPE
Type* = POINTER TO TypeRec;
@@ -84,9 +84,9 @@ MODULE ulmServices;
bufsize = 512; (* length of a name buffer in bytes *)
tabsize = 1171;
TYPE
- BufferPosition = INTEGER;
- Length = LONGINT;
- HashValue = INTEGER;
+ BufferPosition = Types.Int32;
+ Length = Types.Int32;
+ HashValue = Types.Int32;
Buffer = ARRAY bufsize OF CHAR;
NameList = POINTER TO NameListRec;
NameListRec =
@@ -116,14 +116,14 @@ MODULE ulmServices;
(* ==== name table management ======================================== *)
- PROCEDURE Hash(name: ARRAY OF CHAR; length: LONGINT) : HashValue;
+ PROCEDURE Hash(name: ARRAY OF CHAR; length: Types.Int32) : HashValue;
CONST
shift = 4;
VAR
- index: LONGINT;
- val: LONGINT;
+ index: Types.Int32;
+ val: Types.Int32;
ch: CHAR;
- ordval: INTEGER;
+ ordval: Types.Int32;
BEGIN
index := 0; val := length;
WHILE index < length DO
@@ -150,9 +150,9 @@ MODULE ulmServices;
currentPos := 0;
END CreateBuf;
- PROCEDURE StringLength(string: ARRAY OF CHAR) : LONGINT;
+ PROCEDURE StringLength(string: ARRAY OF CHAR) : Types.Int32;
VAR
- index: LONGINT;
+ index: Types.Int32;
BEGIN
index := 0;
WHILE (index < LEN(string)) & (string[index] # 0X) DO
@@ -163,7 +163,7 @@ MODULE ulmServices;
PROCEDURE InitName(name: Type; string: ARRAY OF CHAR);
VAR
- index, length: LONGINT;
+ index, length: Types.Int32;
firstbuf, buf: NameList;
startpos: BufferPosition;
BEGIN
@@ -195,9 +195,9 @@ MODULE ulmServices;
PROCEDURE EqualName(name: Type; string: ARRAY OF CHAR) : BOOLEAN;
(* precondition: both have the same length *)
VAR
- index: LONGINT;
+ index: Types.Int32;
buf: NameList;
- pos: INTEGER;
+ pos: Types.Int32;
BEGIN
buf := name.begin; pos := name.pos;
index := 0;
@@ -216,7 +216,7 @@ MODULE ulmServices;
PROCEDURE SeekName(string: ARRAY OF CHAR; VAR name: Type) : BOOLEAN;
VAR
- length: LONGINT;
+ length: Types.Int32;
hashval: HashValue;
p: Type;
BEGIN
@@ -232,9 +232,9 @@ MODULE ulmServices;
PROCEDURE ExtractName(name: Type; VAR string: ARRAY OF CHAR);
VAR
- index: LONGINT;
+ index: Types.Int32;
buf: NameList;
- pos: INTEGER;
+ pos: Types.Int32;
BEGIN
buf := name.begin; pos := name.pos;
index := 0;
@@ -331,7 +331,7 @@ MODULE ulmServices;
PROCEDURE GetModule(name: ARRAY OF CHAR; VAR module: ARRAY OF CHAR);
(* get the name of the module where 'name' was defined *)
VAR
- index: INTEGER;
+ index: Types.Int32;
BEGIN
index := 0;
WHILE (name[index] # ".") & (name[index] # 0X) &
diff --git a/src/library/ulm/ulmSets.Mod b/src/library/ulm/ulmSets.Mod
index d70d21e9..a1dcd4df 100644
--- a/src/library/ulm/ulmSets.Mod
+++ b/src/library/ulm/ulmSets.Mod
@@ -35,42 +35,43 @@
*)
MODULE ulmSets;
+IMPORT Types := ulmTypes;
CONST
- setsize* = MAX(SET) + 1;
+ setsize* = MAX(Types.Set) + 1;
TYPE
- CharSet* = ARRAY ORD(MAX(CHAR)) + 1 DIV setsize OF SET;
+ CharSet* = ARRAY (ORD(MAX(CHAR)) + 1) DIV setsize OF Types.Set;
- PROCEDURE InitSet*(VAR set: ARRAY OF SET);
- VAR i: LONGINT;
+ PROCEDURE InitSet*(VAR set: ARRAY OF Types.Set);
+ VAR i: Types.Int32;
BEGIN
i := 0;
WHILE i < LEN(set) DO
- set[i] := {}; INC(i);
+ set[i] := {}; INC(i);
END;
END InitSet;
- PROCEDURE Complement*(VAR set: ARRAY OF SET);
- VAR i: LONGINT;
+ PROCEDURE Complement*(VAR set: ARRAY OF Types.Set);
+ VAR i: Types.Int32;
BEGIN
i := 0;
WHILE i < LEN(set) DO
- set[i] := - set[i]; INC(i);
+ set[i] := - set[i]; INC(i);
END;
END Complement;
- PROCEDURE In*(VAR set: ARRAY OF SET; i: LONGINT) : BOOLEAN;
+ PROCEDURE In*(VAR set: ARRAY OF Types.Set; i: Types.Int32) : BOOLEAN;
BEGIN
RETURN (i MOD setsize) IN set[i DIV setsize]
END In;
- PROCEDURE Incl*(VAR set: ARRAY OF SET; i: LONGINT);
+ PROCEDURE Incl*(VAR set: ARRAY OF Types.Set; i: Types.Int32);
BEGIN
INCL(set[i DIV setsize], i MOD setsize);
END Incl;
- PROCEDURE Excl*(VAR set: ARRAY OF SET; i: LONGINT);
+ PROCEDURE Excl*(VAR set: ARRAY OF Types.Set; i: Types.Int32);
BEGIN
EXCL(set[i DIV setsize], i MOD setsize);
END Excl;
@@ -90,117 +91,117 @@ MODULE ulmSets;
EXCL(charset[ORD(ch) DIV setsize], ORD(ch) MOD setsize);
END ExclChar;
- PROCEDURE Intersection*(set1, set2: ARRAY OF SET; VAR result: ARRAY OF SET);
+ PROCEDURE Intersection*(set1, set2: ARRAY OF Types.Set; VAR result: ARRAY OF Types.Set);
VAR
- index: INTEGER;
+ index: Types.Int32;
BEGIN
ASSERT((LEN(result) = LEN(set1)) & (LEN(result) = LEN(set2)));
index := 0;
WHILE index < LEN(result) DO
- result[index] := set1[index] * set2[index];
- INC(index);
+ result[index] := set1[index] * set2[index];
+ INC(index);
END;
END Intersection;
- PROCEDURE SymDifference*(set1, set2: ARRAY OF SET; VAR result: ARRAY OF SET);
+ PROCEDURE SymDifference*(set1, set2: ARRAY OF Types.Set; VAR result: ARRAY OF Types.Set);
VAR
- index: INTEGER;
+ index: Types.Int32;
BEGIN
ASSERT((LEN(result) = LEN(set1)) & (LEN(result) = LEN(set2)));
index := 0;
WHILE index < LEN(result) DO
- result[index] := set1[index] / set2[index];
- INC(index);
+ result[index] := set1[index] / set2[index];
+ INC(index);
END;
END SymDifference;
- PROCEDURE Union*(set1, set2: ARRAY OF SET; VAR result: ARRAY OF SET);
+ PROCEDURE Union*(set1, set2: ARRAY OF Types.Set; VAR result: ARRAY OF Types.Set);
VAR
- index: INTEGER;
+ index: Types.Int32;
BEGIN
ASSERT((LEN(result) = LEN(set1)) & (LEN(result) = LEN(set2)));
index := 0;
WHILE index < LEN(result) DO
- result[index] := set1[index] + set2[index];
- INC(index);
+ result[index] := set1[index] + set2[index];
+ INC(index);
END;
END Union;
- PROCEDURE Difference*(set1, set2: ARRAY OF SET; VAR result: ARRAY OF SET);
+ PROCEDURE Difference*(set1, set2: ARRAY OF Types.Set; VAR result: ARRAY OF Types.Set);
VAR
- index: INTEGER;
+ index: Types.Int32;
BEGIN
ASSERT((LEN(result) = LEN(set1)) & (LEN(result) = LEN(set2)));
index := 0;
WHILE index < LEN(result) DO
- result[index] := set1[index] - set2[index];
- INC(index);
+ result[index] := set1[index] - set2[index];
+ INC(index);
END;
END Difference;
- PROCEDURE Equal*(set1, set2: ARRAY OF SET) : BOOLEAN;
+ PROCEDURE Equal*(set1, set2: ARRAY OF Types.Set) : BOOLEAN;
VAR
- index: INTEGER;
+ index: Types.Int32;
BEGIN
index := 0;
WHILE (index < LEN(set1)) & (index < LEN(set2)) DO
- IF set1[index] # set2[index] THEN
- RETURN FALSE
- END;
- INC(index);
+ IF set1[index] # set2[index] THEN
+ RETURN FALSE
+ END;
+ INC(index);
END;
WHILE index < LEN(set1) DO
- IF set1[index] # {} THEN
- RETURN FALSE
- END;
- INC(index);
+ IF set1[index] # {} THEN
+ RETURN FALSE
+ END;
+ INC(index);
END;
WHILE index < LEN(set2) DO
- IF set2[index] # {} THEN
- RETURN FALSE
- END;
- INC(index);
+ IF set2[index] # {} THEN
+ RETURN FALSE
+ END;
+ INC(index);
END;
RETURN TRUE
END Equal;
- PROCEDURE Subset*(set1, set2: ARRAY OF SET) : BOOLEAN;
+ PROCEDURE Subset*(set1, set2: ARRAY OF Types.Set) : BOOLEAN;
VAR
- index: INTEGER;
+ index: Types.Int32;
BEGIN
index := 0;
WHILE (index < LEN(set1)) & (index < LEN(set2)) DO
- IF set1[index] - set2[index] # {} THEN
- RETURN FALSE
- END;
- INC(index);
+ IF set1[index] - set2[index] # {} THEN
+ RETURN FALSE
+ END;
+ INC(index);
END;
WHILE index < LEN(set1) DO
- IF set1[index] # {} THEN
- RETURN FALSE
- END;
- INC(index);
+ IF set1[index] # {} THEN
+ RETURN FALSE
+ END;
+ INC(index);
END;
RETURN TRUE
END Subset;
- PROCEDURE Card*(set: ARRAY OF SET) : INTEGER;
+ PROCEDURE Card*(set: ARRAY OF Types.Set) : Types.Int32;
VAR
- index: INTEGER;
- i: INTEGER;
- card: INTEGER;
+ index: Types.Int32;
+ i: Types.Int32;
+ card: Types.Int32;
BEGIN
card := 0;
index := 0;
WHILE index < LEN(set) DO
- i := 0;
- WHILE i <= MAX(SET) DO
- IF i IN set[index] THEN
- INC(card);
- END;
- INC(i);
- END;
- INC(index);
+ i := 0;
+ WHILE i <= MAX(Types.Set) DO
+ IF i IN set[index] THEN
+ INC(card);
+ END;
+ INC(i);
+ END;
+ INC(index);
END;
RETURN card
END Card;
diff --git a/src/library/ulm/ulmStreamDisciplines.Mod b/src/library/ulm/ulmStreamDisciplines.Mod
index 522f9cda..32f56bfe 100644
--- a/src/library/ulm/ulmStreamDisciplines.Mod
+++ b/src/library/ulm/ulmStreamDisciplines.Mod
@@ -35,7 +35,7 @@ MODULE ulmStreamDisciplines;
(* definition of general-purpose disciplines for streams *)
- IMPORT ASCII := ulmASCII, Disciplines := ulmIndirectDisciplines, Events := ulmEvents, Sets := ulmSets, Streams := ulmStreams, SYSTEM;
+ IMPORT ASCII := ulmASCII, Disciplines := ulmIndirectDisciplines, Events := ulmEvents, Sets := ulmSets, Streams := ulmStreams, SYSTEM, Types := ulmTypes;
TYPE
LineTerminator* = ARRAY 4 OF CHAR;
@@ -51,7 +51,7 @@ MODULE ulmStreamDisciplines;
fieldseps: Sets.CharSet;
fieldsep: CHAR; (* one of them *)
whitespace: Sets.CharSet;
- indentwidth: INTEGER;
+ indentwidth: Types.Int32;
END;
VAR
@@ -61,7 +61,7 @@ MODULE ulmStreamDisciplines;
defaultFieldSep: CHAR;
defaultLineTerm: LineTerminator;
defaultWhiteSpace: Sets.CharSet;
- defaultIndentWidth: INTEGER;
+ defaultIndentWidth: Types.Int32;
PROCEDURE InitDiscipline(VAR disc: Disciplines.Discipline);
VAR
@@ -194,7 +194,7 @@ MODULE ulmStreamDisciplines;
Disciplines.Add(s, disc);
END SetWhiteSpace;
- PROCEDURE SetIndentationWidth*(s: Streams.Stream; indentwidth: INTEGER);
+ PROCEDURE SetIndentationWidth*(s: Streams.Stream; indentwidth: Types.Int32);
VAR
disc: Disciplines.Discipline;
BEGIN
@@ -207,7 +207,7 @@ MODULE ulmStreamDisciplines;
END;
END SetIndentationWidth;
- PROCEDURE GetIndentationWidth*(s: Streams.Stream; VAR indentwidth: INTEGER);
+ PROCEDURE GetIndentationWidth*(s: Streams.Stream; VAR indentwidth: Types.Int32);
VAR
disc: Disciplines.Discipline;
BEGIN
@@ -218,7 +218,7 @@ MODULE ulmStreamDisciplines;
END;
END GetIndentationWidth;
- PROCEDURE IncrIndentationWidth*(s: Streams.Stream; incr: INTEGER);
+ PROCEDURE IncrIndentationWidth*(s: Streams.Stream; incr: Types.Int32);
VAR
disc: Disciplines.Discipline;
BEGIN
diff --git a/src/library/ulm/ulmStreams.Mod b/src/library/ulm/ulmStreams.Mod
index bb55c3e6..37f25dfd 100644
--- a/src/library/ulm/ulmStreams.Mod
+++ b/src/library/ulm/ulmStreams.Mod
@@ -144,10 +144,10 @@ MODULE ulmStreams;
Address* = Types.Address;
Count* = Types.Count;
Byte* = Types.Byte;
- Whence* = SHORTINT; (* Whence = (fromStart, fromPos, fromEnd); *)
- CapabilitySet* = SET; (* OF Capability; *)
- BufMode* = SHORTINT;
- ErrorCode* = SHORTINT;
+ Whence* = Types.Int8; (* Whence = (fromStart, fromPos, fromEnd); *)
+ CapabilitySet* = Types.Set; (* OF Capability; *)
+ BufMode* = Types.Int8;
+ ErrorCode* = Types.Int8;
Stream* = POINTER TO StreamRec;
Message* = RECORD (Objects.ObjectRec) END;
@@ -185,8 +185,8 @@ MODULE ulmStreams;
BufferPool = POINTER TO BufferPoolRec;
BufferPoolRec =
RECORD
- maxbuf: INTEGER; (* maximal number of buffers to be used *)
- nbuf: INTEGER; (* number of buffers in use *)
+ maxbuf: Types.Int32; (* maximal number of buffers to be used *)
+ nbuf: Types.Int32; (* number of buffers in use *)
bucket: BucketTable;
(* list of all buffers sorted after the last access time;
tail points to the buffer most recently accessed
@@ -230,7 +230,7 @@ MODULE ulmStreams;
(Services.ObjectRec)
(* following components are set after i/o-operations *)
count*: Count; (* resulting count of last operation *)
- errors*: INTEGER; (* incremented for each error; may be set to 0 *)
+ errors*: Types.Int32; (* incremented for each error; may be set to 0 *)
error*: BOOLEAN; (* last operation successful? *)
lasterror*: ErrorCode; (* error code of last error *)
eof*: BOOLEAN; (* last read-operation with count=0 returned *)
@@ -367,7 +367,7 @@ MODULE ulmStreams;
PROCEDURE InitBufPool(s: Stream);
VAR
- index: INTEGER;
+ index: Types.Int32;
BEGIN
s.bufpool.maxbuf := 16; (* default size *)
s.bufpool.nbuf := 0; (* currently, no buffers are allocated *)
@@ -379,7 +379,7 @@ MODULE ulmStreams;
END;
END InitBufPool;
- PROCEDURE HashValue(pos: Count) : INTEGER;
+ PROCEDURE HashValue(pos: Count) : Types.Int32;
(* HashValue returns a hash value for pos *)
BEGIN
RETURN SHORT(pos DIV bufsize) MOD hashtabsize
@@ -387,7 +387,7 @@ MODULE ulmStreams;
PROCEDURE FindBuffer(s: Stream; pos: Count; VAR buf: Buffer) : BOOLEAN;
VAR
- index: INTEGER;
+ index: Types.Int32;
bp: Buffer;
BEGIN
index := HashValue(pos);
@@ -410,11 +410,11 @@ MODULE ulmStreams;
buf: Buffer;
pos: Count; (* buffer boundary for s.pos *)
posindex: Count; (* buf[posindex] corresponds to s.pos *)
- index: INTEGER; (* index into bucket table of the buffer pool *)
+ index: Types.Int32; (* index into bucket table of the buffer pool *)
PROCEDURE InitBuf(buf: Buffer);
VAR
- index: INTEGER; (* of bucket table *)
+ index: Types.Int32; (* of bucket table *)
BEGIN
buf.ok := TRUE;
buf.pos := pos;
@@ -612,7 +612,7 @@ MODULE ulmStreams;
in.tiedStream := out;
END Tie;
- PROCEDURE SetBufferPoolSize*(s: Stream; nbuf: INTEGER);
+ PROCEDURE SetBufferPoolSize*(s: Stream; nbuf: Types.Int32);
BEGIN
s.error := FALSE;
IF SYS.TAS(s.lock) THEN
@@ -624,7 +624,7 @@ MODULE ulmStreams;
s.lock := FALSE;
END SetBufferPoolSize;
- PROCEDURE GetBufferPoolSize*(s: Stream; VAR nbuf: INTEGER);
+ PROCEDURE GetBufferPoolSize*(s: Stream; VAR nbuf: Types.Int32);
BEGIN
s.error := FALSE;
CASE s.bufmode OF
diff --git a/src/library/ulm/ulmStrings.Mod b/src/library/ulm/ulmStrings.Mod
index 19b64395..56785bf9 100644
--- a/src/library/ulm/ulmStrings.Mod
+++ b/src/library/ulm/ulmStrings.Mod
@@ -64,7 +64,7 @@ MODULE ulmStrings;
posOutside* = 3; (* trunc failure: position beyond trunc pos *)
errorcodes* = 4;
TYPE
- ErrorCode* = SHORTINT;
+ ErrorCode* = Types.Int8;
Event* = POINTER TO EventRec;
EventRec* =
RECORD
@@ -91,13 +91,13 @@ MODULE ulmStrings;
(* ======= string to stream operations =========================== *)
PROCEDURE WritePart*(stream: Streams.Stream; string: ARRAY OF CHAR;
- sourceIndex: LONGINT);
+ sourceIndex: Types.Int32);
(* seek to position 0 of `stream' and
copy string[sourceIndex..] to it;
the file pointer of `stream' is left on position 0
*)
VAR
- index: LONGINT;
+ index: Types.Int32;
BEGIN
IF ~Streams.Seek(stream, 0, Streams.fromStart) OR
~Streams.Trunc(stream, 0) THEN
@@ -122,12 +122,12 @@ MODULE ulmStrings;
(* ======= stream to string operations =========================== *)
- PROCEDURE ReadPart*(VAR string: ARRAY OF CHAR; destIndex: LONGINT;
+ PROCEDURE ReadPart*(VAR string: ARRAY OF CHAR; destIndex: Types.Int32;
stream: Streams.Stream);
(* like `Read' but fill string[destIndex..] *)
VAR
- len: LONGINT;
- endIndex: LONGINT;
+ len: Types.Int32;
+ endIndex: Types.Int32;
BEGIN
len := LEN(string);
IF Streams.Seek(stream, 0, Streams.fromStart) & (destIndex < len) THEN
@@ -160,8 +160,8 @@ MODULE ulmStrings;
PROCEDURE Copy*(VAR destination: ARRAY OF CHAR;
source: ARRAY OF CHAR);
VAR
- index: LONGINT;
- minlen: LONGINT;
+ index: Types.Int32;
+ minlen: Types.Int32;
BEGIN
minlen := LEN(destination);
IF minlen > LEN(source) THEN
@@ -180,8 +180,8 @@ MODULE ulmStrings;
destination[index] := 0X;
END Copy;
- PROCEDURE PartCopy*(VAR destination: ARRAY OF CHAR; destIndex: LONGINT;
- source: ARRAY OF CHAR; sourceIndex: LONGINT);
+ PROCEDURE PartCopy*(VAR destination: ARRAY OF CHAR; destIndex: Types.Int32;
+ source: ARRAY OF CHAR; sourceIndex: Types.Int32);
(* copy source[sourceIndex..] to destination[destIndex..] *)
BEGIN
WHILE (destIndex+1 < LEN(destination)) &
@@ -195,10 +195,10 @@ MODULE ulmStrings;
END;
END PartCopy;
- PROCEDURE Len*(string: ARRAY OF CHAR) : LONGINT;
+ PROCEDURE Len*(string: ARRAY OF CHAR) : Types.Int32;
(* returns the number of characters (without terminating 0X) *)
VAR
- len: LONGINT;
+ len: Types.Int32;
BEGIN
len := 0;
WHILE (len < LEN(string)) & (string[len] # 0X) DO
@@ -316,7 +316,7 @@ MODULE ulmStrings;
PROCEDURE Flush(s: Streams.Stream) : BOOLEAN;
VAR
- len: LONGINT;
+ len: Types.Int32;
ch: CHAR;
BEGIN
WITH s: Stream DO
diff --git a/src/library/ulm/ulmSysConversions.Mod b/src/library/ulm/ulmSysConversions.Mod
index 4da16095..babdab5d 100644
--- a/src/library/ulm/ulmSysConversions.Mod
+++ b/src/library/ulm/ulmSysConversions.Mod
@@ -38,7 +38,7 @@ MODULE ulmSysConversions;
(* convert Oberon records to/from C structures *)
IMPORT Events := ulmEvents, Objects := ulmObjects, Priorities := ulmPriorities, Streams := ulmStreams, Strings := ulmStrings,
- SYS := SYSTEM, SysTypes := ulmSysTypes, Texts := ulmTexts;
+ SYS := SYSTEM, SysTypes := ulmSysTypes, Texts := ulmTexts, Types := ulmTypes;
TYPE
Address* = SysTypes.Address;
@@ -66,10 +66,10 @@ MODULE ulmSysConversions;
b: SYS.BYTE
B: BOOLEAN
c: CHAR
- s: SHORTINT
- i: INTEGER
- l: LONGINT
- S: SET
+ s: Types.Int8
+ i: Types.Int32
+ l: Types.Int32
+ S: Types.Set
C data types:
@@ -90,10 +90,10 @@ MODULE ulmSysConversions;
Rec =
RECORD
- a, b: INTEGER;
+ a, b: Types.Int32;
c: CHAR;
- s: SET;
- f: ARRAY 3 OF INTEGER;
+ s: Types.Set;
+ f: ARRAY 3 OF Types.Int32;
END;
to
@@ -118,7 +118,7 @@ MODULE ulmSysConversions;
unsigned = 0; (* suppress sign extension *)
boolean = 1; (* convert anything # 0 to 1 *)
TYPE
- Flags = SET;
+ Flags = Types.Set;
Event* = POINTER TO EventRec;
EventRec* =
RECORD
@@ -134,9 +134,9 @@ MODULE ulmSysConversions;
(* 1: Oberon type
2: C type
*)
- type1, type2: CHAR; length: INTEGER; left: INTEGER;
+ type1, type2: CHAR; length: Types.Int32; left: Types.Int32;
offset1, offset2: Address;
- size1, size2: Address; elementsleft: INTEGER; flags: Flags;
+ size1, size2: Address; elementsleft: Types.Int32; flags: Flags;
END;
Format* = POINTER TO FormatRec;
@@ -192,7 +192,7 @@ MODULE ulmSysConversions;
RETURN (ch >= "0") & (ch <= "9")
END IsDigit;
- PROCEDURE ReadInt(cv: ConvStream; VAR i: INTEGER);
+ PROCEDURE ReadInt(cv: ConvStream; VAR i: Types.Int32);
BEGIN
i := 0;
REPEAT
@@ -219,10 +219,10 @@ MODULE ulmSysConversions;
PROCEDURE ScanConv(cv: ConvStream;
VAR type1, type2: CHAR;
- VAR length: INTEGER) : BOOLEAN;
+ VAR length: Types.Int32) : BOOLEAN;
VAR
- i: INTEGER;
- factor: INTEGER;
+ i: Types.Int32;
+ factor: Types.Int32;
BEGIN
IF cv.left > 0 THEN
type1 := cv.type1;
@@ -274,8 +274,8 @@ MODULE ulmSysConversions;
PROCEDURE Align(VAR offset: Address; boundary: Address);
BEGIN
- IF SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary) # 0 THEN
- offset := SYS.VAL (INTEGER, offset) + (SYS.VAL (INTEGER, boundary) - SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary));
+ IF SYS.VAL (Types.Int32, offset) MOD SYS.VAL (Types.Int32, boundary) # 0 THEN
+ offset := SYS.VAL (Types.Int32, offset) + (SYS.VAL (Types.Int32, boundary) - SYS.VAL (Types.Int32, offset) MOD SYS.VAL (Types.Int32, boundary));
END;
END Align;
@@ -285,28 +285,28 @@ MODULE ulmSysConversions;
VAR flags: Flags) : BOOLEAN;
VAR
type1, type2: CHAR;
- length: INTEGER;
+ length: Types.Int32;
align: BOOLEAN;
- boundary: INTEGER;
+ boundary: Types.Int32;
BEGIN
IF cv.elementsleft > 0 THEN
DEC(cv.elementsleft);
(* Oberon type *)
IF size1 > SIZE(SYS.BYTE) THEN
- Align(cv.offset1, SIZE(INTEGER));
+ Align(cv.offset1, SIZE(Types.Int32));
END;
- offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1;
+ offset1 := cv.offset1; cv.offset1 := SYS.VAL (Types.Int32, cv.offset1) + size1;
size1 := cv.size1; size2 := cv.size2; flags := cv.flags;
IF (size1 > 0) & (cv.elementsleft = 0) THEN
- Align(cv.offset1, SIZE(INTEGER));
+ Align(cv.offset1, SIZE(Types.Int32));
END;
(* C type *)
IF size2 > 1 THEN
Align(cv.offset2, 2);
END;
- offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2);
+ offset2 := cv.offset2; cv.offset2 := SYS.VAL (Types.Int32, cv.offset2) + SYS.VAL (Types.Int32, size2);
RETURN TRUE
END;
@@ -318,21 +318,21 @@ MODULE ulmSysConversions;
| "b": size1 := SIZE(SYS.BYTE); INCL(flags, unsigned);
| "B": size1 := SIZE(BOOLEAN); INCL(flags, boolean);
| "c": size1 := SIZE(CHAR); INCL(flags, unsigned);
- | "s": size1 := SIZE(SHORTINT);
- | "i": size1 := SIZE(INTEGER);
- | "l": size1 := SIZE(LONGINT);
- | "S": size1 := SIZE(SET); INCL(flags, unsigned);
+ | "s": size1 := SIZE(Types.Int8);
+ | "i": size1 := SIZE(Types.Int32);
+ | "l": size1 := SIZE(Types.Int32);
+ | "S": size1 := SIZE(Types.Set); INCL(flags, unsigned);
| "-": size1 := 0;
ELSE Error(cv, "bad Oberon type specifier"); RETURN FALSE
END;
IF size1 > 0 THEN
IF length > 0 THEN
- Align(cv.offset1, SIZE(INTEGER));
+ Align(cv.offset1, SIZE(Types.Int32));
ELSIF size1 > SIZE(SYS.BYTE) THEN
- Align(cv.offset1, SIZE(INTEGER));
+ Align(cv.offset1, SIZE(Types.Int32));
END;
END;
- offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1;
+ offset1 := cv.offset1; cv.offset1 := SYS.VAL (Types.Int32, cv.offset1) + size1;
(* C type *)
CASE type2 OF
@@ -352,7 +352,7 @@ MODULE ulmSysConversions;
IF size2 > 1 THEN
Align(cv.offset2, size2);
END;
- offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2);
+ offset2 := cv.offset2; cv.offset2 := SYS.VAL (Types.Int32, cv.offset2) + SYS.VAL (Types.Int32, size2);
cv.size1 := size1; cv.size2 := size2;
IF length > 0 THEN
@@ -371,7 +371,7 @@ MODULE ulmSysConversions;
Pointer = POINTER TO Bytes;
VAR
dest, source: Pointer;
- dindex, sindex: INTEGER;
+ dindex, sindex: Types.Int32;
nonzero: BOOLEAN;
fill : CHAR;
BEGIN
@@ -383,7 +383,7 @@ MODULE ulmSysConversions;
nonzero := FALSE;
WHILE ssize > 0 DO
nonzero := nonzero OR (source[sindex] # 0X);
- INC(sindex); ssize := SYS.VAL (INTEGER, ssize) - 1;
+ INC(sindex); ssize := SYS.VAL (Types.Int32, ssize) - 1;
END;
IF dsize > 0 THEN
IF nonzero THEN
@@ -395,12 +395,12 @@ MODULE ulmSysConversions;
END;
WHILE dsize > 0 DO
dest[dindex] := 0X;
- dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex);
+ dsize := SYS.VAL (Types.Int32, dsize) - 1; INC(dindex);
END;
ELSE
WHILE (dsize > 0) & (ssize > 0) DO
dest[dindex] := source[sindex];
- ssize := SYS.VAL (INTEGER, ssize) - 1;
+ ssize := SYS.VAL (Types.Int32, ssize) - 1;
dsize := dsize - 1;
INC(dindex); INC(sindex);
END;
@@ -415,7 +415,7 @@ MODULE ulmSysConversions;
END;
WHILE dsize > 0 DO
dest[dindex] := fill;
- dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex);
+ dsize := SYS.VAL (Types.Int32, dsize) - 1; INC(dindex);
END;
END;
END;
@@ -475,7 +475,7 @@ MODULE ulmSysConversions;
WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END;
Close(cv);
size := offset1 + size1;
- Align(size, SIZE(INTEGER));
+ Align(size, SIZE(Types.Int32));
RETURN size
END OberonSize;
diff --git a/src/library/ulm/ulmSysErrors.Mod b/src/library/ulm/ulmSysErrors.Mod
index 0e81818d..ce535744 100644
--- a/src/library/ulm/ulmSysErrors.Mod
+++ b/src/library/ulm/ulmSysErrors.Mod
@@ -1,6 +1,6 @@
MODULE ulmSysErrors;
- IMPORT Errors := ulmErrors, Events := ulmEvents, Priorities := ulmPriorities, RelatedEvents := ulmRelatedEvents, Streams := ulmStreams, Strings := ulmStrings, Sys := ulmSys;
+ IMPORT Errors := ulmErrors, Events := ulmEvents, Priorities := ulmPriorities, RelatedEvents := ulmRelatedEvents, Streams := ulmStreams, Strings := ulmStrings, Sys := ulmSys, Types := ulmTypes;
CONST
perm* = 1;
@@ -138,8 +138,8 @@ MODULE ulmSysErrors;
EventRec* =
RECORD
(Events.EventRec)
- errno*: (*INTEGER*)LONGINT;
- syscall*: (*INTEGER*)LONGINT; (* number of system call *)
+ errno*: (*Types.Int32*)Types.Int32;
+ syscall*: (*Types.Int32*)Types.Int32; (* number of system call *)
text*: ARRAY textlen OF CHAR;
END;
@@ -150,7 +150,7 @@ MODULE ulmSysErrors;
syserror*: ARRAY ncodes OF Events.EventType;
PROCEDURE Raise*(errors: RelatedEvents.Object;
- errno, syscall: (*INTEGER*)LONGINT; text: ARRAY OF CHAR); (* in ulm's system INTEGER and LONGINT have the same size *)
+ errno, syscall: (*Types.Int32*)Types.Int32; text: ARRAY OF CHAR); (* in ulm's system Types.Int32 and Types.Int32 have the same size *)
(* raises the events syserrors and syserrors[syscall];
`text' contains additional information (e.g. filenames);
further, the syserrors[syscall] event is passed to
@@ -192,9 +192,9 @@ MODULE ulmSysErrors;
IF ~Streams.WriteByte(s, ch) THEN END;
END Write;
- PROCEDURE WriteInt(intval: LONGINT);
+ PROCEDURE WriteInt(intval: Types.Int32);
VAR
- rest: LONGINT;
+ rest: Types.Int32;
BEGIN
rest := intval DIV 10;
IF rest > 0 THEN
@@ -231,7 +231,7 @@ MODULE ulmSysErrors;
PROCEDURE InitEvents;
VAR
- errno: INTEGER;
+ errno: Types.Int32;
BEGIN
syserror[0] := NIL;
errno := 1;
@@ -447,11 +447,11 @@ BEGIN
message[netdown] := "Network is down";
name[netunreach] := "ENETUNREACH";
message[netunreach] := "Network is unreachable";
- name[netreset] := "ENETRESET";
+ name[netreset] := "ENETRETypes.Set";
message[netreset] := "Network dropped connection because of reset";
name[connaborted] := "ECONNABORTED";
message[connaborted] := "Software caused connection abort";
- name[connreset] := "ECONNRESET";
+ name[connreset] := "ECONNRETypes.Set";
message[connreset] := "Connection reset by peer";
name[nobufs] := "ENOBUFS";
message[nobufs] := "No buffer space available";
diff --git a/src/library/ulm/ulmSysIO.Mod b/src/library/ulm/ulmSysIO.Mod
index 2a22d29f..3274efda 100644
--- a/src/library/ulm/ulmSysIO.Mod
+++ b/src/library/ulm/ulmSysIO.Mod
@@ -33,7 +33,7 @@ MODULE ulmSysIO;
IMPORT RelatedEvents := ulmRelatedEvents,
Sys := ulmSys, SYS := SYSTEM, ulmSYSTEM,
SysErrors := ulmSysErrors, SysTypes := ulmSysTypes,
- Platform;
+ Platform, Types := ulmTypes;
CONST
(* file control options: arguments of Fcntl and Open *)
@@ -79,11 +79,11 @@ MODULE ulmSysIO;
File* = SysTypes.File; (* file descriptor *)
Address* = SysTypes.Address;
Count* = SysTypes.Count;
- Protection* = LONGINT;
- Whence* = LONGINT;
+ Protection* = Types.Int32;
+ Whence* = Types.Int32;
PROCEDURE OpenCreat*(VAR fd: File;
- filename: ARRAY OF CHAR; options: SET;
+ filename: ARRAY OF CHAR; options: Types.Set;
protection: Protection;
errors: RelatedEvents.Object;
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
@@ -110,7 +110,7 @@ MODULE ulmSysIO;
END OpenCreat;
PROCEDURE Open*(VAR fd: File;
- filename: ARRAY OF CHAR; options: SET;
+ filename: ARRAY OF CHAR; options: Types.Set;
errors: RelatedEvents.Object;
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
(* the filename must be 0X-terminated *)
@@ -196,7 +196,7 @@ MODULE ulmSysIO;
PROCEDURE Seek*(fd: File; offset: Count; whence: Whence;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
- error: Platform.ErrorCode; relativity: INTEGER;
+ error: Platform.ErrorCode; relativity: Types.Int16;
BEGIN
CASE whence OF
|fromPos: relativity := Platform.SeekCur
@@ -216,7 +216,7 @@ MODULE ulmSysIO;
PROCEDURE Tell*(fd: File; VAR offset: Count;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
- d0, d1: LONGINT;
+ d0, d1: Types.Int32;
BEGIN
IF ulmSYSTEM.UNIXCALL(Sys.lseek, d0, d1, fd, 0, fromPos) THEN
offset := d0;
@@ -232,17 +232,17 @@ MODULE ulmSysIO;
sizeofStructTermIO = 18;
tcgeta = 00005405H;
VAR
- d0, d1: LONGINT;
+ d0, d1: Types.Int32;
buf: ARRAY 32 OF SYS.BYTE; (* Should be more than sufficient *)
BEGIN
(* following system call fails for non-tty's *)
RETURN ulmSYSTEM.UNIXCALL(Sys.ioctl, d0, d1, fd, tcgeta, SYS.ADR(buf))
END Isatty;
- PROCEDURE Fcntl*(fd: File; request: INTEGER; VAR arg: LONGINT;
+ PROCEDURE Fcntl*(fd: File; request: Types.Int32; VAR arg: Types.Int32;
errors: RelatedEvents.Object;
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
VAR
- d0, d1: LONGINT;
+ d0, d1: Types.Int32;
BEGIN
interrupted := FALSE;
LOOP
@@ -261,15 +261,15 @@ MODULE ulmSysIO;
END;
END Fcntl;
- PROCEDURE FcntlSet*(fd: File; request: INTEGER; flags: SET;
+ PROCEDURE FcntlSet*(fd: File; request: Types.Int32; flags: Types.Set;
errors: RelatedEvents.Object;
retry: BOOLEAN; VAR interrupted: BOOLEAN) : BOOLEAN;
VAR
- d0, d1: LONGINT;
+ d0, d1: Types.Int32;
BEGIN
interrupted := FALSE;
LOOP
- IF ulmSYSTEM.UNIXCALL(Sys.fcntl, d0, d1, fd, request, SYS.VAL(LONGINT, flags)) THEN
+ IF ulmSYSTEM.UNIXCALL(Sys.fcntl, d0, d1, fd, request, SYS.VAL(Types.Int32, flags)) THEN
RETURN TRUE
ELSE
IF d0 = SysErrors.intr THEN
@@ -283,10 +283,10 @@ MODULE ulmSysIO;
END;
END FcntlSet;
- PROCEDURE FcntlGet*(fd: File; request: INTEGER; VAR flags: SET;
+ PROCEDURE FcntlGet*(fd: File; request: Types.Int32; VAR flags: Types.Set;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
- d0, d1: LONGINT;
+ d0, d1: Types.Int32;
BEGIN
IF ulmSYSTEM.UNIXCALL(Sys.fcntl, d0, d1, fd, request, 0) THEN
ulmSYSTEM.WMOVE(SYS.ADR(d0), SYS.ADR(flags), 1);
@@ -300,8 +300,8 @@ MODULE ulmSysIO;
PROCEDURE Dup*(fd: File; VAR newfd: File;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
- d0, d1: LONGINT;
- a0, a1: LONGINT;
+ d0, d1: Types.Int32;
+ a0, a1: Types.Int32;
BEGIN
a0 := 0; a1 := 0; (* Initialised to disable compiler warning. *)
IF ulmSYSTEM.UNIXCALL(Sys.dup, d0, d1, fd, a0, a1) THEN
@@ -315,8 +315,8 @@ MODULE ulmSysIO;
PROCEDURE Dup2*(fd, newfd: File; errors: RelatedEvents.Object) : BOOLEAN;
VAR
- d0, d1: LONGINT;
- a0, a1: LONGINT;
+ d0, d1: Types.Int32;
+ a0, a1: Types.Int32;
fd2: File;
interrupted: BOOLEAN;
BEGIN
@@ -338,9 +338,9 @@ MODULE ulmSysIO;
PROCEDURE Pipe*(VAR readfd, writefd: File;
errors: RelatedEvents.Object) : BOOLEAN;
VAR
- d0, d1: LONGINT;
- a0, a1: LONGINT;
- fds : ARRAY 2 OF (*File*)INTEGER; (* it needs int pipefd[2], and int is 4 bytes long on x86_64 -- noch *)
+ d0, d1: Types.Int32;
+ a0, a1: Types.Int32;
+ fds : ARRAY 2 OF (*File*)Types.Int32; (* it needs int pipefd[2], and int is 4 bytes long on x86_64 -- noch *)
BEGIN
a0 := 0; a1 := 0; (* Initialised to disable compiler warning. *)
IF ulmSYSTEM.UNIXCALL(Sys.pipe, d0, d1, SYS.ADR (fds), a0, a1) THEN
diff --git a/src/library/ulm/ulmSysStat.Mod b/src/library/ulm/ulmSysStat.Mod
index f9aaa507..addb33f2 100644
--- a/src/library/ulm/ulmSysStat.Mod
+++ b/src/library/ulm/ulmSysStat.Mod
@@ -40,7 +40,7 @@ MODULE ulmSysStat;
(* examine inode: stat(2) and fstat(2) *)
IMPORT RelatedEvents := ulmRelatedEvents, Sys := ulmSys, SYS := SYSTEM, uSYS := ulmSYSTEM, SysConversions := ulmSysConversions, SysErrors := ulmSysErrors,
- SysTypes := ulmSysTypes;
+ SysTypes := ulmSysTypes, Types := ulmTypes;
CONST
(* file mode:
@@ -96,17 +96,17 @@ MODULE ulmSysStat;
device*: SysTypes.Device; (* ID of device containing a directory entry
for this file *)
inode*: SysTypes.Inode; (* inode number *)
- mode*: SET; (* file mode; see mknod(2) *)
- nlinks*: LONGINT; (* number of links *)
- uid*: LONGINT; (* user id of the file's owner *)
- gid*: LONGINT; (* group id of the file's group *)
+ mode*: Types.Set; (* file mode; see mknod(2) *)
+ nlinks*: Types.Int32; (* number of links *)
+ uid*: Types.Int32; (* user id of the file's owner *)
+ gid*: Types.Int32; (* group id of the file's group *)
rdev*: SysTypes.Device; (* ID of device. this entry is defined only for
character special or block special files *)
size*: SysTypes.Offset; (* file size in bytes *)
(* Blocks and blksize are not available on all platforms.
- blksize*: LONGINT; (* preferred blocksize *)
- blocks*: LONGINT; (* # of blocks allocated *)
+ blksize*: Types.Int32; (* preferred blocksize *)
+ blocks*: Types.Int32; (* # of blocks allocated *)
*)
atime*: SysTypes.Time; (* time of last access *)
@@ -119,27 +119,27 @@ MODULE ulmSysStat;
PROCEDURE -Aerrno '#include ';
PROCEDURE -structstats "struct stat s";
- PROCEDURE -statdev(): LONGINT "(LONGINT)s.st_dev";
- PROCEDURE -statino(): LONGINT "(LONGINT)s.st_ino";
- PROCEDURE -statmode(): LONGINT "(LONGINT)s.st_mode";
- PROCEDURE -statnlink(): LONGINT "(LONGINT)s.st_nlink";
- PROCEDURE -statuid(): LONGINT "(LONGINT)s.st_uid";
- PROCEDURE -statgid(): LONGINT "(LONGINT)s.st_gid";
- PROCEDURE -statrdev(): LONGINT "(LONGINT)s.st_rdev";
- PROCEDURE -statsize(): LONGINT "(LONGINT)s.st_size";
- PROCEDURE -statatime(): LONGINT "(LONGINT)s.st_atime";
- PROCEDURE -statmtime(): LONGINT "(LONGINT)s.st_mtime";
- PROCEDURE -statctime(): LONGINT "(LONGINT)s.st_ctime";
+ PROCEDURE -statdev(): Types.Int32 "(INT32)s.st_dev";
+ PROCEDURE -statino(): Types.Int32 "(INT32)s.st_ino";
+ PROCEDURE -statmode(): Types.Int32 "(INT32)s.st_mode";
+ PROCEDURE -statnlink(): Types.Int32 "(INT32)s.st_nlink";
+ PROCEDURE -statuid(): Types.Int32 "(INT32)s.st_uid";
+ PROCEDURE -statgid(): Types.Int32 "(INT32)s.st_gid";
+ PROCEDURE -statrdev(): Types.Int32 "(INT32)s.st_rdev";
+ PROCEDURE -statsize(): Types.Int32 "(INT32)s.st_size";
+ PROCEDURE -statatime(): Types.Int32 "(INT32)s.st_atime";
+ PROCEDURE -statmtime(): Types.Int32 "(INT32)s.st_mtime";
+ PROCEDURE -statctime(): Types.Int32 "(INT32)s.st_ctime";
(* Blocks and blksize are not available on all platforms.
- PROCEDURE -statblksize(): LONGINT "(LONGINT)s.st_blksize";
- PROCEDURE -statblocks(): LONGINT "(LONGINT)s.st_blocks";
+ PROCEDURE -statblksize(): Types.Int32 "(Types.Int32)s.st_blksize";
+ PROCEDURE -statblocks(): Types.Int32 "(Types.Int32)s.st_blocks";
*)
- PROCEDURE -fstat(fd: LONGINT): INTEGER "fstat(fd, &s)";
- PROCEDURE -stat (n: ARRAY OF CHAR): INTEGER "stat((char*)n, &s)";
+ PROCEDURE -fstat(fd: Types.Int32): Types.Int32 "fstat(fd, &s)";
+ PROCEDURE -stat (n: ARRAY OF CHAR): Types.Int32 "stat((char*)n, &s)";
- PROCEDURE -err(): INTEGER "errno";
+ PROCEDURE -err(): Types.Int32 "errno";
PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec; errors: RelatedEvents.Object): BOOLEAN;
BEGIN
@@ -147,7 +147,7 @@ MODULE ulmSysStat;
IF stat(path) < 0 THEN SysErrors.Raise(errors, err(), Sys.newstat, path); RETURN FALSE END;
buf.device := SYS.VAL(SysTypes.Device, statdev());
buf.inode := SYS.VAL(SysTypes.Inode, statino());
- buf.mode := SYS.VAL(SET, statmode());
+ buf.mode := SYS.VAL(Types.Set, statmode());
buf.nlinks := statnlink();
buf.uid := statuid();
buf.gid := statgid();
@@ -166,10 +166,10 @@ MODULE ulmSysStat;
PROCEDURE Fstat*(fd: SysTypes.File; VAR buf: StatRec; errors: RelatedEvents.Object): BOOLEAN;
BEGIN
structstats;
- IF fstat(SYS.VAL(LONGINT, fd)) < 0 THEN SysErrors.Raise(errors, err(), Sys.newfstat, ""); RETURN FALSE END;
+ IF fstat(SYS.VAL(Types.Int32, fd)) < 0 THEN SysErrors.Raise(errors, err(), Sys.newfstat, ""); RETURN FALSE END;
buf.device := SYS.VAL(SysTypes.Device, statdev());
buf.inode := SYS.VAL(SysTypes.Inode, statino());
- buf.mode := SYS.VAL(SET, statmode());
+ buf.mode := SYS.VAL(Types.Set, statmode());
buf.nlinks := statnlink();
buf.uid := statuid();
buf.gid := statgid();
diff --git a/src/library/ulm/ulmSysTypes.Mod b/src/library/ulm/ulmSysTypes.Mod
index 6d16ab4b..c757a5dc 100644
--- a/src/library/ulm/ulmSysTypes.Mod
+++ b/src/library/ulm/ulmSysTypes.Mod
@@ -40,12 +40,12 @@ MODULE ulmSysTypes;
Byte* = Types.Byte;
File* = Platform.FileHandle;
- Offset* = LONGINT;
- Device* = LONGINT;
- Inode* = LONGINT;
- Time* = LONGINT;
+ Offset* = Types.Int32;
+ Device* = Types.Int32;
+ Inode* = Types.Int32;
+ Time* = Types.Int32;
- Word* = INTEGER; (* must have the size of C's int-type *)
+ Word* = Types.Int32; (* must have the size of C's int-type *)
(* Note: linux supports wait4 but not waitid, i.e. these
* constants aren't needed. *)
@@ -64,7 +64,7 @@ MODULE ulmSysTypes;
idAll = 7; (* all processes *)
idLwpid = 8; (* an LWP identifier *)
TYPE
- IdType = INTEGER; (* idPid .. idLwpid *)
+ IdType = Types.Int32; (* idPid .. idLwpid *)
*)
END ulmSysTypes.
diff --git a/src/library/ulm/ulmTCrypt.Mod b/src/library/ulm/ulmTCrypt.Mod
index c35c7809..f31decda 100644
--- a/src/library/ulm/ulmTCrypt.Mod
+++ b/src/library/ulm/ulmTCrypt.Mod
@@ -36,7 +36,8 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
Events := ulmEvents, NetIO := ulmNetIO,
PersistentObjects := ulmPersistentObjects, Random := ulmRandomGenerators,
RelatedEvents := ulmRelatedEvents, Services := ulmServices,
- Streams := ulmStreams, SYS := SYSTEM;
+ Streams := ulmStreams, SYS := SYSTEM,
+ Types := ulmTypes;
CONST
M = 16; (* size of an element of CC(M) [ring of Circular Convolution] *)
@@ -59,8 +60,8 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
TYPE
(* an element out of CC(M) *)
- CCMElement = SET;
- Exponent = ARRAY MaxVar OF SHORTINT;
+ CCMElement = Types.Set;
+ Exponent = ARRAY MaxVar OF Types.Int8;
TYPE
(* a polynomial with coefficients out of CC(M) *)
@@ -161,7 +162,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
ErrorEvent = POINTER TO ErrorEventRec;
ErrorEventRec = RECORD
(Events.EventRec)
- errorcode : SHORTINT;
+ errorcode : Types.Int8;
END;
VAR
@@ -176,7 +177,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
PolFeld : ARRAY MaxTerms OF Polynom; (* used for sorting purposes *)
PreEvalArg : ARRAY M OF TCryptInput; (* precomputed values to speed
up evaluation of a polynomial *)
- k : SHORTINT; (* simple counter during initialisation *)
+ k : Types.Int8; (* simple counter during initialisation *)
error : Events.EventType;
errormsg : ARRAY errorcodes OF Events.Message;
@@ -191,7 +192,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
errormsg[notRegular] := "element isn't regular";
END InitErrorHandling;
- PROCEDURE Error(s: Streams.Stream; errorcode: SHORTINT);
+ PROCEDURE Error(s: Streams.Stream; errorcode: Types.Int8);
VAR
event: ErrorEvent;
BEGIN
@@ -208,7 +209,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
(* tests x for regularity [a regular CCMElement contains an odd number of
set bits]; returns TRUE when x is regular, FALSE otherwise *)
VAR
- res, i : SHORTINT;
+ res, i : Types.Int8;
BEGIN
i := 0;
res := 0;
@@ -225,7 +226,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
(* compares x and y for equality; if x and y are equal TRUE is returned,
FALSE otherwise *)
VAR
- i : SHORTINT;
+ i : Types.Int8;
BEGIN
i := 0;
WHILE i < M DO
@@ -240,7 +241,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
PROCEDURE AddCCM (x, y: CCMElement; VAR z: CCMElement);
(* add x and y in CC(M) *)
VAR
- i : SHORTINT;
+ i : Types.Int8;
BEGIN
z := NullCCM;
i := 0;
@@ -255,8 +256,8 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
PROCEDURE MulCCM (x, y: CCMElement; VAR z: CCMElement);
(* multiply x and y in CC(M) *)
VAR
- i, j, diff : SHORTINT;
- tmp : INTEGER;
+ i, j, diff : Types.Int8;
+ tmp : Types.Int32;
BEGIN
z := NullCCM;
i := 0;
@@ -283,7 +284,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
UNTIL i>=M;
END MulCCM;
- PROCEDURE PowerCCM (x: CCMElement; exp: INTEGER; VAR z: CCMElement);
+ PROCEDURE PowerCCM (x: CCMElement; exp: Types.Int32; VAR z: CCMElement);
(* raises x to the power exp in CC(M) *)
VAR
tmp : CCMElement;
@@ -320,12 +321,12 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
UNTIL exp < 1;
END PowerCCM;
- PROCEDURE CreateCCM (VAR x: CCMElement; mode: SHORTINT);
+ PROCEDURE CreateCCM (VAR x: CCMElement; mode: Types.Int8);
(* creates a random element out of CC(M) depending on mode which
can be reg, sing or random;
the result is in any case different from the zero *)
VAR
- i, SetBits: SHORTINT;
+ i, SetBits: Types.Int8;
BEGIN
x := NullCCM;
REPEAT
@@ -361,10 +362,10 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
(* ***** arithmetic functions for polynomials over CC(M) ***** *)
- PROCEDURE LengthPolynom(p: Polynom) : INTEGER;
+ PROCEDURE LengthPolynom(p: Polynom) : Types.Int32;
(* returns the number of terms which make up the polynomial p *)
VAR
- i : INTEGER;
+ i : Types.Int32;
BEGIN
i := 0;
WHILE p # NIL DO
@@ -378,7 +379,7 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
(* tests the regularity of a polynomial [a polynomial is regular
iff the # of regular coefficients is odd] *)
VAR
- regkoeffs : SHORTINT;
+ regkoeffs : Types.Int8;
BEGIN
regkoeffs := 0;
WHILE p # NIL DO
@@ -391,16 +392,16 @@ MODULE ulmTCrypt; (* Michael Szczuka *)
RETURN (regkoeffs MOD 2) = 1;
END RegulaerPolynom;
- PROCEDURE CmpExp (exp1, exp2: Exponent) : SHORTINT;
+ PROCEDURE CmpExp (exp1, exp2: Exponent) : Types.Int8;
(* compares two exponent vectors and returns 0 on equality, a
positive value if exp1>exp2 and a negative value if exp1 0) & Streams.WriteByte(s, " ") DO
@@ -180,12 +180,12 @@ MODULE ulmWrite;
(* procedures writing to Streams.stdout *)
- PROCEDURE Int*(int: LONGINT; width: LONGINT);
+ PROCEDURE Int*(int: Types.Int32; width: Types.Int32);
BEGIN
IntS(Streams.stdout, int, width);
END Int;
- PROCEDURE Real*(real: LONGREAL; width: LONGINT);
+ PROCEDURE Real*(real: Types.Real64; width: Types.Int32);
(* write real in exponential format *)
BEGIN
RealS(Streams.stdout, real, width);
diff --git a/src/library/v4/Args.Mod b/src/library/v4/Args.Mod
old mode 100644
new mode 100755
index a196b5c5..c3621116
--- a/src/library/v4/Args.Mod
+++ b/src/library/v4/Args.Mod
@@ -3,20 +3,20 @@ MODULE Args; (* jt, 8.12.94 *)
(* command line argument handling for voc (jet backend) *)
- IMPORT Platform, SYSTEM;
+ IMPORT Platform, Modules, SYSTEM;
TYPE
ArgPtr = POINTER TO ARRAY 1024 OF CHAR;
ArgVec = POINTER TO ARRAY 1024 OF ArgPtr;
VAR
- argc-: LONGINT;
+ argc-: INTEGER;
argv-: SYSTEM.ADDRESS;
-PROCEDURE Get* (n: INTEGER; VAR val: ARRAY OF CHAR); BEGIN Platform.GetArg(n, val) END Get;
-PROCEDURE GetInt*(n: INTEGER; VAR val: LONGINT); BEGIN Platform.GetIntArg(n, val) END GetInt;
-PROCEDURE Pos* (s: ARRAY OF CHAR): INTEGER; BEGIN RETURN Platform.ArgPos(s) END Pos;
+PROCEDURE Get* (n: INTEGER; VAR val: ARRAY OF CHAR); BEGIN Modules.GetArg(n, val) END Get;
+PROCEDURE GetInt*(n: INTEGER; VAR val: LONGINT); BEGIN Modules.GetIntArg(n, val) END GetInt;
+PROCEDURE Pos* (s: ARRAY OF CHAR): INTEGER; BEGIN RETURN Modules.ArgPos(s) END Pos;
PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR);
BEGIN Platform.GetEnv(var, val) END GetEnv;
@@ -26,6 +26,6 @@ BEGIN RETURN Platform.getEnv(var, val) END getEnv;
BEGIN
- argc := Platform.ArgCount;
- argv := Platform.ArgVector;
+ argc := Modules.ArgCount;
+ argv := Modules.ArgVector;
END Args.
diff --git a/src/runtime/Errors.Txt b/src/runtime/Errors.Txt
index 5e608945..29ed7063 100644
--- a/src/runtime/Errors.Txt
+++ b/src/runtime/Errors.Txt
@@ -177,6 +177,7 @@ Compiler Warnings
307 no ELSE symbol after CASE statement sequence may lead to trap
308 SYSTEM.VAL result includes memory past end of source variable; use SYSTEM.GET
309 you should name this parameter type, or else no actual parameter will match
+310 redefining standard predefined type
Run-time Error Messages
-1 assertion failed, cf. SYSTEM_assert
diff --git a/src/runtime/Files.Mod b/src/runtime/Files.Mod
index 9e51f73b..64236a7d 100644
--- a/src/runtime/Files.Mod
+++ b/src/runtime/Files.Mod
@@ -2,33 +2,24 @@ 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;
BufSize = 4096;
NoDesc = -1;
- (* file states *)
+ (* No file states, used when FileDesc.fd = NoDesc *)
open = 0; (* OS File has been opened *)
create = 1; (* OS file needs to be created *)
- close = 2; (* Register telling Create to use registerName directly:
- i.e. since we're closing and all data is still in
- buffers bypass writing to temp file and then renaming
- and just write directly to fianl register name *)
-
+ close = 2; (* Flag used by Files.Register to tell Create to create the
+ file using it's registerName directly, rather than to
+ create a temporary file: i.e. since we're closing and all
+ data is still in buffers bypass writing to temp file and
+ then renaming and just write directly to final register
+ name *)
TYPE
- FileName = ARRAY 101 OF CHAR;
+ FileName = ARRAY 256 OF CHAR;
File* = POINTER TO FileDesc;
Buffer = POINTER TO BufDesc;
@@ -37,12 +28,12 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
registerName: FileName;
tempFile: BOOLEAN;
identity: Platform.FileIdentity;
- fd-: Platform.FileHandle;
+ fd: Platform.FileHandle;
len, pos: LONGINT;
bufs: ARRAY NumBufs OF Buffer;
swapper: INTEGER;
state: INTEGER;
- next: File;
+ next: POINTER [1] TO FileDesc;
END;
BufDesc = RECORD
@@ -54,7 +45,7 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
END;
Rider* = RECORD
- res*: LONGINT;
+ res*: LONGINT; (* Residue (byte count not read) at eof of ReadBytes *)
eof*: BOOLEAN;
buf: Buffer;
org: LONGINT; (* File offset of block containing current position *)
@@ -63,52 +54,57 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
VAR
- files: File; (* List of files that have an OS file handle/descriptor assigned *)
+ 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;
SearchPath: POINTER TO ARRAY OF CHAR;
-
-
PROCEDURE -IdxTrap "__HALT(-1)";
- PROCEDURE -ToAdr(x: SYSTEM.INT64): SYSTEM.ADDRESS "(ADDRESS)x";
PROCEDURE^ Finalize(o: SYSTEM.PTR);
+ PROCEDURE Assert(truth: BOOLEAN);
+ BEGIN
+ IF ~truth THEN Out.Ln; ASSERT(truth) END
+ END Assert;
+
PROCEDURE Err(s: ARRAY OF CHAR; f: File; errcode: Platform.ErrorCode);
BEGIN
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;
@@ -116,32 +112,69 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
name[i] := 0X
END GetTempName;
- PROCEDURE Create(f: File);
- VAR
- identity: Platform.FileIdentity;
- done: BOOLEAN;
- error: Platform.ErrorCode;
- err: ARRAY 32 OF CHAR;
+ (* When registering a file, it may turn out that the name we want to use
+ is aready in use by another File. E.g. the compiler opens and reads
+ an existing symbol file if present before creating an updated one.
+ When this happens on Windows, creation of the new file will be blocked
+ by the presence of the old one because it is in a open state. Further,
+ on both Unix and Windows systems we want behaviour to match that of
+ a real Oberon system, where registering the new file has the effect of
+ unregistering the old file. To simulate this we need to change the old
+ Files.File back to a temp file. *)
+ PROCEDURE Deregister(name: ARRAY OF CHAR);
+ VAR
+ identity: Platform.FileIdentity;
+ osfile: File;
+ error: Platform.ErrorCode;
+ BEGIN
+ IF Platform.IdentifyByName(name, identity) = 0 THEN
+ (* The name we are registering is an already existing file. *)
+ osfile := files;
+ WHILE (osfile # NIL) & ~Platform.SameFile(osfile.identity, identity) DO osfile := osfile.next END;
+ IF osfile # NIL THEN
+ (* osfile is the FileDesc corresponding to the file name we are hoping
+ to register. Turn it into a temporary file. *)
+ ASSERT(~osfile.tempFile); ASSERT(osfile.fd >= 0);
+ osfile.registerName := osfile.workName;
+ GetTempName(osfile.registerName, osfile.workName);
+ osfile.tempFile := TRUE;
+ osfile.state := open;
+ error := Platform.Rename(osfile.registerName, osfile.workName);
+ IF error # 0 THEN
+ Err("Couldn't rename previous version of file being registered", osfile, error)
+ END
+ END
+ END
+ END Deregister;
+
+
+ PROCEDURE Create(f: File);
+ (* Makes sure there is an OS file backing this Oberon file.
+ Used when more data has been written to an unregistered new file than
+ buffers can hold, or when registering a new file whose data is all in
+ buffers. *)
+ VAR
+ done: BOOLEAN;
+ error: Platform.ErrorCode;
+ err: ARRAY 32 OF CHAR;
BEGIN
- (*
- Out.String("Files.Create fd = "); Out.Int(f.fd,1);
- Out.String(", registerName = "); Out.String(f.registerName);
- Out.String(", workName = "); Out.String(f.workName);
- Out.String(", state = "); Out.Int(f.state,1);
- Out.Ln;
- *)
IF f.fd = NoDesc THEN
IF f.state = create THEN
+ (* New file with enough data written to exceed buffers, so we need to
+ create a temporary file to back it. *)
GetTempName(f.registerName, f.workName); f.tempFile := TRUE
- ELSIF f.state = close THEN
+ ELSE
+ ASSERT(f.state = close);
+ (* New file with all data in buffers being registered. No need for a
+ temp file, will just write the buffers to the registerName. *)
+ Deregister(f.registerName);
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END;
error := Platform.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*)
-
error := Platform.New(f.workName, f.fd);
done := error = 0;
IF done THEN
- f.next := files; files := f;
+ 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;
@@ -163,63 +196,26 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
f: File;
(* identity: Platform.FileIdentity; *)
BEGIN
- (*
- Out.String("Files.Flush buf.f.registername = "); Out.String(buf.f.registerName);
- Out.String(", buf.f.fd = "); Out.Int(buf.f.fd,1);
- Out.String(", buffer at $"); Out.Hex(SYSTEM.ADR(buf.data));
- Out.String(", size "); Out.Int(buf.size,1); Out.Ln;
- *)
IF buf.chg THEN f := buf.f; Create(f);
IF buf.org # f.pos THEN
error := Platform.Seek(f.fd, buf.org, Platform.SeekSet);
- (*
- Out.String("Seeking to "); Out.Int(buf.org,1);
- Out.String(", error code "); Out.Int(error,1); Out.Ln;
- *)
END;
error := Platform.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
IF error # 0 THEN Err("error writing file", f, error) END;
f.pos := buf.org + buf.size;
buf.chg := FALSE;
- error := Platform.Identify(f.fd, f.identity);
+ error := Platform.Identify(f.fd, f.identity); (* Update identity with new modification time. *)
IF error # 0 THEN Err("error identifying file", f, error) END;
- (*
- error := Platform.Identify(f.fd, identity);
- f.identity.mtime := identity.mtime;
- *)
END
END Flush;
-
- PROCEDURE CloseOSFile(f: File);
- (* Close the OS file handle and remove f from 'files' *)
- VAR prev: File; error: Platform.ErrorCode;
- BEGIN
- IF files = f THEN files := f.next
- ELSE
- prev := files;
- WHILE (prev # NIL) & (prev.next # f) DO prev := prev.next END;
- IF prev.next # NIL THEN prev.next := f.next END
- END;
- error := Platform.Close(f.fd);
- f.fd := NoDesc; f.state := create; DEC(Heap.FileCount);
- END CloseOSFile;
-
-
PROCEDURE Close* (f: File);
VAR
- i: LONGINT;
- error: Platform.ErrorCode;
+ i: LONGINT; error: Platform.ErrorCode;
BEGIN
IF (f.state # create) OR (f.registerName # "") THEN
Create(f); i := 0;
WHILE (i < NumBufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END;
- (* There's no reason to sync this file - we're about to close it. The OS
- will sync if necessary. Further, sync will fail for a R/O file on Windows.
- error := Platform.Sync(f.fd);
- IF error # 0 THEN Err("error syncing file", f, error) END;
- *)
- CloseOSFile(f);
END
END Close;
@@ -318,7 +314,7 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
error := Platform.Identify(fd, identity);
f := CacheEntry(identity);
IF f # NIL THEN
- (* error := Platform.Close(fd); DCWB: Either this should be removed or should call CloseOSFile. *)
+ error := Platform.Close(fd); (* fd not needed - we'll be using f.fd. *)
RETURN f
ELSE NEW(f); Heap.RegisterFinalizer(f, Finalize);
f.fd := fd; f.state := open; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
@@ -361,7 +357,7 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
PROCEDURE Pos* (VAR r: Rider): LONGINT;
BEGIN
- ASSERT(r.offset <= BufSize);
+ Assert(r.offset <= BufSize);
RETURN r.org + r.offset
END Pos;
@@ -369,18 +365,12 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
VAR org, offset, i, n: LONGINT; buf: Buffer; error: Platform.ErrorCode;
BEGIN
IF f # NIL THEN
- (*
- Out.String("Files.Set rider on fd = "); Out.Int(f.fd,1);
- Out.String(", registerName = "); Out.String(f.registerName);
- Out.String(", workName = "); Out.String(f.workName);
- Out.String(", state = "); Out.Int(f.state,1);
- Out.Ln;
- *)
IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END;
offset := pos MOD BufSize; org := pos - offset; i := 0;
WHILE (i < NumBufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END;
IF i < NumBufs THEN
- IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf
+ IF f.bufs[i] = NIL THEN
+ NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf
ELSE buf := f.bufs[i]
END
ELSE
@@ -401,7 +391,7 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
END
ELSE buf := NIL; org := 0; offset := 0
END;
- ASSERT(offset <= BufSize);
+ Assert(offset <= BufSize);
r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE; r.res := 0
END Set;
@@ -409,8 +399,10 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
VAR offset: LONGINT; buf: Buffer;
BEGIN
buf := r.buf; offset := r.offset;
- IF r.org # buf.org THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END;
- ASSERT(offset <= buf.size);
+ IF r.org # buf.org THEN
+ Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
+ END;
+ Assert(offset <= buf.size);
IF (offset < buf.size) THEN
x := buf.data[offset]; r.offset := offset + 1
ELSIF r.org + offset < buf.f.len THEN
@@ -421,22 +413,29 @@ 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
IF n > LEN(x) THEN IdxTrap END;
- xpos := 0; buf := r.buf; offset := r.offset;
+ xpos := 0;
+ buf := r.buf;
+ offset := r.offset; (* Offset within buffer r.buf *)
WHILE n > 0 DO
IF (r.org # buf.org) OR (offset >= BufSize) THEN
- Set(r, buf.f, r.org + offset);
- buf := r.buf; offset := r.offset
+ Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
END;
restInBuf := buf.size - offset;
IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN
ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END;
- SYSTEM.MOVE(SYSTEM.ADR(buf.data) + ToAdr(offset), SYSTEM.ADR(x) + ToAdr(xpos), min);
+ SYSTEM.MOVE(SYSTEM.ADR(buf.data[offset]), SYSTEM.ADR(x[xpos]), min);
INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min);
- ASSERT(offset <= BufSize)
+ Assert(offset <= BufSize)
END;
r.res := 0; r.eof := FALSE
END ReadBytes;
@@ -449,12 +448,12 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
VAR buf: Buffer; offset: LONGINT;
BEGIN
buf := r.buf; offset := r.offset;
- ASSERT(offset <= BufSize);
+ Assert(offset <= BufSize);
IF (r.org # buf.org) OR (offset >= BufSize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END;
- ASSERT(offset < BufSize);
+ Assert(offset < BufSize);
buf.data[offset] := x;
buf.chg := TRUE;
IF offset = buf.size THEN
@@ -469,17 +468,17 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
IF n > LEN(x) THEN IdxTrap END;
xpos := 0; buf := r.buf; offset := r.offset;
WHILE n > 0 DO
- ASSERT(offset <= BufSize);
+ Assert(offset <= BufSize);
IF (r.org # buf.org) OR (offset >= BufSize) THEN
Set(r, buf.f, r.org + offset);
buf := r.buf; offset := r.offset
END;
- ASSERT(offset <= BufSize);
+ Assert(offset <= BufSize);
restInBuf := BufSize - offset;
IF n > restInBuf THEN min := restInBuf ELSE min := n END;
- SYSTEM.MOVE(SYSTEM.ADR(x) + ToAdr(xpos), SYSTEM.ADR(buf.data) + ToAdr(offset), min);
+ SYSTEM.MOVE(SYSTEM.ADR(x[xpos]), SYSTEM.ADR(buf.data[offset]), min);
INC(offset, min); r.offset := offset;
- ASSERT(offset <= BufSize);
+ Assert(offset <= BufSize);
IF offset > buf.size THEN INC(buf.f.len, offset - buf.size); buf.size := offset END;
INC(xpos, min); DEC(n, min); buf.chg := TRUE
END;
@@ -520,7 +519,10 @@ Especially Length would become fairly complex.
*)
PROCEDURE Delete*(name: ARRAY OF CHAR; VAR res: INTEGER);
- BEGIN res := Platform.Unlink(name) END Delete;
+ BEGIN
+ Deregister(name);
+ res := Platform.Unlink(name)
+ END Delete;
PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER);
VAR
@@ -530,10 +532,6 @@ Especially Length would become fairly complex.
oldidentity, newidentity: Platform.FileIdentity;
buf: ARRAY 4096 OF CHAR;
BEGIN
- (*
- Out.String("Files.Rename old = "); Out.String(old);
- Out.String(", new = "); Out.String(new); Out.Ln;
- *)
error := Platform.IdentifyByName(old, oldidentity);
IF error = 0 THEN
error := Platform.IdentifyByName(new, newidentity);
@@ -542,6 +540,8 @@ Especially Length would become fairly complex.
END;
error := Platform.Rename(old, new);
(* Out.String("Platform.Rename error code "); Out.Int(error,1); Out.Ln; *)
+ (* TODO, if we already have a FileDesc for old, it ought to be updated
+ with the new workname. *)
IF ~Platform.DifferentFilesystems(error) THEN
res := error; RETURN
ELSE
@@ -574,23 +574,14 @@ Especially Length would become fairly complex.
END Rename;
PROCEDURE Register* (f: File);
- VAR idx, errcode: INTEGER; f1: File; file: ARRAY 104 OF CHAR;
+ VAR idx, errcode: INTEGER; f1: File;
BEGIN
- (*
- Out.String("Files.Register f.registerName = "); Out.String(f.registerName);
- Out.String(", fd = "); Out.Int(f.fd,1); Out.Ln;
- *)
IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END;
Close(f);
IF f.registerName # "" THEN
+ Deregister(f.registerName);
Rename(f.workName, f.registerName, errcode);
- (*
- Out.String("Renamed (for register) f.fd = "); Out.Int(f.fd,1);
- Out.String(" from workname "); Out.String(f.workName);
- Out.String(" to registerName "); Out.String(f.registerName);
- Out.String(" errorcode = "); Out.Int(errcode,1); Out.Ln;
- *)
- IF errcode # 0 THEN COPY(f.registerName, file); HALT(99) END;
+ IF errcode # 0 THEN Err("Couldn't rename temp name as register name", f, errcode) END;
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
END
END Register;
@@ -664,7 +655,7 @@ Especially Length would become fairly complex.
BEGIN s := 0; q := 0; Read(R, b);
WHILE b < 0 DO INC(q, ASH(b+128, s)); INC(s, 7); Read(R, b) END;
INC(q, ASH(b MOD 64 - b DIV 64 * 64, s));
- ASSERT(LEN(x) <= 8);
+ Assert(LEN(x) <= 8);
SYSTEM.MOVE(SYSTEM.ADR(q), SYSTEM.ADR(x), LEN(x)) (* Assumes little endian representation of q and x. *)
END ReadNum;
@@ -687,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;
@@ -720,15 +719,24 @@ Especially Length would become fairly complex.
COPY (f.workName, name);
END GetName;
+ PROCEDURE CloseOSFile(f: File);
+ (* Close the OS file handle and remove f from 'files' *)
+ VAR prev: File; error: Platform.ErrorCode;
+ BEGIN
+ IF files = f THEN files := f.next
+ ELSE
+ prev := files;
+ WHILE (prev # NIL) & (prev.next # f) DO prev := prev.next END;
+ IF prev.next # NIL THEN prev.next := f.next END
+ END;
+ error := Platform.Close(f.fd);
+ f.fd := NoDesc; f.state := create; DEC(Heap.FileCount);
+ END CloseOSFile;
+
PROCEDURE Finalize(o: SYSTEM.PTR);
VAR f: File; res: LONGINT;
BEGIN
f := SYSTEM.VAL(File, o);
- (*
- Out.String("Files.Finalize f.fd = "); Out.Int(f.fd,1);
- Out.String(", f.registername = "); Out.String(f.registerName);
- Out.String(", f.workName = "); Out.String(f.workName); Out.Ln;
- *)
IF f.fd >= 0 THEN
CloseOSFile(f);
IF f.tempFile THEN res := Platform.Unlink(f.workName) END
@@ -750,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 550867f7..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 free_lists *)
- 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
@@ -22,7 +22,7 @@ MODULE Heap;
(* heap chunks *)
nextChnkOff = S.VAL(S.ADDRESS, 0); (* next heap chunk, sorted ascendingly! *)
endOff = S.VAL(S.ADDRESS, SZA); (* end of heap chunk *)
- blkOff = S.VAL(S.ADDRESS, 3*SZA); (* first block in a chunk *)
+ blkOff = S.VAL(S.ADDRESS, 3*SZA); (* first block in a chunk, starts with tag *)
(* heap blocks *)
tagOff = S.VAL(S.ADDRESS, 0); (* block starts with tag *)
@@ -33,31 +33,32 @@ MODULE Heap;
AddressZero = S.VAL(S.ADDRESS, 0);
TYPE
- ModuleName = ARRAY ModNameLen OF CHAR;
- CmdName = ARRAY CmdNameLen OF CHAR;
+ ModuleName- = ARRAY ModNameLen OF CHAR;
+ CmdName- = ARRAY CmdNameLen OF CHAR;
- Module = POINTER TO ModuleDesc;
- Cmd = POINTER TO CmdDesc;
+ Module- = POINTER TO ModuleDesc;
+ Cmd- = POINTER TO CmdDesc;
- EnumProc = PROCEDURE(P: PROCEDURE(p: S.PTR));
+ EnumProc- = PROCEDURE(P: PROCEDURE(p: S.PTR));
- ModuleDesc = RECORD
- next: Module;
- name: ModuleName;
- refcnt: LONGINT;
- cmds: Cmd;
- types: S.ADDRESS;
- enumPtrs: EnumProc;
- reserved1, reserved2: LONGINT
- END ;
+ ModuleDesc- = RECORD
+ next-: Module;
+ name-: ModuleName;
+ refcnt-: LONGINT;
+ cmds-: Cmd;
+ types-: S.ADDRESS;
+ enumPtrs-: EnumProc;
+ reserved1,
+ reserved2: LONGINT
+ END;
- Command = PROCEDURE;
+ Command- = PROCEDURE;
- CmdDesc = RECORD
- next: Cmd;
- name: CmdName;
- cmd: Command
- END ;
+ CmdDesc- = RECORD
+ next-: Cmd;
+ name-: CmdName;
+ cmd-: Command
+ END;
Finalizer = PROCEDURE(obj: S.PTR);
@@ -67,26 +68,30 @@ MODULE Heap;
obj: S.ADDRESS; (* weak pointer *)
marked: BOOLEAN;
finalize: Finalizer;
- END ;
+ END;
VAR
(* the list of loaded (=initialization started) modules *)
- modules*: S.PTR;
+ modules-: S.PTR; (*POINTER [1] TO ModuleDesc;*)
freeList: ARRAY nofLists + 1 OF S.ADDRESS; (* dummy, 16, 32, 48, 64, 80, 96, 112, 128, sentinel *)
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 *)
- heapend: S.ADDRESS; (* max possible pointer value (used for stack collection) *)
- 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;
@@ -110,6 +115,9 @@ MODULE Heap;
END Unlock;
+ PROCEDURE -uLT(x, y: S.ADDRESS): BOOLEAN "((size_t)x < (size_t)y)";
+ PROCEDURE -uLE(x, y: S.ADDRESS): BOOLEAN "((size_t)x <= (size_t)y)";
+
(*
PROCEDURE TAS*(VAR flag:BOOLEAN): BOOLEAN; (* added for compatibility with ulmSYSTEM module; noch *)
VAR oldflag : BOOLEAN;
@@ -138,6 +146,22 @@ MODULE Heap;
RETURN m
END REGMOD;
+ PROCEDURE FreeModule*(name: ARRAY OF CHAR): LONGINT;
+ (* Returns 0 if freed, -1 if not found, refcount if found and refcount > 0. *)
+ VAR m, p: Module;
+ BEGIN m := S.VAL(Module, modules);
+ WHILE (m # NIL) & (m.name # name) DO p := m; m := m.next END;
+ IF (m # NIL) & (m.refcnt = 0) THEN
+ IF m = S.VAL(Module, modules) THEN modules := m.next
+ ELSE p.next := m.next
+ END;
+ RETURN 0
+ ELSE
+ IF m = NIL THEN RETURN -1 ELSE RETURN m.refcnt END
+ END
+ END FreeModule;
+
+
PROCEDURE REGCMD*(m: Module; VAR name: CmdName; cmd: Command);
VAR c: Cmd;
BEGIN
@@ -166,41 +190,52 @@ MODULE Heap;
PROCEDURE -OSAllocate(size: S.ADDRESS): S.ADDRESS "Platform_OSAllocate(size)";
PROCEDURE NewChunk(blksz: S.ADDRESS): S.ADDRESS;
- VAR chnk: S.ADDRESS;
+ VAR chnk, blk, end: S.ADDRESS;
BEGIN
chnk := OSAllocate(blksz + blkOff);
IF chnk # 0 THEN
- S.PUT(chnk + endOff, chnk + (blkOff + blksz));
- S.PUT(chnk + blkOff, chnk + (blkOff + sizeOff));
- S.PUT(chnk + (blkOff + sizeOff), blksz);
- S.PUT(chnk + (blkOff + sntlOff), NoPtrSntl);
- S.PUT(chnk + (blkOff + nextOff), bigBlocks);
- bigBlocks := chnk + blkOff;
- INC(heapsize, blksz)
- END ;
+ blk := chnk + blkOff; (* Heap chunk consists of a single block *)
+ end := blk + blksz;
+ S.PUT(chnk + endOff, end);
+ S.PUT(blk + tagOff, blk + sizeOff);
+ S.PUT(blk + sizeOff, blksz);
+ S.PUT(blk + sntlOff, NoPtrSntl);
+ S.PUT(blk + nextOff, bigBlocks);
+ bigBlocks := blk; (* Prepend block to list of big blocks *)
+ INC(heapsize, blksz);
+ (* Maintain heap range limits *)
+ IF uLT(blk + SZA, heapMin) THEN heapMin := blk + SZA END;
+ IF uLT(heapMax, end) THEN heapMax := end END
+ END;
RETURN chnk
END NewChunk;
PROCEDURE ExtendHeap(blksz: S.ADDRESS);
VAR size, chnk, j, next: S.ADDRESS;
BEGIN
- IF blksz > 10000*Unit THEN size := blksz
- ELSE size := 10000*Unit (* additional heuristics *)
- END ;
+ 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
(*sorted insertion*)
- IF chnk < heap THEN
+ IF uLT(chnk, heap) THEN
S.PUT(chnk, heap); heap := chnk
ELSE
j := heap; S.GET(j, next);
- WHILE (next # 0) & (chnk > next) DO
+ WHILE (next # 0) & uLT(next, chnk) DO
j := next;
S.GET(j, next)
END;
S.PUT(chnk, next); S.PUT(j, chnk)
- END ;
- IF next = 0 THEN S.GET(chnk+endOff, heapend) END
+ 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;
@@ -214,18 +249,18 @@ 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;
+ 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 i < nofLists THEN (* unlink *)
+ END;
+ IF i < nofLists THEN (* Unlink from freelist[i] *)
S.GET(adr + nextOff, next);
freeList[i] := next;
- IF i # i0 THEN (* split *)
+ IF i # i0 THEN (* Split *)
di := i - i0; restsize := di * Unit; end := adr + restsize;
S.PUT(end + sizeOff, blksz);
S.PUT(end + sntlOff, NoPtrSntl);
@@ -235,60 +270,60 @@ MODULE Heap;
freeList[di] := adr;
INC(adr, restsize)
END
- ELSE
+ ELSE (* Search in bigBlocks *)
adr := bigBlocks; prev := 0;
LOOP
- IF adr = 0 THEN
+ IF adr = 0 THEN (* Nothing free *)
IF firstTry THEN
GC(TRUE); INC(blksz, Unit);
- IF (heapsize - allocated - blksz) * 4 < heapsize THEN
- (* heap is still almost full; expand to avoid thrashing *)
- ExtendHeap((allocated + blksz) DIV (3*Unit) * (4*Unit) - heapsize)
- 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 *)
- END ;
+ (* 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);
+ 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
END
- END ;
+ END;
S.GET(adr+sizeOff, t);
- IF t >= blksz THEN EXIT END ;
+ IF uLE(blksz, t) THEN EXIT END;
prev := adr; S.GET(adr + nextOff, adr)
- END ;
+ END;
restsize := t - blksz; end := adr + restsize;
S.PUT(end + sizeOff, blksz);
S.PUT(end + sntlOff, NoPtrSntl);
S.PUT(end, end + sizeOff);
- IF restsize > nofLists * Unit THEN (*resize*)
+ IF uLT(nofLists * Unit, restsize) THEN (* Resize *)
S.PUT(adr + sizeOff, restsize)
- ELSE (*unlink*)
+ ELSE (* Unlink *)
S.GET(adr + nextOff, next);
IF prev = 0 THEN bigBlocks := next
ELSE S.PUT(prev + nextOff, next);
- END ;
- IF restsize > 0 THEN (*move*)
+ END;
+ IF restsize # 0 THEN (* Move *)
di := restsize DIV Unit;
S.PUT(adr + sizeOff, restsize);
S.PUT(adr + nextOff, freeList[di]);
freeList[di] := adr
END
- END ;
+ END;
INC(adr, restsize)
- END ;
+ END;
i := adr + 4*SZA; end := adr + blksz;
- WHILE i < end DO (*deliberately unrolled*)
+ WHILE uLT(i, end) DO (* Deliberately unrolled *)
S.PUT(i, AddressZero);
S.PUT(i + SZA, AddressZero);
S.PUT(i + 2*SZA, AddressZero);
S.PUT(i + 3*SZA, AddressZero);
INC(i, 4*SZA)
- END ;
+ END;
S.PUT(adr + nextOff, AddressZero);
S.PUT(adr, tag);
S.PUT(adr + sizeOff, AddressZero);
@@ -326,7 +361,7 @@ MODULE Heap;
S.GET(tag, offset); (* Get next ptr field offset *)
IF offset < 0 THEN (* Sentinel reached: Value is -8*(#fields+1) *)
S.PUT(q - SZA, tag + offset + 1); (* Rotate base ptr into tag *)
- IF p = 0 THEN EXIT END ;
+ IF p = 0 THEN EXIT END;
n := q; q := p;
S.GET(q - SZA, tag); DEC(tag, 1);
S.GET(tag, offset); fld := q + offset;
@@ -344,7 +379,7 @@ MODULE Heap;
tag := tagbits
END
END
- END ;
+ END;
INC(tag, SZA)
END
END
@@ -359,24 +394,25 @@ MODULE Heap;
PROCEDURE Scan;
VAR chnk, adr, end, start, tag, i, size, freesize: S.ADDRESS;
BEGIN bigBlocks := 0; i := 1;
- WHILE i < nofLists DO freeList[i] := 0; INC(i) END ;
+ WHILE i < nofLists DO freeList[i] := 0; INC(i) END;
freesize := 0; allocated := 0; chnk := heap;
WHILE chnk # 0 DO
adr := chnk + blkOff;
S.GET(chnk + endOff, end);
- WHILE adr < end DO
+ WHILE uLT(adr, end) DO
S.GET(adr, tag);
- IF ODD(tag) THEN (*marked*)
- IF freesize > 0 THEN
+ IF ODD(tag) THEN (* Marked *)
+ IF freesize # 0 THEN
start := adr - freesize;
S.PUT(start, start+SZA);
S.PUT(start+sizeOff, freesize);
S.PUT(start+sntlOff, NoPtrSntl);
- i := freesize DIV Unit; freesize := 0;
- IF i < nofLists THEN S.PUT(start + nextOff, freeList[i]); freeList[i] := start
- ELSE S.PUT(start + nextOff, bigBlocks); bigBlocks := start
+ 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
- END ;
+ END;
DEC(tag, 1);
S.PUT(adr, tag);
S.GET(tag, size);
@@ -387,62 +423,61 @@ MODULE Heap;
INC(freesize, size);
INC(adr, size)
END
- END ;
- IF freesize > 0 THEN (*collect last block*)
+ END;
+ IF freesize # 0 THEN (* Collect last block *)
start := adr - freesize;
S.PUT(start, start+SZA);
S.PUT(start+sizeOff, freesize);
S.PUT(start+sntlOff, NoPtrSntl);
- i := freesize DIV Unit; freesize := 0;
- IF i < nofLists THEN S.PUT(start + nextOff, freeList[i]); freeList[i] := start
- ELSE S.PUT(start + nextOff, bigBlocks); bigBlocks := start
+ 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
- END ;
+ END;
S.GET(chnk, chnk)
END
END Scan;
- PROCEDURE Sift (l, r: S.ADDRESS; VAR a: ARRAY OF S.ADDRESS);
- VAR i, j, x: S.ADDRESS;
+ PROCEDURE Sift (l, r: LONGINT; VAR a: ARRAY OF S.ADDRESS);
+ VAR i, j: LONGINT; x: S.ADDRESS;
BEGIN j := l; x := a[j];
LOOP i := j; j := 2*j + 1;
- IF (j < r) & (a[j] < a[j+1]) THEN INC(j) END;
- IF (j > r) OR (a[j] <= x) THEN EXIT END;
+ IF (j < r) & uLT(a[j], a[j+1]) THEN INC(j) END;
+ IF (j > r) OR uLE(a[j], x) THEN EXIT END;
a[i] := a[j]
END;
a[i] := x
END Sift;
- PROCEDURE HeapSort (n: S.ADDRESS; VAR a: ARRAY OF S.ADDRESS);
- VAR l, r, x: S.ADDRESS;
+ PROCEDURE HeapSort (n: LONGINT; VAR a: ARRAY OF S.ADDRESS);
+ VAR l, r: LONGINT; x: S.ADDRESS;
BEGIN l := n DIV 2; r := n - 1;
WHILE l > 0 DO DEC(l); Sift(l, r, a) END;
WHILE r > 0 DO x := a[0]; a[0] := a[r]; a[r] := x; DEC(r); Sift(l, r, a) END
END HeapSort;
- PROCEDURE MarkCandidates(n: S.ADDRESS; VAR cand: ARRAY OF S.ADDRESS);
- VAR chnk, adr, tag, next, lim, lim1, i, ptr, size: S.ADDRESS;
+ PROCEDURE MarkCandidates(n: LONGINT; VAR cand: ARRAY OF S.ADDRESS);
+ VAR chnk, end, adr, tag, next, i, ptr, size: S.ADDRESS;
BEGIN
- chnk := heap; i := 0; lim := cand[n-1];
- WHILE (chnk # 0 ) & (chnk < lim) DO
+ ASSERT(n > 0);
+ chnk := heap; i := 0;
+ WHILE chnk # 0 DO
+ S.GET(chnk + endOff, end);
adr := chnk + blkOff;
- S.GET(chnk + endOff, lim1);
- IF lim < lim1 THEN lim1 := lim END ;
- WHILE adr < lim1 DO
+ WHILE uLT(adr, end) DO
S.GET(adr, tag);
IF ODD(tag) THEN (*already marked*)
- S.GET(tag-1, size); INC(adr, size)
+ S.GET(tag-1, size); INC(adr, size); ptr := adr + SZA;
+ WHILE uLT(cand[i], ptr) DO INC(i); IF i = n THEN RETURN END END ;
ELSE
- S.GET(tag, size);
- ptr := adr + SZA;
- WHILE cand[i] < ptr DO INC(i) END ;
- IF i = n THEN RETURN END ;
- next := adr + size;
- IF cand[i] < next THEN Mark(ptr) END ;
- adr := next
- END
+ S.GET(tag, size); ptr := adr + SZA; INC(adr, size);
+ WHILE uLT(cand[i], ptr) DO INC(i); IF i = n THEN RETURN END END ;
+ IF uLT(cand[i], adr) THEN Mark(ptr) END
+ END ;
+ IF uLE(end, cand[i]) THEN (*skip rest of this heap chunk*) adr := end END
END ;
- S.GET(chnk, chnk)
+ S.GET(chnk + nextChnkOff, chnk)
END
END MarkCandidates;
@@ -454,7 +489,7 @@ MODULE Heap;
S.GET(n.obj - SZA, tag);
IF ~ODD(tag) THEN n.marked := FALSE; Mark(n.obj)
ELSE n.marked := TRUE
- END ;
+ END;
n := n.next
END
END CheckFin;
@@ -464,7 +499,7 @@ MODULE Heap;
BEGIN n := fin; prev := NIL;
WHILE n # NIL DO
IF ~n.marked THEN
- IF n = fin THEN fin := fin.next ELSE prev.next := n.next END ;
+ IF n = fin THEN fin := fin.next ELSE prev.next := n.next END;
n.finalize(S.VAL(S.PTR, n.obj));
(* new nodes may have been pushed in n.finalize, therefore: *)
IF prev = NIL THEN n := fin ELSE n := n.next END
@@ -483,71 +518,77 @@ MODULE Heap;
END
END FINALL;
- PROCEDURE -ExternMainStackFrame "extern ADDRESS Platform_MainStackFrame;";
- PROCEDURE -PlatformMainStackFrame(): S.ADDRESS "Platform_MainStackFrame";
+ PROCEDURE -ExternMainStackFrame "extern ADDRESS Modules_MainStackFrame;";
+ PROCEDURE -ModulesMainStackFrame(): S.ADDRESS "Modules_MainStackFrame";
PROCEDURE MarkStack(n: S.ADDRESS; VAR cand: ARRAY OF S.ADDRESS);
VAR
frame: S.PTR;
- inc, nofcand: S.ADDRESS;
- sp, p, stack0: S.ADDRESS;
- align: RECORD ch: CHAR; p: S.PTR END ;
+ nofcand: LONGINT;
+ inc, sp, p, stack0: S.ADDRESS;
+ align: RECORD ch: CHAR; p: S.PTR END;
BEGIN
IF n > 0 THEN MarkStack(n-1, cand); (* flush register windows by means of recursive calls *)
IF n > 100 THEN RETURN END (* prevent tail recursion optimization *)
- END ;
+ END;
IF n = 0 THEN
nofcand := 0; sp := S.ADR(frame);
- stack0 := PlatformMainStackFrame();
+ stack0 := ModulesMainStackFrame();
(* check for minimum alignment of pointers *)
inc := S.ADR(align.p) - S.ADR(align);
- IF sp > stack0 THEN inc := -inc END ;
+ IF uLT(stack0, sp) THEN inc := -inc END;
WHILE sp # stack0 DO
S.GET(sp, p);
- IF (p > heap) & (p < heapend) THEN
- IF nofcand = LEN(cand) THEN HeapSort(nofcand, cand); MarkCandidates(nofcand, cand); nofcand := 0 END ;
+ IF uLE(heapMin, p) & uLT(p, heapMax) THEN
+ IF nofcand = LEN(cand) THEN HeapSort(nofcand, cand); MarkCandidates(nofcand, cand); nofcand := 0 END;
cand[nofcand] := p; INC(nofcand)
- END ;
+ END;
INC(sp, inc)
- END ;
+ END;
IF nofcand > 0 THEN HeapSort(nofcand, cand); MarkCandidates(nofcand, cand) END
END
END MarkStack;
+
+
PROCEDURE GC*(markStack: BOOLEAN);
VAR
m: Module;
- i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23: S.ADDRESS;
+ i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11,
+ 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
- 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 ;
+ 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;
- CheckFin;
- Scan;
- Finalize;
- Unlock()
- 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;
+ END;
+ CheckFin;
+ Scan;
+ Finalize;
+ Unlock()
END GC;
PROCEDURE RegisterFinalizer*(obj: S.PTR; finalize: Finalizer);
@@ -558,18 +599,34 @@ MODULE Heap;
END RegisterFinalizer;
-PROCEDURE -ExternHeapInit "extern void *Heap__init();";
-PROCEDURE -HeapModuleInit 'Heap__init()';
+ PROCEDURE -ExternHeapInit "extern void *Heap__init();";
+ PROCEDURE -HeapModuleInit 'Heap__init()';
PROCEDURE InitHeap*;
(* InitHeap is called by Platform.init before any module bodies have been
initialised, to enable NEW, S.NEW *)
BEGIN
- heap := NewChunk(heapSize0);
- S.GET(heap + endOff, heapend);
- S.PUT(heap, AddressZero);
- allocated := 0; firstTry := TRUE; freeList[nofLists] := 1; lockdepth := 0;
- FileCount := 0; modules := NIL; heapsize := 0; bigBlocks := 0; fin := NIL;
+ 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);
+
+ firstTry := TRUE;
+ freeList[nofLists] := 1; (* Sentinel, # 0 *)
+
+ FileCount := 0;
+ modules := NIL;
+ fin := NIL;
interrupted := FALSE;
HeapModuleInit;
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/Modules.Mod b/src/runtime/Modules.Mod
index d6b8eeeb..cf398304 100644
--- a/src/runtime/Modules.Mod
+++ b/src/runtime/Modules.Mod
@@ -3,50 +3,225 @@ MODULE Modules; (* jt 6.1.96 *)
(* access to list of modules and commands, based on ETH Oberon *)
- IMPORT SYSTEM, Heap, Platform;
+ IMPORT SYSTEM, Platform, Heap; (* Note, must import Platform before Heap *)
CONST
ModNameLen* = 20;
TYPE
- ModuleName* = ARRAY ModNameLen OF CHAR;
- Module* = POINTER TO ModuleDesc;
- Cmd* = POINTER TO CmdDesc;
- ModuleDesc* = RECORD (* cf. SYSTEM.Mod *)
- next-: Module;
- name-: ModuleName;
- refcnt-: LONGINT;
- cmds-: Cmd;
- types-: LONGINT;
- enumPtrs-: PROCEDURE (P: PROCEDURE(p: LONGINT));
- reserved1, reserved2: LONGINT;
- END ;
-
- Command* = PROCEDURE;
-
- CmdDesc* = RECORD
- next-: Cmd;
- name-: ARRAY 24 OF CHAR;
- cmd-: Command
- END ;
-
+ ModuleName* = Heap.ModuleName;
+ Module* = Heap.Module;
+ Cmd* = Heap.Cmd;
+ Command* = Heap.Command;
VAR
- res*: INTEGER;
- resMsg*: ARRAY 256 OF CHAR;
- imported*, importing*: ModuleName;
+ res*: INTEGER;
+ resMsg*: ARRAY 256 OF CHAR;
+ imported*: ModuleName;
+ importing*: ModuleName;
+
+ MainStackFrame-: SYSTEM.ADDRESS;
+ ArgCount-: INTEGER;
+ ArgVector-: SYSTEM.ADDRESS;
+ BinaryDir-: ARRAY 1024 OF CHAR;
- PROCEDURE Append(VAR a: ARRAY OF CHAR; b: ARRAY OF CHAR);
- VAR i, j: INTEGER;
+(* Program startup *)
+
+ PROCEDURE -ExternInitHeap "extern void Heap_InitHeap();";
+ PROCEDURE -InitHeap "Heap_InitHeap()";
+ PROCEDURE -ExternInitModulesInit "extern void *Modules__init(void);";
+ PROCEDURE -ModulesInit() "Modules__init()";
+
+ PROCEDURE Init*(argc: SYSTEM.INT32; argvadr: SYSTEM.ADDRESS);
+ (* This start code is called by the __INIT macro generated by the compiler
+ as the C main program. *)
BEGIN
- i := 0; WHILE a[i] # 0X DO INC(i) END;
- j := 0; WHILE b[j] # 0X DO a[i] := b[j]; INC(i); INC(j) END;
- a[i] := 0X
+ MainStackFrame := argvadr;
+ ArgCount := SYSTEM.VAL(INTEGER, argc);
+ SYSTEM.GET(argvadr, ArgVector);
+
+ InitHeap; (* Initialse heap variables needed for compiler generated *__inits *)
+ ModulesInit(); (* Our own __init code will run Platform__init and Heap__init. *)
+ END Init;
+
+
+ PROCEDURE GetArg*(n: INTEGER; VAR val: ARRAY OF CHAR);
+ TYPE argptr = POINTER TO ARRAY 1024 OF CHAR;
+ VAR arg: argptr;
+ BEGIN
+ IF n < ArgCount THEN
+ SYSTEM.GET(ArgVector + n*SIZE(SYSTEM.ADDRESS), arg); (* Address of nth argument. *)
+ COPY(arg^, val);
+ END
+ END GetArg;
+
+ PROCEDURE GetIntArg*(n: INTEGER; VAR val: LONGINT);
+ VAR s: ARRAY 64 OF CHAR; k, d, i: LONGINT;
+ BEGIN
+ s := ""; GetArg(n, s); i := 0;
+ IF s[0] = "-" THEN i := 1 END ;
+ k := 0; d := ORD(s[i]) - ORD("0");
+ WHILE (d >= 0 ) & (d <= 9) DO k := k*10 + d; INC(i); d := ORD(s[i]) - ORD("0") END ;
+ IF s[0] = "-" THEN k := -k; DEC(i) END ;
+ IF i > 0 THEN val := k END
+ END GetIntArg;
+
+ PROCEDURE ArgPos*(s: ARRAY OF CHAR): INTEGER;
+ VAR i: INTEGER; arg: ARRAY 256 OF CHAR;
+ BEGIN
+ i := 0; GetArg(i, arg);
+ WHILE (i < ArgCount) & (s # arg) DO INC(i); GetArg(i, arg) END ;
+ RETURN i
+ END ArgPos;
+
+
+(* Determine directory from which this executable was loaded *)
+
+ PROCEDURE CharCount(s: ARRAY OF CHAR): INTEGER;
+ VAR i: INTEGER;
+ BEGIN
+ i := 0; WHILE (i < LEN(s)) & (s[i] # 0X) DO INC(i) END;
+ RETURN i;
+ END CharCount;
+
+ PROCEDURE Append(s: ARRAY OF CHAR; VAR d: ARRAY OF CHAR);
+ VAR i,j: INTEGER;
+ BEGIN
+ i := 0; j := CharCount(d);
+ WHILE s[i] # 0X DO d[j] := s[i]; INC(i); INC(j) END;
+ d[j] := 0X;
END Append;
+ PROCEDURE AppendPart(c: CHAR; s: ARRAY OF CHAR; VAR d: ARRAY OF CHAR);
+ VAR i,j: INTEGER;
+ BEGIN
+ i := 0; j := CharCount(d);
+ (* Append delimiter c to d only if d is either empty or doesn not
+ already end in c. *)
+ IF (j > 0) & (d[j-1] # c) THEN d[j] := c; INC(j) END;
+ (* Append s to d *)
+ WHILE s[i] # 0X DO d[j] := s[i]; INC(i); INC(j) END;
+ d[j] := 0X;
+ END AppendPart;
- PROCEDURE -modules(): Module "(Modules_Module)Heap_modules";
- PROCEDURE -setmodules(m: Module) "Heap_modules = m";
+ PROCEDURE IsOneOf(c: CHAR; s: ARRAY OF CHAR): BOOLEAN;
+ VAR i: INTEGER;
+ BEGIN
+ IF c = 0X THEN RETURN FALSE END;
+ i := 0; WHILE (s[i] # c) & (s[i] # 0X) DO INC(i) END;
+ RETURN s[i] = c
+ END IsOneOf;
+
+ PROCEDURE IsAbsolute(d: ARRAY OF CHAR): BOOLEAN;
+ BEGIN
+ IF d = '' THEN RETURN FALSE END;
+ IF IsOneOf(d[0], '/\') THEN RETURN TRUE END;
+ IF d[1] = ':' THEN RETURN TRUE END;
+ RETURN FALSE;
+ END IsAbsolute;
+
+ PROCEDURE Canonify(s: ARRAY OF CHAR; VAR d: ARRAY OF CHAR);
+ BEGIN
+ IF IsAbsolute(s) THEN
+ COPY(s, d)
+ ELSE
+ COPY(Platform.CWD, d); AppendPart('/', s, d);
+ END;
+ END Canonify;
+
+ PROCEDURE IsFilePresent(s: ARRAY OF CHAR): BOOLEAN;
+ VAR identity: Platform.FileIdentity;
+ BEGIN
+ (*Out.String("IsFilePresent("); Out.String(s); Out.String(")."); Out.Ln;*)
+ RETURN Platform.IdentifyByName(s, identity) = 0
+ END IsFilePresent;
+
+ PROCEDURE ExtractPart(s: ARRAY OF CHAR; VAR i: INTEGER; p: ARRAY OF CHAR; VAR d: ARRAY OF CHAR);
+ (* Extracts from s starting at i up to any character in p.
+ Result string in d.
+ Returns i skipped passed found string and any number of delimiters from p.
+ *)
+ VAR j: INTEGER;
+ BEGIN
+ j := 0;
+ WHILE (s[i] # 0X) & ~IsOneOf(s[i], p) DO
+ d[j] := s[i]; INC(i); INC(j)
+ END;
+ d[j] := 0X;
+ WHILE IsOneOf(s[i], p) DO INC(i) END
+ END ExtractPart;
+
+ PROCEDURE Trim(s: ARRAY OF CHAR; VAR d: ARRAY OF CHAR);
+ (* Remove redundant '.'s and '/'s. Convert '\'s to '/'.
+ Note, does not remove 'x/..'. This cannot safely be removed because if
+ x is a link then 'x/..' means the parent of what x links to rather than
+ the directory containing link x.
+ *)
+ VAR i,j: INTEGER; part: ARRAY 1024 OF CHAR;
+ BEGIN
+ i := 0; j := 0;
+ (* Retain any leading single or pair of '/' (filesystem root or network root). *)
+ WHILE (i<2) & IsOneOf(s[i], "/\") DO INC(i); d[j] := '/'; INC(j) END;
+ d[j] := 0X;
+ (* Append path parts omitting empty or '.' parts. *)
+ WHILE s[i] # 0X DO
+ ExtractPart(s, i, "/\", part);
+ IF (part # '') & (part # '.') THEN AppendPart('/', part, d) END
+ END;
+ END Trim;
+
+ PROCEDURE FindBinaryDir(VAR binarydir: ARRAY OF CHAR);
+ TYPE pathstring = ARRAY 4096 OF CHAR;
+ VAR
+ arg0: pathstring; (* The command exactly as passed by the shell *)
+ pathlist: pathstring; (* The whole PATH environment variable *)
+ pathdir: pathstring; (* A single directory from the PATH *)
+ tempstr: pathstring;
+ i, j, k: INTEGER;
+ present: BOOLEAN;
+ BEGIN
+ IF ArgCount < 1 THEN
+ (* The caller is misbehaving: Shells and GUIs always pass the command
+ as ARGV[0]. *)
+ binarydir[0] := 0X;
+ RETURN;
+ END;
+
+ GetArg(0, arg0); (* arg0 is the command binary file name passed by the shell. *)
+ i := 0; WHILE (arg0[i] # 0X) & (arg0[i] # '/') & (arg0[i] # '\') DO INC(i) END;
+ IF (arg0[i] = '/') OR (arg0[i] = '\') THEN
+ (* The argument contains a '/', we expect it to work without reference
+ to the path. *)
+ Trim(arg0, tempstr); Canonify(tempstr, binarydir);
+ present := IsFilePresent(binarydir)
+ ELSE
+ (* There are no '/'s in arg0, so search through the path. *)
+ Platform.GetEnv("PATH", pathlist);
+ i := 0; present := FALSE;
+ WHILE (~present) & (pathlist[i] # 0X) DO
+ ExtractPart(pathlist, i, ":;", pathdir);
+ AppendPart('/', arg0, pathdir);
+ Trim(pathdir, tempstr); Canonify(tempstr, binarydir);
+ present := IsFilePresent(binarydir)
+ END
+ END;
+
+ IF present THEN
+ (* Remove trailing binarydir file name *)
+ k := CharCount(binarydir);
+ WHILE (k > 0) & ~IsOneOf(binarydir[k-1], '/\') DO DEC(k) END;
+ (* Chop off binarydir file name *)
+ IF k = 0 THEN binarydir[k] := 0X ELSE binarydir[k-1] := 0X END;
+ ELSE
+ binarydir[0] := 0X (* Couldn't determine binary directory. *)
+ END
+ END FindBinaryDir;
+
+
+(* Module and command lookup by name *)
+
+ PROCEDURE -modules(): Module "(Heap_Module)Heap_modules";
+ (*PROCEDURE -setmodules(m: Module) "Heap_modules = m";*)
PROCEDURE ThisMod* (name: ARRAY OF CHAR): Module;
VAR m: Module; bodyname: ARRAY 64 OF CHAR; body: Command;
@@ -54,7 +229,7 @@ MODULE Modules; (* jt 6.1.96 *)
WHILE (m # NIL) & (m.name # name) DO m := m.next END ;
IF m # NIL THEN res := 0; resMsg := ""
ELSE res := 1; COPY(name, importing);
- resMsg := ' module "'; Append(resMsg, name); Append(resMsg, '" not found');
+ resMsg := ' module "'; Append(name, resMsg); Append('" not found', resMsg);
END ;
RETURN m
END ThisMod;
@@ -65,37 +240,36 @@ MODULE Modules; (* jt 6.1.96 *)
WHILE (c # NIL) & (c.name # name) DO c := c.next END ;
IF c # NIL THEN res := 0; resMsg := ""; RETURN c.cmd
ELSE res := 2; resMsg := ' command "'; COPY(name, importing);
- Append(resMsg, mod.name); Append(resMsg, "."); Append(resMsg, name); Append(resMsg, '" not found');
+ Append(mod.name, resMsg); Append(".", resMsg); Append(name, resMsg); Append('" not found', resMsg);
RETURN NIL
END
END ThisCommand;
PROCEDURE Free*(name: ARRAY OF CHAR; all: BOOLEAN);
- VAR m, p: Module;
+ VAR m, p: Module; refcount: LONGINT;
BEGIN m := modules();
IF all THEN
res := 1; resMsg := 'unloading "all" not yet supported'
ELSE
- WHILE (m # NIL) & (m.name # name) DO p := m; m := m.next END ;
- IF (m # NIL) & (m.refcnt = 0) THEN
- IF m = modules() THEN setmodules(m.next)
- ELSE p.next := m.next
- END ;
+ refcount := Heap.FreeModule(name);
+ IF refcount = 0 THEN
res := 0
- ELSE res := 1;
- IF m = NIL THEN resMsg := "module not found"
+ ELSE
+ IF refcount < 0 THEN resMsg := "module not found"
ELSE resMsg := "clients of this module exist"
- END
+ END;
+ res := 1
END
END
END Free;
+
(* Run time error reporting. *)
PROCEDURE errch(c: CHAR); (* Here we favour simplicity over efficiency, so no buffering. *)
VAR e: Platform.ErrorCode;
- BEGIN e := Platform.Write(1, SYSTEM.ADR(c), 1)
+ BEGIN e := Platform.Write(Platform.StdOut, SYSTEM.ADR(c), 1)
END errch;
PROCEDURE errstring(s: ARRAY OF CHAR);
@@ -136,7 +310,7 @@ MODULE Modules; (* jt 6.1.96 *)
PROCEDURE Halt*(code: SYSTEM.INT32);
BEGIN
- (*IF HaltHandler # NIL THEN HaltHandler(code) END;*)
+ Heap.FINALL;
errstring("Terminated by Halt("); errint(code); errstring("). ");
IF code < 0 THEN DisplayHaltCode(code) END;
errstring(Platform.NL);
@@ -145,15 +319,13 @@ MODULE Modules; (* jt 6.1.96 *)
PROCEDURE AssertFail*(code: SYSTEM.INT32);
BEGIN
+ Heap.FINALL;
errstring("Assertion failure.");
IF code # 0 THEN errstring(" ASSERT code "); errint(code); errstring("."); END;
errstring(Platform.NL);
- Platform.Exit(code);
+ IF code > 0 THEN Platform.Exit(code) ELSE Platform.Exit(-1) END;
END AssertFail;
- (*
- PROCEDURE SetHalt*(p: HaltProcedure);
- BEGIN HaltHandler := p; END SetHalt;
- *)
-
+BEGIN
+ FindBinaryDir(BinaryDir);
END Modules.
diff --git a/src/runtime/Oberon.Mod b/src/runtime/Oberon.Mod
index fbc3abd4..c67dcf17 100644
--- a/src/runtime/Oberon.Mod
+++ b/src/runtime/Oberon.Mod
@@ -2,7 +2,7 @@ MODULE Oberon;
(* this version should not have dependency on graphics -- noch *)
- IMPORT Platform, Texts, Out;
+ IMPORT Platform, Modules, Texts, Out;
TYPE
ParList* = POINTER TO ParRec;
@@ -38,11 +38,11 @@ PROCEDURE PopulateParams;
BEGIN
Texts.OpenWriter(W);
i := 1; (* skip program name *)
- WHILE i < Platform.ArgCount DO
- Platform.GetArg(i, str); Texts.WriteString(W, str); Texts.Write(W, " ");
+ WHILE i < Modules.ArgCount DO
+ Modules.GetArg(i, str); Texts.WriteString(W, str); Texts.Write(W, " ");
INC(i)
END;
- Texts.Append (Par^.text, W.buf);
+ Texts.Append(Par^.text, W.buf);
END PopulateParams;
PROCEDURE GetSelection*(VAR text: Texts.Text; VAR beg, end, time: LONGINT);
diff --git a/src/runtime/Out.Mod b/src/runtime/Out.Mod
index 9564f275..8895037c 100644
--- a/src/runtime/Out.Mod
+++ b/src/runtime/Out.Mod
@@ -1,6 +1,9 @@
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;
+IMPORT SYSTEM, Platform, Heap;
VAR
IsConsole-: BOOLEAN;
@@ -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;
@@ -68,6 +74,21 @@ BEGIN
WHILE i > 0 DO DEC(i); Char(s[i]) END
END Int;
+
+PROCEDURE Hex*(x, n: HUGEINT);
+BEGIN
+ IF n < 1 THEN n := 1 ELSIF n > 16 THEN n := 16 END;
+ IF x >= 0 THEN
+ WHILE (n < 16) & (SYSTEM.LSH(x, -4*n) # 0) DO INC(n) END
+ END;
+ x := SYSTEM.ROT(x, 4*(16-n));
+ WHILE n > 0 DO
+ x := SYSTEM.ROT(x,4); DEC(n);
+ IF x MOD 16 < 10 THEN Char(CHR((x MOD 16) + ORD('0')))
+ 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;
@@ -89,6 +110,7 @@ BEGIN
END prepend;
+
PROCEDURE Ten*(e: INTEGER): LONGREAL;
VAR r, power: LONGREAL;
BEGIN r := 1.0D0; power := 1.0D1;
@@ -101,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 *)
@@ -196,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;
@@ -208,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 fa22d7ee..bcf11137 100644
--- a/src/runtime/Platformunix.Mod
+++ b/src/runtime/Platformunix.Mod
@@ -7,7 +7,6 @@ CONST
StdErr- = 2;
TYPE
- HaltProcedure = PROCEDURE(n: SYSTEM.INT32);
SignalHandler = PROCEDURE(signal: SYSTEM.INT32);
ErrorCode* = INTEGER;
@@ -19,21 +18,10 @@ TYPE
mtime: LONGINT; (* File modification time, value is system dependent *)
END;
- EnvPtr = POINTER TO ARRAY 1024 OF CHAR;
- ArgPtr = POINTER TO ARRAY 1024 OF CHAR;
- ArgVec = POINTER TO ARRAY 1024 OF ArgPtr;
- ArgVecPtr = POINTER TO ARRAY 1 OF SYSTEM.ADDRESS;
-
-
VAR
LittleEndian-: BOOLEAN;
- MainStackFrame-: SYSTEM.ADDRESS;
PID-: INTEGER; (* Note: Must be updated by Fork implementation *)
CWD-: ARRAY 256 OF CHAR;
- ArgCount-: INTEGER;
-
- ArgVector-: SYSTEM.ADDRESS;
- HaltHandler: HaltProcedure;
TimeStart: LONGINT;
SeekSet-: INTEGER;
@@ -56,6 +44,7 @@ PROCEDURE -Aincludeerrno '#include ';
PROCEDURE -Astdlib '#include ';
PROCEDURE -Astdio '#include ';
PROCEDURE -Aerrno '#include ';
+PROCEDURE -Alimits '#include ';
@@ -78,7 +67,6 @@ PROCEDURE -EINTR(): ErrorCode 'EINTR';
-
PROCEDURE TooManyFiles*(e: ErrorCode): BOOLEAN;
BEGIN RETURN (e = EMFILE()) OR (e = ENFILE()) END TooManyFiles;
@@ -107,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))";
@@ -118,72 +117,24 @@ PROCEDURE OSFree*(address: SYSTEM.ADDRESS); BEGIN free(address) END OSFree;
-(* Program startup *)
-
-PROCEDURE -ExternInitHeap "extern void Heap_InitHeap();";
-PROCEDURE -HeapInitHeap() "Heap_InitHeap()";
-
-PROCEDURE Init*(argc: SYSTEM.INT32; argvadr: SYSTEM.ADDRESS);
-VAR av: ArgVecPtr;
-BEGIN
- MainStackFrame := argvadr;
- ArgCount := SYSTEM.VAL(INTEGER, argc);
- av := SYSTEM.VAL(ArgVecPtr, argvadr);
- ArgVector := av[0];
-
- (* This function (Platform.Init) is called at program startup BEFORE any
- modules have been initalised. In turn we must initialise the heap
- before module startup (xxx__init) code is run. *)
- HeapInitHeap();
-END Init;
-
-
-
-
(* Program arguments and environment access *)
-PROCEDURE -getenv(var: ARRAY OF CHAR): EnvPtr "(Platform_EnvPtr)getenv((char*)var)";
+PROCEDURE -getenv(var: ARRAY OF CHAR): SYSTEM.ADDRESS "getenv((char*)var)";
PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN;
- VAR p: EnvPtr;
+TYPE EnvPtr = POINTER TO ARRAY 1024 OF CHAR;
+VAR p: EnvPtr;
BEGIN
- p := getenv(var);
+ p := SYSTEM.VAL(EnvPtr, getenv(var));
IF p # NIL THEN COPY(p^, val) END;
RETURN p # NIL;
END getEnv;
PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR);
BEGIN
- IF ~ getEnv(var, val) THEN val[0] := 0X END;
+ IF ~getEnv(var, val) THEN val[0] := 0X END;
END GetEnv;
-PROCEDURE GetArg*(n: INTEGER; VAR val: ARRAY OF CHAR);
- VAR av: ArgVec;
-BEGIN
- IF n < ArgCount THEN
- av := SYSTEM.VAL(ArgVec,ArgVector);
- COPY(av[n]^, val)
- END
-END GetArg;
-
-PROCEDURE GetIntArg*(n: INTEGER; VAR val: LONGINT);
- VAR s: ARRAY 64 OF CHAR; k, d, i: LONGINT;
-BEGIN
- s := ""; GetArg(n, s); i := 0;
- IF s[0] = "-" THEN i := 1 END ;
- k := 0; d := ORD(s[i]) - ORD("0");
- WHILE (d >= 0 ) & (d <= 9) DO k := k*10 + d; INC(i); d := ORD(s[i]) - ORD("0") END ;
- IF s[0] = "-" THEN k := -k; DEC(i) END ;
- IF i > 0 THEN val := k END
-END GetIntArg;
-
-PROCEDURE ArgPos*(s: ARRAY OF CHAR): INTEGER;
- VAR i: INTEGER; arg: ARRAY 256 OF CHAR;
-BEGIN
- i := 0; GetArg(i, arg);
- WHILE (i < ArgCount) & (s # arg) DO INC(i); GetArg(i, arg) END ;
- RETURN i
-END ArgPos;
@@ -483,7 +434,6 @@ PROCEDURE -getpid(): INTEGER "(INTEGER)getpid()";
BEGIN
TestLittleEndian;
- HaltHandler := NIL;
TimeStart := 0; TimeStart := Time();
PID := getpid();
IF getcwd(CWD) = NIL THEN CWD := "" END;
diff --git a/src/runtime/Platformwindows.Mod b/src/runtime/Platformwindows.Mod
index bde70184..63c90a69 100644
--- a/src/runtime/Platformwindows.Mod
+++ b/src/runtime/Platformwindows.Mod
@@ -8,7 +8,6 @@ IMPORT SYSTEM;
TYPE
- HaltProcedure = PROCEDURE(n: SYSTEM.INT32);
SignalHandler = PROCEDURE(signal: SYSTEM.INT32);
ErrorCode* = INTEGER;
@@ -22,22 +21,10 @@ TYPE
mtimelow: LONGINT; (* File modification time, value is system dependent *)
END;
- EnvPtr = POINTER TO ARRAY 1024 OF CHAR;
- ArgPtr = POINTER TO ARRAY 1024 OF CHAR;
- ArgVec = POINTER TO ARRAY 1024 OF ArgPtr;
- ArgVecPtr = POINTER TO ARRAY 1 OF SYSTEM.ADDRESS;
-
-
VAR
LittleEndian-: BOOLEAN;
- MainStackFrame-: SYSTEM.ADDRESS;
- HaltCode-: LONGINT;
PID-: INTEGER; (* Note: Must be updated by Fork implementation *)
CWD-: ARRAY 4096 OF CHAR;
- ArgCount-: INTEGER;
-
- ArgVector-: SYSTEM.ADDRESS;
- HaltHandler: HaltProcedure;
TimeStart: LONGINT;
SeekSet-: INTEGER;
@@ -48,8 +35,6 @@ VAR
StdOut-: FileHandle;
StdErr-: FileHandle;
- InterruptHandler: SignalHandler;
-
NL-: ARRAY 3 OF CHAR; (* Platform specific newline representation *)
@@ -106,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))";
@@ -117,29 +113,6 @@ PROCEDURE OSFree*(address: SYSTEM.ADDRESS); BEGIN free(address) END OSFree;
-(* Program startup *)
-
-PROCEDURE -ExternInitHeap "extern void Heap_InitHeap();";
-PROCEDURE -HeapInitHeap() "Heap_InitHeap()";
-
-PROCEDURE Init*(argc: SYSTEM.INT32; argvadr: SYSTEM.ADDRESS);
-VAR av: ArgVecPtr;
-BEGIN
- MainStackFrame := argvadr;
- ArgCount := SYSTEM.VAL(INTEGER, argc);
- av := SYSTEM.VAL(ArgVecPtr, argvadr);
- ArgVector := av[0];
- HaltCode := -128;
-
- (* This function (Platform.Init) is called at program startup BEFORE any
- modules have been initalised. In turn we must initialise the heap
- before module startup (xxx__init) code is run. *)
- HeapInitHeap();
-END Init;
-
-
-
-
(* Program arguments and environmet access *)
PROCEDURE -getenv(name: ARRAY OF CHAR; VAR buf: ARRAY OF CHAR): INTEGER
@@ -164,34 +137,6 @@ BEGIN
IF ~getEnv(var, val) THEN val[0] := 0X END;
END GetEnv;
-PROCEDURE GetArg*(n: INTEGER; VAR val: ARRAY OF CHAR);
- VAR av: ArgVec;
-BEGIN
- IF n < ArgCount THEN
- av := SYSTEM.VAL(ArgVec,ArgVector);
- COPY(av[n]^, val)
- END
-END GetArg;
-
-PROCEDURE GetIntArg*(n: INTEGER; VAR val: LONGINT);
- VAR s: ARRAY 64 OF CHAR; k, d, i: LONGINT;
-BEGIN
- s := ""; GetArg(n, s); i := 0;
- IF s[0] = "-" THEN i := 1 END ;
- k := 0; d := ORD(s[i]) - ORD("0");
- WHILE (d >= 0 ) & (d <= 9) DO k := k*10 + d; INC(i); d := ORD(s[i]) - ORD("0") END ;
- IF s[0] = "-" THEN k := -k; DEC(i) END ;
- IF i > 0 THEN val := k END
-END GetIntArg;
-
-PROCEDURE ArgPos*(s: ARRAY OF CHAR): INTEGER;
- VAR i: INTEGER; arg: ARRAY 256 OF CHAR;
-BEGIN
- i := 0; GetArg(i, arg);
- WHILE (i < ArgCount) & (s # arg) DO INC(i); GetArg(i, arg) END ;
- RETURN i
-END ArgPos;
-
@@ -300,13 +245,13 @@ PROCEDURE Error*(): ErrorCode; BEGIN RETURN err() END Error;
PROCEDURE -invalidHandleValue(): SYSTEM.ADDRESS "((ADDRESS)INVALID_HANDLE_VALUE)";
PROCEDURE -openrw (n: ARRAY OF CHAR): FileHandle
-"(ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)";
+"(ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE|FILE_SHARE_DELETE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)";
PROCEDURE -openro (n: ARRAY OF CHAR): FileHandle
-"(ADDRESS)CreateFile((char*)n, GENERIC_READ , FILE_SHARE_READ|FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)";
+"(ADDRESS)CreateFile((char*)n, GENERIC_READ , FILE_SHARE_READ|FILE_SHARE_WRITE|FILE_SHARE_DELETE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)";
PROCEDURE -opennew(n: ARRAY OF CHAR): FileHandle
-"(ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)";
+"(ADDRESS)CreateFile((char*)n, GENERIC_READ|GENERIC_WRITE, FILE_SHARE_READ|FILE_SHARE_WRITE|FILE_SHARE_DELETE, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)";
@@ -559,8 +504,6 @@ PROCEDURE -getpid(): INTEGER "(INTEGER)GetCurrentProcessId()";
BEGIN
TestLittleEndian;
- HaltCode := -128;
- HaltHandler := NIL;
TimeStart := 0; TimeStart := Time();
CWD := ""; getCurrentDirectory(CWD);
PID := getpid();
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 43baa836..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
@@ -237,7 +243,7 @@ static inline double SYSTEM_ABSD(double i) {return i >= 0.0 ? i : -i;}
#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r))))
#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p)))
#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p)
-#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p)
+#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*((typ*)p)
@@ -258,10 +264,15 @@ extern void Heap_INCREF();
// Main module initialisation, registration and finalisation
-extern void Platform_Init(INT32 argc, ADDRESS argv);
+extern void Modules_Init(INT32 argc, ADDRESS argv);
extern void Heap_FINALL();
-#define __INIT(argc, argv) static void *m; Platform_Init(argc, (ADDRESS)&argv);
+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 305b225d..aba83032 100644
--- a/src/runtime/Texts.Mod
+++ b/src/runtime/Texts.Mod
@@ -120,7 +120,6 @@ MODULE Texts; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91**
del: Buffer;
FontsDefault: FontsFont;
-
PROCEDURE FontsThis(VAR name: ARRAY OF CHAR): FontsFont;
VAR F: FontsFont;
BEGIN
@@ -340,8 +339,8 @@ MODULE Texts; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91**
IF u IS Piece THEN Files.Read(R.rider, ch); R.elem := NIL;
IF (ch = 0AX) & u(Piece).ascii THEN ch := CR (* << LF to CR *)
ELSIF (ch = CR) & u(Piece).ascii THEN (* << CR LF to CR *)
- pos := Files.Pos(R.rider); Files.Read(R.rider, nextch);
- IF nextch = 0AX THEN INC(R.off) ELSE Files.Set(R.rider, u(Piece).file, pos) END
+ pos := Files.Pos(R.rider); Files.Read(R.rider, nextch);
+ IF nextch = 0AX THEN INC(R.off) ELSE Files.Set(R.rider, u(Piece).file, pos) END
END
ELSIF u IS Elem THEN ch := ElemChar; R.elem := u(Elem)
ELSE ch := 0X; R.elem := NIL; R.eot := TRUE
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/arrayassignment/aa.mod b/src/test/confidence/arrayassignment/aa.mod
index 145824e8..e5ac2db0 100644
--- a/src/test/confidence/arrayassignment/aa.mod
+++ b/src/test/confidence/arrayassignment/aa.mod
@@ -19,8 +19,5 @@ BEGIN
COPY(a30, a10); Console.String("a10: "); Console.String(a10); Console.Ln;
Console.String("a20: "); Console.String(a20); Console.Ln;
Console.Ln;
- a10 := a30; Console.String("a10: "); Console.String(a10); Console.Ln;
- Console.String("a20: "); Console.String(a20); Console.Ln;
- Console.Ln;
Console.String("Array assignment test complete."); Console.Ln;
END aa.
diff --git a/src/test/confidence/arrayassignment/expected b/src/test/confidence/arrayassignment/expected
index 7ca85cf2..753916be 100644
--- a/src/test/confidence/arrayassignment/expected
+++ b/src/test/confidence/arrayassignment/expected
@@ -4,7 +4,4 @@ a20: 1st 10 ch 2nd 10 ch
a10: 1st 10 ch
a20: 1st 10 ch 2nd 10 ch
-a10: 1st 10 ch
-a20: 1st 10 ch 2nd 10 ch
-
Array assignment test complete.
diff --git a/src/test/confidence/intsyntax/expected b/src/test/confidence/intsyntax/expected
index 1abe43f9..ce0633c4 100644
--- a/src/test/confidence/intsyntax/expected
+++ b/src/test/confidence/intsyntax/expected
@@ -1,15 +1,15 @@
-IntSyntax.mod compiling IntSyntax.
+IntSyntax.mod Compiling IntSyntax.
14: i := l; (* Bad, INTEGER shorter than LONGINT *)
- ^
- pos 341 err 113 incompatible assignment
+ ^
+ pos 340 err 113 incompatible assignment
15: s := l; (* Bad, SHORTINT shorter than LONGINT *)
- ^
- pos 393 err 113 incompatible assignment
+ ^
+ pos 392 err 113 incompatible assignment
16: i := l; (* Bad, SHORTINT shorter than INTEGER *)
- ^
- pos 446 err 113 incompatible assignment
+ ^
+ pos 445 err 113 incompatible assignment
Module compilation failed.
diff --git a/src/test/confidence/lola/lola.Mod b/src/test/confidence/lola/lola.Mod
index eccebbfd..8f7faaa3 100644
--- a/src/test/confidence/lola/lola.Mod
+++ b/src/test/confidence/lola/lola.Mod
@@ -1,7 +1,7 @@
MODULE Lola; (* Command line runner for Lola to verilog compilation *)
- IMPORT LSB, LSC, LSV, Platform, Console;
+ IMPORT LSB, LSC, LSV, Modules, Console;
BEGIN
- IF Platform.ArgCount < 3 THEN
+ IF Modules.ArgCount < 3 THEN
Console.String("Lola - compile lola source to verilog source."); Console.Ln; Console.Ln;
Console.String("usage:"); Console.Ln; Console.Ln;
Console.String(" lola lola-source-file verilog-source-file"); Console.Ln; Console.Ln;
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/planned-binary-change b/src/test/confidence/planned-binary-change
index d7a05d09..9135bbd2 100644
--- a/src/test/confidence/planned-binary-change
+++ b/src/test/confidence/planned-binary-change
@@ -1 +1 @@
-18 Oct 2016 18:12:01
+18 Dec 2016 16:55:53
diff --git a/src/test/confidence/signal/signal.mod b/src/test/confidence/signal/signal.mod
index 3a897392..294345f2 100644
--- a/src/test/confidence/signal/signal.mod
+++ b/src/test/confidence/signal/signal.mod
@@ -1,6 +1,6 @@
(* Test that interrupt and quit are handled correctly. *)
MODULE SignalTest;
-IMPORT Console, Platform, Files, SYSTEM;
+IMPORT Console, Platform, Modules, Files, SYSTEM;
VAR result: Files.File; rider: Files.Rider;
@@ -42,7 +42,7 @@ END Take5;
BEGIN
result := Files.New("result");
Files.Set(rider, result, 0);
- IF Platform.ArgCount > 1 THEN
+ IF Modules.ArgCount > 1 THEN
Platform.SetInterruptHandler(handle);
Platform.SetQuitHandler(handle)
END;
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/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--";
+\n";
+close $svg;
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/beautifier/makefile b/src/tools/beautifier/makefile
new file mode 100644
index 00000000..2108b547
--- /dev/null
+++ b/src/tools/beautifier/makefile
@@ -0,0 +1,4 @@
+VOC = /opt/voc/bin/voc
+
+all:
+ $(VOC) -m vbeautify.Mod
diff --git a/src/tools/beautifier/vbeautify.Mod b/src/tools/beautifier/vbeautify.Mod
new file mode 100644
index 00000000..ef38edba
--- /dev/null
+++ b/src/tools/beautifier/vbeautify.Mod
@@ -0,0 +1,758 @@
+MODULE vbeautify;
+
+IMPORT Oberon, Out, Strings, Texts;
+
+CONST
+ Tab = 09X; LF = 0DX;
+ SK = 0; (* Section - Keyword *)
+ IK = 1; (* Indent Keyword *)
+ IEK = 2; (* Indent ending Keyword *)
+ IBK = 3; (* Indent breaking Keyword *)
+ NK = -1; (* No keyword -- used when end of text is reached*)
+ TwoCharOp = 0; SpcAfterOnly = 1; SpcAllOps = 2;
+
+TYPE
+ Keyword = RECORD
+ word: ARRAY 10 OF CHAR;
+ class: SHORTINT
+ END;
+
+VAR
+ w: Texts.Writer;
+ b: Texts.Buffer;
+ fC, lC: ARRAY 23 OF INTEGER;
+ hashT: ARRAY 51 OF Keyword;
+
+PROCEDURE (VAR k: Keyword) Init (s: ARRAY (*10*) OF CHAR; class: SHORTINT);
+BEGIN
+ COPY(s, k.word);
+ k.class := class
+END Init;
+
+PROCEDURE passComments (VAR s: Texts.Reader);
+ VAR cmt: INTEGER; ch: CHAR;
+BEGIN
+ cmt := 1;
+ WHILE ~s.eot & (cmt > 0) DO
+ Texts.Read(s, ch);
+ WHILE ch = "(" DO Texts.Read(s, ch); IF ch = "*" THEN INC(cmt) END END; (* Nested comment opening *)
+ WHILE ch = "*" DO Texts.Read(s, ch); IF ch = ")" THEN DEC(cmt) END END (* comment closing *)
+ END
+END passComments;
+
+PROCEDURE passProcHead (VAR s: Texts.Scanner; bText: Texts.Text; VAR noProc: BOOLEAN; VAR procName: ARRAY OF CHAR);
+ VAR ch: CHAR;
+BEGIN
+ noProc := FALSE;
+ Texts.Scan(s);
+ (* --- Type-bound procedures can have Receiver *)
+ WHILE ~s.eot & (s.class = Texts.Char) & (s.c = Texts.ElemChar) DO Texts.Scan(s) END;
+ IF (s.class = Texts.Char) & (s.c = "(") THEN
+ REPEAT Texts.Scan(s) UNTIL (s.class = Texts.Char) & (s.c = ")") OR s.eot;
+ Texts.Scan(s)
+ END;
+ WHILE ~s.eot & (s.class = Texts.Char) & (s.c = Texts.ElemChar) DO Texts.Scan(s) END;
+ (* --- Check name of procedure *)
+ IF s.class # Texts.Name THEN noProc := TRUE; RETURN END;
+ COPY(s.s, procName);
+ (* --- Formal parameters *)
+ Texts.OpenScanner(s, bText, Texts.Pos(s) - 1);
+ Texts.Read(s, ch);
+ WHILE ~s.eot & (ch # ";") DO
+ IF ch = "(" THEN
+ WHILE ~s.eot & (ch # ")") DO Texts.Read(s, ch) END
+ ELSE
+ Texts.Read(s, ch)
+ END
+ END
+END passProcHead;
+(*
+PROCEDURE MarkedViewer (): TextFrames.Frame;
+ VAR v: Viewers.Viewer;
+BEGIN
+ v := Oberon.MarkedViewer();
+ IF (v # NIL) & (v.dsc # NIL) & (v.dsc.next IS TextFrames.Frame) THEN
+ RETURN v.dsc.next(TextFrames.Frame)
+ ELSE
+ RETURN NIL
+ END
+END MarkedViewer;
+*)
+PROCEDURE NoNotify (t: Texts.Text; op: INTEGER; beg, end: LONGINT); END NoNotify;
+
+PROCEDURE ParseCmdLine (VAR bText: Texts.Text; VAR oldNotifier: Texts.Notifier);
+VAR
+ beg, end, time: LONGINT;
+ (*f: TextFrames.Frame;*)
+ par: Oberon.ParList;
+ s: Texts.Scanner;
+ t: Texts.Text;
+(*
+PROCEDURE OpenText (fileName: ARRAY OF CHAR; VAR t: Texts.Text; VAR f: TextFrames.Frame);
+ VAR menuF: TextFrames.Frame; v: Viewers.Viewer; x, y: INTEGER;
+BEGIN
+ menuF := TextFrames.NewMenu(fileName, "Edit.Store System.Close");
+ t := TextFrames.Text(fileName);
+ f := TextFrames.NewText(t, 0);
+ Oberon.AllocateUserViewer(0, x, y);
+ v := MenuViewers.New(menuF, f, TextFrames.menuH, x, y)
+END OpenText;
+*)
+PROCEDURE OpenText (fileName: ARRAY OF CHAR; VAR t: Texts.Text);
+BEGIN
+ NEW(t);
+ Texts.Open(t, fileName);
+
+END OpenText;
+BEGIN
+ oldNotifier := NIL; par := Oberon.Par;
+ Texts.OpenScanner(s, par.text, par.pos);
+ Texts.Scan(s);
+ IF s.class = Texts.Name THEN (* Called by filename *)
+ (*OpenText(s.s, bText, f)*)
+ OpenText(s.s, bText)
+ (*
+ ELSIF (s.class = Texts.Char) & (s.c = "*") THEN (* Called by selected viewer *)
+ f := MarkedViewer()
+ ELSIF (s.class = Texts.Char) & (s.c = "^") THEN (* Called by selection *)
+ Oberon.GetSelection(t, beg, end, time);
+ IF time >= 0 THEN (* Selection found *)
+ Texts.OpenScanner(s, t, beg); Texts.Scan(s);
+ IF s.class = Texts.Name THEN
+ OpenText(s.s, bText, f)
+ END
+ END
+ *) (* commented out oberon system specific parts. -- noch *)
+ END;
+ (*IF f # NIL THEN
+ bText := f.text;
+ oldNotifier := f.text.notify;
+ bText.notify := NoNotify
+ ELSE
+ Out.String("Could not find TextFrames.Frame. Program aborted."); Out.Ln;
+ HALT(99)
+ END*)
+END ParseCmdLine;
+(*
+PROCEDURE GetFontsFromText (bText: Texts.Text; VAR expNamFnt, cmtFnt: Fonts.Font);
+VAR
+ r: Texts.Reader;
+ ch: CHAR;
+ boldfont, italicfont: ARRAY 32 OF CHAR;
+ i: INTEGER;
+BEGIN
+ (* --- Get the fontname *)
+ Texts.OpenReader(r, bText, 0);
+ Texts.Read(r, ch);
+ COPY(r.fnt.name, boldfont);
+ COPY(r.fnt.name, italicfont);
+
+ (* --- Get fonts *)
+ i := Strings.Pos(".", boldfont, 0);
+ Strings.Insert("b", i, boldfont);
+ expNamFnt := Fonts.This(boldfont);
+ Strings.Insert("i", i, italicfont);
+ cmtFnt := Fonts.This(italicfont)
+END GetFontsFromText;
+*)
+PROCEDURE UpdateText (bText: Texts.Text; oldNotifier: Texts.Notifier);
+BEGIN
+ IF oldNotifier # NIL THEN
+ bText.notify := oldNotifier;
+ bText.notify(bText, Texts.replace, 0, bText.len)
+ END
+END UpdateText;
+
+PROCEDURE getKeyword (t: Texts.Text; VAR s: Texts.Scanner; section: BOOLEAN): SHORTINT;
+ VAR i, firstC, lastC: INTEGER; pos: LONGINT; noProc: BOOLEAN; dummy: ARRAY 32 OF CHAR;
+BEGIN
+ WHILE ~s.eot DO
+ Texts.Scan(s);
+ IF s.class = Texts.Name THEN
+ (* --- hash value calculation *)
+ firstC := ORD(s.s[0]) - ORD('A');
+ lastC := ORD(s.s[s.len - 1]) - ORD('A');
+ IF (firstC >= 0) & (firstC < 23) & (lastC < 23) & (lastC >= 0) THEN
+ i := (fC[firstC] + 11 * lC[lastC]) MOD 51;
+ IF (i # 17) & (i # 35) & (i # 4) & (hashT[i].word = s.s) THEN
+ RETURN hashT[i].class
+ ELSIF (i = 35) & (s.nextCh = LF) & (s.s = "VAR") THEN
+ RETURN IBK
+ ELSIF (i = 4) & (s.s = "BEGIN") THEN
+ IF section THEN RETURN IBK ELSE RETURN IK END
+ ELSIF (i = 17) THEN
+ passProcHead(s, t, noProc, dummy);
+ IF ~noProc THEN RETURN hashT[i].class END
+ END
+ END
+ ELSIF (s.class = Texts.Char) THEN
+ IF (s.c = "|") THEN RETURN IBK END;
+ IF (s.c = "(") & (s.nextCh = "*") THEN Texts.Scan(s); passComments(s) END
+ END
+ END;
+ RETURN NK
+END getKeyword;
+
+PROCEDURE InsertInd (VAR r: Texts.Reader; VAR s: Texts.Scanner; t: Texts.Text; ind: SHORTINT; decInd: BOOLEAN);
+VAR
+ ch, ch2: CHAR;
+ lastLF, sPos: LONGINT;
+ i: INTEGER;
+BEGIN
+ FOR i := 1 TO ind DO Texts.Write(w, Tab) END;
+ sPos := Texts.Pos(s);
+ lastLF := - 1;
+ (* --- Trace reader to position of Scanner *)
+ WHILE (Texts.Pos(r) + 1 < sPos) & ~r.eot DO
+ Texts.Read(r, ch); Texts.Read(r, ch2); IF ~r.eot THEN Texts.OpenReader(r, t, Texts.Pos(r) - 1); END;
+ IF (ch = LF) & (ch2 # LF) & (ind > 0) THEN
+ lastLF := Texts.Pos(r);
+ sPos := sPos + ind;
+ Texts.Copy(w.buf, b);
+ Texts.Insert(t, lastLF, b);
+ Texts.OpenReader(r, t, lastLF + ind)
+ END
+ END;
+ Texts.OpenBuf(w.buf); (* Flush buffer *)
+ Texts.OpenScanner(s, t, sPos);
+ (* --- Check if we have to move the last line one tab position to the left *)
+ IF decInd & (lastLF # - 1) THEN
+ Texts.Delete(t, lastLF, lastLF + 1);
+ Texts.OpenScanner(s, t, Texts.Pos(s) - 1);
+ Texts.OpenReader(r, t, Texts.Pos(r) - 1)
+ END
+END InsertInd;
+
+PROCEDURE IndentCheck (bText: Texts.Text);
+VAR
+ r: Texts.Reader; s: Texts.Scanner; ch: CHAR; ind, i: SHORTINT; pos: LONGINT; section: BOOLEAN; leadStart, trailStart: LONGINT;
+BEGIN
+ (* --- Kill leading and trailing Tabs/Blanks *)
+ pos := 0;
+ Texts.OpenReader(r, bText, pos);
+ Texts.Read(r, ch);
+ trailStart := 0;
+ WHILE (~r.eot) DO
+ IF ch = LF THEN
+ leadStart := Texts.Pos(r);
+ Texts.Read(r, ch);
+ WHILE (ch = " ") OR (ch = Tab) DO Texts.Read(r, ch) END;
+ pos := Texts.Pos(r) - 1;
+ Texts.Delete(bText, leadStart, pos);
+ Texts.OpenReader(r, bText, leadStart + 1)
+ ELSE
+ WHILE (ch # LF) & ~r.eot DO
+ IF (ch = " ") OR (ch = Tab) THEN
+ IF trailStart = - 1 THEN trailStart := Texts.Pos(r) - 1 END
+ ELSE
+ trailStart := - 1
+ END;
+ Texts.Read(r, ch)
+ END;
+ IF trailStart > - 1 THEN
+ pos := Texts.Pos(r) - 1;
+ Texts.Delete(bText, trailStart, pos);
+ Texts.OpenReader(r, bText, trailStart + 1);
+ trailStart := - 1
+ END
+ END
+ END;
+
+ (* --- Insert correct tabulation *)
+ Texts.OpenScanner(s, bText, 0);
+ Texts.OpenReader(r, bText, 0);
+ Texts.Scan(s);
+ section := FALSE;
+ ind := 0;
+ WHILE ~s.eot & (ind >= 0) DO
+ i := getKeyword(bText, s, section);
+ IF i = IK THEN
+ InsertInd(r, s, bText, ind, FALSE);
+ INC(ind)
+ ELSIF i = IEK THEN
+ InsertInd(r, s, bText, ind, TRUE);
+ DEC(ind);
+ IF ind = 0 THEN section := FALSE END
+ ELSIF i = IBK THEN
+ InsertInd(r, s, bText, ind, TRUE)
+ ELSIF i = SK THEN
+ InsertInd(r, s, bText, ind, section);
+ IF ~section THEN INC(ind) END;
+ section := TRUE
+ END
+ END
+END IndentCheck;
+(*
+PROCEDURE ChangeFont (bText: Texts.Text; expNamFnt, cmtFnt: Fonts.Font);
+VAR
+ s: Texts.Scanner; ch: CHAR; oPos, pos: LONGINT; exp: BOOLEAN; noExpLine: INTEGER;
+BEGIN
+ pos := 0; noExpLine := -1;
+ exp := TRUE;
+ Texts.OpenScanner(s, bText, pos);
+ WHILE ~s.eot DO
+ Texts.Scan(s);
+ oPos := pos;
+ pos := Texts.Pos(s);
+ IF (s.class = Texts.Char) & (s.c = "(") & (s.nextCh = "*") THEN (* comment *)
+ oPos := pos;
+ Texts.Scan(s);
+ passComments(s);
+ pos := Texts.Pos(s);
+ Texts.ChangeLooks(bText, oPos - 2, pos, {0}, cmtFnt, s.col, s.voff);
+ Texts.OpenScanner(s, bText, pos)
+ ELSIF (s.class = Texts.Char) & ((s.c = "=") OR (s.c = ":")) THEN
+ noExpLine := s.line;
+ ELSIF (s.class = Texts.Char) & (s.c = ";") THEN
+ noExpLine := -1;
+ ELSIF (s.class = Texts.Name) THEN
+ IF (s.s = "BEGIN") THEN exp := FALSE
+ ELSIF (s.s = "PROCEDURE") THEN exp := TRUE
+ ELSIF exp & (noExpLine # s.line) & (s.nextCh = " ") THEN (* probably spaces between name and '*' *)
+ Texts.Read(s, ch);
+ WHILE ~s.eot & (ch = " ") DO Texts.Read(s, ch) END;
+ IF (ch = "*") OR (ch = "-") THEN
+ Texts.Delete(bText, pos - 1, Texts.Pos(s) - 1);
+ Texts.ChangeLooks(bText, oPos, pos, {0}, expNamFnt, s.col, s.voff);
+ Texts.OpenScanner(s, bText, pos)
+ ELSE (* rewind *)
+ Texts.OpenScanner(s, bText, Texts.Pos(s) - 1)
+ END
+ ELSIF exp & (noExpLine # s.line) & ((s.nextCh = "*") OR (s.nextCh = "-")) THEN (* "regular" exported name *)
+ Texts.ChangeLooks(bText, oPos - 1, pos, {0}, expNamFnt, s.col, s.voff);
+ Texts.OpenScanner(s, bText, pos)
+ END
+ END
+ END
+END ChangeFont;
+*)
+PROCEDURE Format*;
+VAR
+ bText: Texts.Text; oldNotifier: Texts.Notifier;(* expNamFnt, cmtFnt: Fonts.Font;*)
+BEGIN
+ bText := NIL; oldNotifier := NIL;
+ ParseCmdLine(bText, oldNotifier);
+ IF bText = NIL THEN
+ (*Out.String("Usage: Beautifier.Format * | ^ | Filename.Mod"); Out.Ln*)
+ Out.String("Usage: vbeautify Filename.Mod"); Out.Ln
+ ELSE
+ (*GetFontsFromText(bText, expNamFnt, cmtFnt);
+ FoldElems.ExpandAll(bText, 0, TRUE);
+ ChangeFont(bText, expNamFnt, cmtFnt);*)
+ IndentCheck(bText);
+ (*FoldElems.CollapseAll(bText, {FoldElems.tempLeft});*)
+ UpdateText(bText, oldNotifier)
+ END
+END Format;
+
+
+PROCEDURE RemSemicolons (bText: Texts.Text);
+ VAR s: Texts.Scanner; lastSC, pos: LONGINT; eCount: INTEGER; err: BOOLEAN; procName: ARRAY 24 OF CHAR;
+ i: INTEGER;
+BEGIN
+ lastSC := - 1; eCount := 0;
+ Texts.OpenScanner(s, bText, 0);
+ Texts.Scan(s);
+ WHILE ~s.eot DO
+ IF (s.class = Texts.Char) THEN
+ IF (s.c = ';') THEN
+ lastSC := Texts.Pos(s) - 1;
+ Texts.Scan(s)
+ END
+ END;
+ IF (s.c = "(") & (s.nextCh = "*") THEN
+ Texts.Scan(s);
+ passComments(s); Texts.Scan(s)
+ END;
+
+ IF (s.class = Texts.Name) THEN
+ (* --- delete semicolons *)
+ IF (lastSC # - 1) & (eCount > 0) & ((s.s = "END") OR (s.s = "ELSE") OR (s.s = "ELSIF") OR (s.s = "UNTIL")) THEN
+ pos := Texts.Pos(s);
+ Texts.Delete(bText, lastSC - 1, lastSC);
+ Texts.OpenScanner(s, bText, pos - 1)
+ END;
+ IF (s.s = "IF") OR (s.s = "WHILE") OR (s.s = "FOR") OR (s.s = "RECORD") OR (s.s = "WITH") OR (s.s = "LOOP") OR (s.s = "CASE") THEN
+ INC(eCount)
+ ELSIF (s.s = "END") THEN
+ DEC(eCount)
+ END;
+ IF (s.s = "PROCEDURE") THEN
+ passProcHead(s, bText, err, procName);
+ IF ~err THEN INC(eCount) END
+ END
+ END;
+ lastSC := - 1;
+ Texts.Scan(s)
+ END
+END RemSemicolons;
+
+PROCEDURE RemoveSemicolons*;
+ VAR bText: Texts.Text; oldNotifier: Texts.Notifier;
+BEGIN
+ ParseCmdLine(bText, oldNotifier);
+ IF bText = NIL THEN
+ Out.String("Usage: Beautifier.RemSemicolons * | ^ | Filename.Mod"); Out.Ln
+ ELSE
+ (*FoldElems.ExpandAll(bText, 0, TRUE);*)
+ RemSemicolons(bText);
+ (*FoldElems.CollapseAll(bText, {FoldElems.tempLeft});*)
+ UpdateText(bText, oldNotifier)
+ END
+END RemoveSemicolons;
+
+
+PROCEDURE FoldProcedures (bText: Texts.Text);
+ VAR s: Texts.Scanner; start, end: LONGINT; procName: ARRAY 24 OF CHAR; err: BOOLEAN; ch: CHAR; (*e: FoldElems.Elem;*) te: Texts.Elem;
+BEGIN
+ Texts.OpenScanner(s, bText, 0);
+ Texts.Scan(s);
+ WHILE ~s.eot DO
+ IF(s.class = Texts.Name) & (s.s = "PROCEDURE") THEN (* FoldProcedures *)
+ passProcHead(s, bText, err, procName);
+ IF ~err THEN
+ start := Texts.Pos(s);
+ (* --- Read to end of line *)
+ Texts.Read(s, ch);
+ WHILE (ch # LF) & ((s.elem = NIL)(* OR ~(s.elem IS FoldElems.Elem)*)) DO Texts.Read(s, ch) END;
+ te := s.elem;
+
+ (* --- find end of procedure *)
+ Texts.OpenScanner(s, bText, start);
+ Texts.Scan(s);
+ end := - 1;
+ WHILE ~s.eot & (end = - 1) DO
+ IF (s.class = Texts.Name) & (s.s = "END") THEN Texts.Scan(s);
+ IF (s.class = Texts.Name) & (s.s = procName) THEN end := Texts.Pos(s) END
+ ELSE
+ Texts.Scan(s)
+ END
+ END;
+
+ (* --- Check, whether Procedure has not yet been folded *)
+ (*IF (te = NIL) OR ~(te IS FoldElems.Elem) THEN
+ (* --- Insert FoldElems *)
+ NEW(e); e.mode := FoldElems.expRight; e.W := FoldElems.elemW; e.H := FoldElems.elemH;
+ e.handle := FoldElems.FoldHandler; e.visible := TRUE; Texts.WriteElem(w, e); Texts.Insert(bText, end, w.buf);
+ NEW(e); e.mode := FoldElems.expLeft; e.W := FoldElems.elemW; e.H := FoldElems.elemH;
+ e.handle := FoldElems.FoldHandler; NEW(e.hidden); Texts.OpenBuf(e.hidden); e.visible := TRUE;
+ Texts.WriteElem(w, e); Texts.Insert(bText, start, w.buf);
+ Texts.OpenScanner(s, bText, end)
+ END*)
+ END
+ ELSIF (s.class = Texts.Name) & (s.s = "BEGIN") THEN (* Fold Module-Body *)
+ start := Texts.Pos(s) - 1;
+ Texts.OpenReader(s, bText, start);
+ (* --- Read to end of line *)
+ Texts.Read(s, ch);
+ WHILE (ch # LF) & ((s.elem = NIL)(* OR ~(s.elem IS FoldElems.Elem)*)) DO Texts.Read(s, ch) END;
+ te := s.elem;
+
+ (* --- Find end of Module *)
+ WHILE ~s.eot DO
+ Texts.Scan(s);
+ WHILE ~s.eot & (s.class = Texts.Name) & (s.s = "END") DO
+ end := Texts.Pos(s) - 5;
+ Texts.Scan(s)
+ END
+ END;
+ (* --- Check, whether Procedure has not yet been folded *)
+ (*IF (te = NIL) OR ~(te IS FoldElems.Elem) THEN
+ (* --- Insert FoldElems *)
+ NEW(e); e.mode := FoldElems.expRight; e.W := FoldElems.elemW; e.H := FoldElems.elemH;
+ e.handle := FoldElems.FoldHandler; e.visible := TRUE; Texts.WriteElem(w, e); Texts.Insert(bText, end, w.buf);
+ NEW(e); e.mode := FoldElems.expLeft; e.W := FoldElems.elemW; e.H := FoldElems.elemH;
+ e.handle := FoldElems.FoldHandler; NEW(e.hidden); Texts.OpenBuf(e.hidden); e.visible := TRUE;
+ Texts.WriteElem(w, e); Texts.Insert(bText, start, w.buf);
+ Texts.OpenScanner(s, bText, end)
+ END*)
+ ELSIF (s.class = Texts.Char) & (s.c = "(") & (s.nextCh = "*") THEN
+ passComments(s)
+ END;
+ Texts.Scan(s)
+ END
+END FoldProcedures;
+
+PROCEDURE FoldProc*;
+ VAR bText: Texts.Text; oldNotifier: Texts.Notifier;
+BEGIN
+ ParseCmdLine(bText, oldNotifier);
+ IF bText = NIL THEN
+ Out.String("Usage: Beautifier.FoldProc * | ^ | Filename.Mod"); Out.Ln
+ ELSE
+ (*FoldElems.ExpandAll(bText, 0, TRUE);*)
+ FoldProcedures(bText);
+ (*FoldElems.CollapseAll(bText, {FoldElems.tempLeft});*)
+ UpdateText(bText, oldNotifier)
+ END
+END FoldProc;
+
+PROCEDURE ReadOperator (VAR r: Texts.Reader; VAR buf: ARRAY OF CHAR; VAR opFlags: SET);
+ VAR i, cmt: INTEGER; ch, ech: CHAR; opFound: BOOLEAN;
+BEGIN
+ opFound := FALSE;
+ EXCL(opFlags, TwoCharOp); EXCL(opFlags, SpcAfterOnly);
+
+ Texts.Read(r, ch);
+ WHILE ~r.eot & ~opFound DO
+ (* --- Move buffer content *)
+ FOR i := 0 TO 7 DO buf[i] := buf[i + 1] END;
+ buf[8] := ch;
+
+ (* --- Leave out comments *)
+ WHILE ~r.eot & (ch = "(") DO
+ Texts.Read(r, ch);
+ IF (ch = "*") THEN
+ passComments(r); Texts.Read(r, ch)
+ END
+ END;
+
+ (* --- Leave out String and Character constants *)
+ IF (ch = "'") OR (ch = '"') THEN
+ REPEAT
+ Texts.Read(r, ech)
+ UNTIL r.eot OR (ch = ech)
+ END;
+
+ (* --- Check for spcAllOps & Spacing of parameter lists *)
+ IF (buf = "PROCEDURE") THEN
+ EXCL(opFlags, SpcAllOps)
+
+ END;
+ IF (buf[4] = "B") & (buf[5] = "E") & (buf[6] = "G") & (buf[7] = "I") & (buf[8] = "N") THEN INCL(opFlags, SpcAllOps) END;
+
+ (* --- Check for Operators *)
+ IF (ch = "<") OR (ch = ">") OR (ch = ":") THEN
+ opFound := TRUE;
+ INCL(opFlags, TwoCharOp)
+ ELSIF (ch = "+") OR ((SpcAllOps IN opFlags) & ((ch = "-") OR (ch = "*")) ) OR (ch = "/") OR (ch = "=") OR (ch = "#") OR (ch = "&") THEN
+ opFound := TRUE
+ ELSIF (ch = ";") OR (ch = ",") THEN
+ opFound := TRUE;
+ INCL(opFlags, SpcAfterOnly)
+ END;
+
+ Texts.Read(r, ch)
+ END;
+
+ IF opFound THEN
+ FOR i := 0 TO 7 DO buf[i] := buf[i + 1] END;
+ buf[8] := ch;
+ IF (TwoCharOp IN opFlags) & (ch = "=") THEN
+ FOR i := 0 TO 7 DO buf[i] := buf[i + 1] END;
+ Texts.Read(r, ch); buf[8] := ch
+ ELSE
+ EXCL(opFlags, TwoCharOp);
+ IF buf[7] = ":" THEN INCL(opFlags, SpcAfterOnly) END
+ END
+ END
+END ReadOperator;
+
+PROCEDURE SpaceOperators (bText: Texts.Text);
+ VAR r: Texts.Reader; opFlags: SET; buffer: ARRAY 10 OF CHAR; ch: CHAR; pos: LONGINT;
+
+PROCEDURE InsertSpace (pos: LONGINT);
+BEGIN
+ Texts.Write(w, " ");
+ Texts.Insert(bText, pos, w.buf);
+ Texts.OpenReader(r, bText, pos)
+END InsertSpace;
+
+BEGIN
+ Texts.OpenReader(r, bText, 0);
+ COPY(" ", buffer);
+ ReadOperator(r, buffer, opFlags);
+ WHILE ~r.eot DO
+ pos := Texts.Pos(r);
+ IF TwoCharOp IN opFlags THEN
+ IF (buffer[8] # " ") THEN InsertSpace(pos - 1) END;
+ IF (buffer[5] # " ") THEN InsertSpace(pos - 3) END
+ ELSE
+ IF SpcAfterOnly IN opFlags THEN
+ IF (buffer[8] # " ") & (buffer[8] # LF) THEN InsertSpace(pos - 1) END
+ ELSE
+ IF (buffer[8] # " ") THEN InsertSpace(pos - 1) END;
+ IF (buffer[6] # " ") THEN InsertSpace(pos - 2) END
+ END
+ END;
+ ReadOperator(r, buffer, opFlags)
+ END
+END SpaceOperators;
+
+PROCEDURE SpaceFormParms (bText: Texts.Text);
+ VAR s: Texts.Scanner; r: Texts.Reader; ch: CHAR;
+BEGIN
+ Texts.OpenScanner(s, bText, 0);
+ Texts.Scan(s);
+ WHILE ~s.eot DO
+ IF (s.class = Texts.Name) & (s.s = "PROCEDURE") THEN
+ Texts.OpenReader(r, bText, Texts.Pos(s) - 1);
+ Texts.Read(r, ch);
+ (* --- Search through the Procedure Heading *)
+ WHILE ~r.eot & (ch # ";") DO
+ IF (ch = "(") THEN
+ (* --- Parameterlist found *)
+ Texts.OpenReader(r, bText, Texts.Pos(r) - 2);
+ Texts.Read(r, ch);
+ IF ch # " " THEN
+ (* --- Insert space *)
+ Texts.Write(w, ' ');
+ Texts.Insert(bText, Texts.Pos(r) , w.buf);
+ Texts.OpenReader(r, bText, Texts.Pos(r))
+ END;
+ (* --- Search for end of parameterlist *)
+ WHILE ~r.eot & (ch # ")") DO Texts.Read(r, ch) END;
+ Texts.OpenScanner(s, bText, Texts.Pos(s))
+ END;
+ Texts.Read(r, ch)
+ END
+ END;
+ Texts.Scan(s)
+ END
+END SpaceFormParms;
+
+PROCEDURE RemSpaces (bText: Texts.Text);
+ VAR r: Texts.Reader; linStart: BOOLEAN; ch, ech: CHAR; start, end: LONGINT;
+BEGIN
+ linStart := TRUE;
+ Texts.OpenReader(r, bText, 0);
+ Texts.Read(r, ch);
+ WHILE ~r.eot DO
+ IF ch = LF THEN
+ linStart := TRUE
+ ELSIF ch # " " THEN
+ linStart := FALSE;
+ (* --- Pass by comments *)
+ WHILE ~r.eot & (ch = "(") DO
+ Texts.Read(r, ch);
+ IF ch = "*" THEN passComments(r) END
+ END;
+
+ (* --- Pass by string & character constants *)
+ IF (ch = "'") OR (ch = '"') THEN
+ ech := ch;
+ REPEAT Texts.Read(r, ch) UNTIL r.eot OR (ch = ech)
+ END
+ ELSIF ~linStart THEN
+ start := Texts.Pos(r);
+ REPEAT Texts.Read(r, ch) UNTIL r.eot OR (ch # " ");
+ end := Texts.Pos(r);
+ IF (end - start) > 1THEN
+ Texts.Delete(bText, start, end - 1)
+ END;
+ Texts.OpenReader(r, bText, start)
+ END;
+ Texts.Read(r, ch)
+ END
+END RemSpaces;
+
+PROCEDURE SpaceOps*;
+ VAR bText: Texts.Text; oldNotifier: Texts.Notifier;
+BEGIN
+ ParseCmdLine(bText, oldNotifier);
+ IF bText = NIL THEN
+ Out.String("Usage: Beautifier.SpaceOps * | ^ | Filename.Mod"); Out.Ln
+ ELSE
+ (*FoldElems.ExpandAll(bText, 0, TRUE);*)
+ SpaceOperators(bText);
+ SpaceFormParms(bText);
+ RemSpaces(bText);
+ (*FoldElems.CollapseAll(bText, {FoldElems.tempLeft});*)
+ UpdateText(bText, oldNotifier)
+ END
+END SpaceOps;
+
+PROCEDURE TextToString(VAR T : Texts.Text; VAR string : ARRAY OF CHAR);
+ VAR R : Texts.Reader;
+ ch : CHAR;
+ i : LONGINT;
+BEGIN
+ COPY("", string);
+ Texts.OpenReader(R, T, 0);
+ i := 0;
+ WHILE Texts.Pos(R) < T.len DO
+ Texts.Read(R, ch);
+ IF ch # 0DX THEN string[i] := ch ELSE string[i] := 0AX END;
+ INC(i);
+ END;
+ (*string[i] := 0X;*)
+END TextToString;
+
+PROCEDURE DumpText(VAR t: Texts.Text);
+VAR s : POINTER TO ARRAY OF CHAR;
+BEGIN
+ NEW(s, t.len + 1);
+ COPY("", s^);
+ TextToString(t, s^);
+ Out.String(s^); Out.Ln;
+END DumpText;
+
+PROCEDURE Beautify*;
+ VAR bText: Texts.Text; oldNotifier: Texts.Notifier; (*expNamFnt, cmtFnt: Fonts.Font;*)
+BEGIN
+ ParseCmdLine(bText, oldNotifier);
+ IF bText = NIL THEN
+ (*Out.String("Usage: Beautifier.SpaceOps * | ^ | Filename.Mod"); Out.Ln*)
+ Out.String("Usage: vbeautify Filename.Mod"); Out.Ln
+ ELSE
+ (*GetFontsFromText(bText, expNamFnt, cmtFnt);
+ FoldElems.ExpandAll(bText, 0, TRUE);
+ ChangeFont(bText, expNamFnt, cmtFnt);*)
+ IndentCheck(bText);
+ RemSemicolons(bText);
+ FoldProcedures(bText);
+ SpaceOperators(bText);
+ SpaceFormParms(bText);
+ (*FoldElems.CollapseAll(bText, {FoldElems.tempLeft});*)
+ UpdateText(bText, oldNotifier);
+ (*Texts.CloseAscii(bText, 'test');*)
+ DumpText(bText)
+ END
+END Beautify;
+
+PROCEDURE InitHashTable;
+ VAR i: INTEGER;
+BEGIN
+ (* --- empty the Character Functions *)
+ FOR i := 0 TO 22 DO
+ fC[i] := 0;
+ lC[i] := 0
+ END;
+ (* --- empty Hash-Table *)
+ FOR i := 0 TO 50 DO
+ COPY("", hashT[i].word)
+ END
+ (* --- Set Character Functions *) ;
+ fC[1] := 0; fC[2] := 1; fC[4] := 2; fC[5] := 3; fC[8] := 4; fC[11] := 5; fC[15] := 6; fC[17] := 7;
+ fC[20] := 8; fC[21] := 9; fC[22] := 10;
+ lC[3] := 0; lC[4] := 1; lC[5] := 2; lC[7] := 3; lC[11] := 4; lC[13] := 5; lC[15] := 6; lC[17] := 7;
+ lC[19] := 8;
+ (* --- Put Keywords into hashtable *)
+ hashT[1].Init("UNTIL", IEK);
+ hashT[2].Init("END", IEK);
+ hashT[4].Init("BEGIN", IK); (* only if ~section , else BEGIN is IBK *)
+ hashT[7].Init("RECORD", IK);
+ hashT[11].Init("TYPE", SK);
+ hashT[12].Init("CASE", IK);
+ hashT[13].Init("ELSE", IBK);
+ hashT[17].Init("PROCEDURE", SK); (* only if not a type definition *)
+ hashT[20].Init("LOOP", IK);
+ hashT[21].Init("WHILE", IK);
+ hashT[24].Init("ELSIF", IBK);
+ hashT[26].Init("IF", IK);
+ hashT[29].Init("FOR", IK);
+ hashT[35].Init("VAR", IBK); (* only if nextCh = LF *)
+ hashT[38].Init("CONST", SK);
+ hashT[41].Init("IMPORT", SK);
+ hashT[43].Init("WITH", IK);
+ hashT[44].Init("REPEAT", IK)
+
+END InitHashTable;
+
+BEGIN
+ Texts.OpenWriter(w);
+ NEW(b);
+ Texts.OpenBuf(b);
+ InitHashTable;
+ Beautify
+END vbeautify.
diff --git a/src/tools/browser/BrowserCmd.Mod b/src/tools/browser/BrowserCmd.Mod
index d463c22d..e4ffe88f 100644
--- a/src/tools/browser/BrowserCmd.Mod
+++ b/src/tools/browser/BrowserCmd.Mod
@@ -3,7 +3,7 @@ MODULE BrowserCmd; (* RC 29.10.93 *) (* object model 4.12.93, command line ver
IMPORT
OPM, OPS, OPT, OPV,
Texts, Strings, Files, Out,
- Oberon, Platform, SYSTEM, Configuration;
+ Oberon, Modules, SYSTEM, Configuration;
CONST
OptionChar = "-";
@@ -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
@@ -265,13 +283,13 @@ MODULE BrowserCmd; (* RC 29.10.93 *) (* object model 4.12.93, command line ver
PROCEDURE ShowDef*;
VAR S, vname, name: OPS.Name;
BEGIN
- option := 0X; Platform.GetArg(1, S);
- IF Platform.ArgCount > 2 THEN
- IF S[0] = OptionChar THEN option := S[1]; Platform.GetArg(2, S)
- ELSE Platform.GetArg(2, vname); option := vname[1]
+ option := 0X; Modules.GetArg(1, S);
+ IF Modules.ArgCount > 2 THEN
+ IF S[0] = OptionChar THEN option := S[1]; Modules.GetArg(2, S)
+ ELSE Modules.GetArg(2, vname); option := vname[1]
END
END;
- IF Platform.ArgCount >= 2 THEN
+ IF Modules.ArgCount >= 2 THEN
Ident(S, name);
OPT.Init(name, {}); OPT.SelfName := "AvoidErr154";
WModule(name, Oberon.Log);
diff --git a/src/tools/make/addlibrary.sh b/src/tools/make/addlibrary.sh
new file mode 100644
index 00000000..46e6e3e4
--- /dev/null
+++ b/src/tools/make/addlibrary.sh
@@ -0,0 +1,28 @@
+# addlibrary - shell script to install/uninstall oberon libraries
+#
+# $1 - "install" or "uninstall"
+# $2 - location containing .so's
+# $3 - oberon name
+
+
+if ! which ldconfig >/dev/null 2>&1; then exit 0; fi
+
+if test -d /etc/ld.so.conf.d; then
+
+ # Linux-like system
+ # Need to update the ldconfig configuration in the /etc/ld.so.conf.d dir.
+ if test "$1" = "install"; then
+ echo $2>/etc/ld.so.conf.d/lib$3.conf
+ else
+ rm -f /etc/ld.so.conf.d/lib$3.conf
+ fi
+ ldconfig
+
+else
+
+ # BSD-like system
+ # Just run ldconfig -m to update the cache. It'll add-to/update/reove-from
+ # the cache appropraitely for whether they are present opt not.
+ ldconfig -m "$2"
+
+fi
diff --git a/src/tools/make/buildall.pl b/src/tools/make/buildall.pl
deleted file mode 100755
index 0dbb0260..00000000
--- a/src/tools/make/buildall.pl
+++ /dev/null
@@ -1,231 +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" => ['pi@pie', "sudo", "projects/oberon/vishap/voc", "make full"],
- "darwin" => ['dave@dcb', "sudo", "projects/oberon/vishap/voc", "make full"],
- "cygwin" => ['-p5932 dave@wax', "", "oberon/cygwin/voc", "export CC=gcc && make full;"
- . "cd ~;"
- . "sh start64.sh \\\"cd oberon/cygwin/voc && git reset --hard && git clean -dfx &&"
- . "git pull && git checkout $branch && git pull;"
- . "export CC=gcc && make full;\\\""],
- "mingw" => ['-p5932 dave@wax', "", "oberon/mingw/voc", "export CC=i686-w64-mingw32-gcc && make full;"
- . "cd ~;"
- . "sh start64.sh \\\"cd oberon/mingw/voc && git reset --hard && git clean -dfx &&"
- . "git pull && git checkout $branch && git pull;"
- . "export CC=x86_64-w64-mingw32-gcc && make full;\\\""],
- "android" => ['-p8022 root@and', "", "vishap/voc", "export CC=gcc && make full"],
- "lub64" => ['dave@vim', "sudo", "oberon/voc", "make full"],
- "lub32" => ['dave@vim-lub32', "sudo", "oberon/voc", "make full"],
- "fed64" => ['dave@vim-fed64', "sudo", "oberon/voc", "make full"],
- "osu64" => ['dave@vim-osu64', "sudo", "oberon/voc", "make full"],
- "ob32" => ['root@nas-ob32', "", "vishap/voc", "make full"],
- "ce64" => ['-p5922 obe@www', "sudo", "vishap/voc", "make full"],
- "fb64" => ['root@oberon', "", "vishap/voc", "make full"]
-);
-
-
-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);
- close($log);
- exit;
- }
-}
-
-unlink glob "log/*";
-
-for my $machine (sort keys %machines) {
- my ($login, $sudo, $dir, $mkcmd) = @{$machines{$machine}};
- my $cmd = "ssh $login \"cd $dir && $sudo git reset --hard && $sudo git clean -dfx &&"
- . "$sudo git pull && $sudo git checkout -f $branch && $sudo git pull && $sudo $mkcmd\" ";
- logged($cmd, $machine);
-}
-
-while ((my $pid = wait) > 0) {print "Child pid $pid completed.\n";}
-
-
-# # All builds have completed. Now scan the logs for pass/fail and build the passing report.
-
-
-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.";
- 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 = "Failed";}
- if (/^([0-9.]+) --- Compiler build successfull ---$/) {$compilerok = "Built";}
-
- if (/^([0-9.]+) --- Library build started ---$/) {$libraryok = "Failed";}
- 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 = "Failed";}
- if (/^([0-9.]+) --- Confidence tests passed ---$/) {$tests = "Passed";}
- }
- 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";
-
-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/make/configure.c b/src/tools/make/configure.c
index 5865e3e0..258a1b4e 100644
--- a/src/tools/make/configure.c
+++ b/src/tools/make/configure.c
@@ -8,7 +8,7 @@
// Derived from vocparam.c originally by J. Templ 23.6.95
-#define O_VER 2.00 // Version number to be reported by compiler.
+#define O_VER 2.1.0 // Version number to be reported by compiler.
#define O_NAME voc // Compiler name used for binary, install dir and references in text.
@@ -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;
@@ -106,7 +104,7 @@ void determineOS() {
#ifdef _WIN32
os = "windows"; platform = "windows"; binext = ".exe"; staticlink = "";
#else
- os = "unknown"; platform = "unix"; binext = ""; staticlink = "-static";
+ os = "unknown"; platform = "unix"; binext = ""; staticlink = " -static";
struct utsname sys;
if (uname(&sys)<0) fail("Couldn't get sys name - uname() failed.");
@@ -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/ignore b/src/tools/make/ignore
index 42554f00..8985991b 100644
--- a/src/tools/make/ignore
+++ b/src/tools/make/ignore
@@ -1,6 +1,7 @@
^/\* voc +
Configuration_
OPM_ResourceDir
+OPM_InstallDir
__MOVE.* cmd,
OPM_(IntSize|PointerSize|Alignment) =
Strings_Append.+void\*\)(cmd|OPM_OBERON|extTools_comp)
diff --git a/src/tools/make/oberon.mk b/src/tools/make/oberon.mk
index 796cb8d5..d68cc09b 100644
--- a/src/tools/make/oberon.mk
+++ b/src/tools/make/oberon.mk
@@ -32,8 +32,8 @@ usage:
clean:
- @printf "\n\n--- Cleaning branch $(BRANCH) $(OS) $(COMPILER) $(DATAMODEL) ---\n\n"
- rm -rf $(BUILDDIR)
+ @printf '\n\n--- Cleaning branch $(BRANCH) $(OS) $(COMPILER) $(DATAMODEL) ---\n\n'
+ rm -rf $(BUILDDIR) "$(ROOTDIR)/install"
rm -f $(OBECOMP)
@@ -42,38 +42,39 @@ clean:
# Assemble: Generate the Vishap Oberon compiler binary by compiling the C sources in the build directory
assemble:
- @printf "\nmake assemble - compiling Oberon compiler c source:\n"
- @printf " VERSION: %s\n" "$(VERSION)"
- @printf " BRANCH: %s\n" "$(BRANCH)"
- @printf " Target characteristics:\n"
- @printf " PLATFORM: %s\n" "$(PLATFORM)"
- @printf " OS: %s\n" "$(OS)"
- @printf " BUILDDIR: %s\n" "$(BUILDDIR)"
- @printf " INSTALLDIR: %s\n" "$(INSTALLDIR)"
- @printf " Oberon characteristics:\n"
- @printf " MODEL: %s\n" "$(MODEL)"
- @printf " ADRSIZE: %s\n" "$(ADRSIZE)"
- @printf " ALIGNMENT: %s\n" "$(ALIGNMENT)"
- @printf " C compiler:\n"
- @printf " COMPILER: %s\n" "$(COMPILER)"
- @printf " COMPILE: %s\n" "$(COMPILE)"
- @printf " DATAMODEL: %s\n" "$(DATAMODEL)"
+ @printf '\nmake assemble - compiling Oberon compiler c source:\n'
+ @printf ' VERSION: %s\n' "$(VERSION)"
+ @printf ' BRANCH: %s\n' "$(BRANCH)"
+ @printf ' Target characteristics:\n'
+ @printf ' PLATFORM: %s\n' "$(PLATFORM)"
+ @printf ' OS: %s\n' "$(OS)"
+ @printf ' BUILDDIR: %s\n' "$(BUILDDIR)"
+ @printf ' INSTALLDIR: %s\n' "$(INSTALLDIR)"
+ @printf ' Oberon characteristics:\n'
+ @printf ' MODEL: %s\n' "$(MODEL)"
+ @printf ' ADRSIZE: %s\n' "$(ADRSIZE)"
+ @printf ' ALIGNMENT: %s\n' "$(ALIGNMENT)"
+ @printf ' C compiler:\n'
+ @printf ' COMPILER: %s\n' "$(COMPILER)"
+ @printf ' COMPILE: %s\n' "$(COMPILE)"
+ @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)
- @printf "$(OBECOMP) created.\n"
+ cp src/runtime/*.Txt "$(ROOTDIR)"
+ @printf '$(OBECOMP) created.\n'
@@ -95,45 +96,45 @@ translate:
if [ ! -e $(OBECOMP) ]; then make -f src/tools/make/oberon.mk -s compilerfromsavedsource; fi
- @printf "\nmake translate - translating compiler source from Oberon to C:\n"
- @printf " PLATFORM: %s\n" $(PLATFORM)
- @printf " MODEL: %s\n" $(MODEL)
- @printf " ADRSIZE: %s\n" $(ADRSIZE)
- @printf " ALIGNMENT: %s\n" $(ALIGNMENT)
+ @printf '\nmake translate - translating compiler source from Oberon to C:\n'
+ @printf ' PLATFORM: %s\n' $(PLATFORM)
+ @printf ' MODEL: %s\n' $(MODEL)
+ @printf ' ADRSIZE: %s\n' $(ADRSIZE)
+ @printf ' ALIGNMENT: %s\n' $(ALIGNMENT)
@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)
- @printf "$(BUILDDIR) filled with compiler C source.\n"
+ @printf '$(BUILDDIR) filled with compiler C source.\n'
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
+ @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); $(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 \
@@ -142,223 +143,233 @@ 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"'
+ @rm -rf "$(ROOTDIR)/install"
+
+ @mkdir -p "$(ROOTDIR)/install/bin"
+ @cp $(OBECOMP) "$(ROOTDIR)/install/bin/$(OBECOMP)"
+ @-cp $(BUILDDIR)/showdef$(BINEXT) "$(ROOTDIR)/install/bin"
+
+ @mkdir -p "$(ROOTDIR)/install/2/include" && cp $(BUILDDIR)/2/*.h "$(ROOTDIR)/install/2/include/"
+ @mkdir -p "$(ROOTDIR)/install/2/sym" && cp $(BUILDDIR)/2/*.sym "$(ROOTDIR)/install/2/sym/"
+ @mkdir -p "$(ROOTDIR)/install/C/include" && cp $(BUILDDIR)/C/*.h "$(ROOTDIR)/install/C/include/"
+ @mkdir -p "$(ROOTDIR)/install/C/sym" && cp $(BUILDDIR)/C/*.sym "$(ROOTDIR)/install/C/sym/"
+
+ @cp $(BUILDDIR)/*.Txt "$(ROOTDIR)/install/2/sym/"
+ @cp $(BUILDDIR)/*.Txt "$(ROOTDIR)/install/C/sym/"
+
+ @mkdir -p "$(ROOTDIR)/install/lib"
+ @cp $(BUILDDIR)/2/lib$(ONAME)* "$(ROOTDIR)/install/lib/"
+ @cp $(BUILDDIR)/C/lib$(ONAME)* "$(ROOTDIR)/install/lib/"
+
+
+# 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 'export PATH=\"$(ROOTDIR)/install/bin:$$PATH\"\n'
+ @printf '\n'
+
+
+
+
FORCE:
-# installable: Check for access to the installation directory
+# installable: Check for access to the installation directory
installable:
@rm -rf "S(INSTALLDIR)/test-access-qqq"
- @if ! mkdir -p "$(INSTALLDIR)/test-access-qqq";then echo "\\n\\n Cannot write to install directory.\\n Please use sudo or run as root/administrator.\\n\\n"; exit 1;fi
+ @if ! mkdir -p "$(INSTALLDIR)/test-access-qqq";then printf '\n\n Cannot write to install directory.\n Please use sudo or run as root/administrator.\n\n'; exit 1;fi
@rm -rf "S(INSTALLDIR)/test-access-qqq"
+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)"
# install: Use only after a successful full build. Installs the compiler
# and libraries in /opt/$(ONAME).
# May require root access.
-install:
- @printf "\nInstalling into \"$(INSTALLDIR)\"\n"
+install: uninstall
+ @printf '\nInstalling into \"$(INSTALLDIR)\"\n'
@rm -rf "$(INSTALLDIR)"
-
- @mkdir -p "$(INSTALLDIR)/bin"
- @cp $(OBECOMP) "$(INSTALLDIR)/bin/$(OBECOMP)"
- @-cp $(BUILDDIR)/showdef$(BINEXT) "$(INSTALLDIR)/bin"
-
- @mkdir -p "$(INSTALLDIR)/2/include" && cp $(BUILDDIR)/2/*.h "$(INSTALLDIR)/2/include/"
- @mkdir -p "$(INSTALLDIR)/2/sym" && cp $(BUILDDIR)/2/*.sym "$(INSTALLDIR)/2/sym/"
- @mkdir -p "$(INSTALLDIR)/C/include" && cp $(BUILDDIR)/C/*.h "$(INSTALLDIR)/C/include/"
- @mkdir -p "$(INSTALLDIR)/C/sym" && cp $(BUILDDIR)/C/*.sym "$(INSTALLDIR)/C/sym/"
-
- @cp $(BUILDDIR)/*.Txt "$(INSTALLDIR)/2/sym/"
- @cp $(BUILDDIR)/*.Txt "$(INSTALLDIR)/C/sym/"
-
- @mkdir -p "$(INSTALLDIR)/lib"
- @cp $(BUILDDIR)/2/lib$(ONAME)* "$(INSTALLDIR)/lib/"
- @cp $(BUILDDIR)/C/lib$(ONAME)* "$(INSTALLDIR)/lib/"
- @if which ldconfig >/dev/null 2>&1; then $(LDCONFIG); fi
+ @cp -rf "$(ROOTDIR)/install/" "$(INSTALLDIR)"
+ @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'
+ @printf '\n'
-
-
-# showpath: Describe how to set the PATH variable
-showpath:
- @printf "\nNow add $(INSTALLDIR)/bin to your path, for example with the command:\n"
- @printf "export PATH=\"$(INSTALLDIR)/bin:\$$PATH\"\n"
- @printf "\n"
-
-
-
-
-uninstall:
- @printf "\nUninstalling from \"$(INSTALLDIR)\"\n"
- rm -rf "$(INSTALLDIR)"
- rm -f /etc/ld.so.conf/lib$(ONAME)
- if which ldconfig >/dev/null 2>&1; then ldconfig; fi
-
-
-runtime:
- @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/Modules.Mod
- cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Strings.Mod
- cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/runtime/Out.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
+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/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
+ @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
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
+ @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
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
+ @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
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
+ @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
ulm:
- @printf "\nMaking ulm library for -O$(MODEL)\n"
- 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/ulmTypes.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
+ @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
pow32:
- @printf "\nMaking pow library for -O$(MODEL)\n"
- cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Fs -O$(MODEL) ../../../src/library/pow/powStrings.Mod
+ @printf '\nMaking pow library for -O$(MODEL)\n'
+ 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
+ @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
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
+ @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/ethBase64.Mod
@@ -368,28 +379,28 @@ O2library: runtime v4 ooc2 ooc ulm pow32 misc s3
OClibrary: runtime
library:
- @printf "\nCompiling lib$(ONAME)-O$(MODEL) sources\n"
+ @printf '\nCompiling lib$(ONAME)-O$(MODEL) sources\n'
rm -rf $(BUILDDIR)/$(MODEL)
mkdir -p $(BUILDDIR)/$(MODEL)
cp $(BUILDDIR)/SYSTEM.[ho] $(BUILDDIR)/$(MODEL)
+ cp src/runtime/*.Txt $(BUILDDIR)/$(MODEL)
cp $(BUILDDIR)/WindowsWrapper.h $(BUILDDIR)/$(MODEL)
@make -f src/tools/make/oberon.mk -s O$(MODEL)library MODEL=$(MODEL)
- @printf "\nMaking lib$(ONAME)-O$(MODEL) .a and .so\n"
+ @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)"
-
-RUNTEST = COMPILER=$(COMPILER) OBECOMP="$(OBECOMP) -O$(MODEL)" FLAVOUR=$(FLAVOUR) BRANCH=$(BRANCH) sh ./test.sh "$(INSTALLDIR)"
+RUNTEST = COMPILER=$(COMPILER) OBECOMP="$(OBECOMP) -O$(MODEL)" FLAVOUR=$(FLAVOUR) BRANCH=$(BRANCH) sh ./test.sh "$(ROOTDIR)/install"
confidence:
- @printf "\n\n--- Confidence tests ---\n\n"
+ @printf '\n\n--- Confidence tests ---\n\n'
cd src/test/confidence/hello; $(RUNTEST)
cd src/test/confidence/out; $(RUNTEST)
cd src/test/confidence/in; $(RUNTEST)
@@ -402,4 +413,4 @@ confidence:
cd src/test/confidence/isptest; $(RUNTEST)
cd src/test/confidence/lola; $(RUNTEST)
if [ "$(PLATFORM)" != "windows" ] ; then cd src/test/confidence/signal; $(RUNTEST); fi
- @printf "\n\n--- Confidence tests passed ---\n\n"
+ @printf '\n\n--- Confidence tests passed ---\n\n'
diff --git a/src/tools/make/postpush.pl b/src/tools/make/postpush.pl
deleted file mode 100755
index 5bfe0ffb..00000000
--- a/src/tools/make/postpush.pl
+++ /dev/null
@@ -1,57 +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
- system 'echo Syncing voc>postpush.log';
- system '(cd voc; git reset --hard; git clean -dfx; git pull; git checkout -f ' . $branch . '; git pull; git checkout -f) >>postpush.log';
- exec 'perl voc/src/tools/make/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/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 ""
diff --git a/src/tools/ocat/OCatCmd.Mod b/src/tools/ocat/OCatCmd.Mod
index 030011a1..3d76a745 100644
--- a/src/tools/ocat/OCatCmd.Mod
+++ b/src/tools/ocat/OCatCmd.Mod
@@ -2,7 +2,7 @@ MODULE OCatCmd; (* J. Templ, 13-Jan-96 *)
(* looks at the OBERON search path and writes one or more Oberon or ascii texts to standard out *)
- IMPORT Args, Console, Files := Files0, Texts := Texts0;
+ IMPORT Args, Console, Files, Texts;
PROCEDURE Cat*;
VAR path: ARRAY 128 OF CHAR; i: INTEGER; T: Texts.Text; R: Texts.Reader; ch: CHAR; tab: BOOLEAN;
diff --git a/src/voc07R/CompatTexts.Mod b/src/voc07R/CompatTexts.Mod
deleted file mode 100644
index 8e8b45ac..00000000
--- a/src/voc07R/CompatTexts.Mod
+++ /dev/null
@@ -1,585 +0,0 @@
-MODULE CompatTexts; (*JG 21.11.90 / NW 11.7.90 / 24.12.95 / 22.11.10 / 26.3.2014*)
- IMPORT Files := CompatFiles, Fonts;
-
- TYPE INTEGER = LONGINT; (* voc adaptation by noch *)
- BYTE = CHAR;
-
- CONST (*scanner symbol classes*)
- Inval* = 0; (*invalid symbol*)
- Name* = 1; (*name s (length len)*)
- String* = 2; (*literal string s (length len)*)
- Int* = 3; (*integer i (decimal or hexadecimal)*)
- Real* = 4; (*real number x*)
- Char* = 6; (*special character c*)
-
- (* TextBlock = TextTag "1" offset run {run} "0" len {AsciiCode}.
- run = fnt [name] col voff len. *)
-
- TAB = 9X; CR = 0DX; maxD = 9;
- TextTag = 0F1X;
- replace* = 0; insert* = 1; delete* = 2; unmark* = 3; (*op-codes*)
-
- TYPE Piece = POINTER TO PieceDesc;
- PieceDesc = RECORD
- f: Files.File;
- off, len: LONGINT;
- fnt: Fonts.Font;
- col, voff: INTEGER;
- prev, next: Piece
- END;
-
- Text* = POINTER TO TextDesc;
- Notifier* = PROCEDURE (T: Text; op: INTEGER; beg, end: LONGINT);
- TextDesc* = RECORD
- len*: LONGINT;
- changed*: BOOLEAN;
- notify*: Notifier;
- trailer: Piece;
- pce: Piece; (*cache*)
- org: LONGINT; (*cache*)
- END;
-
- Reader* = RECORD
- eot*: BOOLEAN;
- fnt*: Fonts.Font;
- col*, voff*: INTEGER;
- ref: Piece;
- org: LONGINT;
- off: LONGINT;
- rider: Files.Rider
- END;
-
- Scanner* = RECORD (Reader)
- nextCh*: CHAR;
- line*, class*: INTEGER;
- i*: LONGINT;
- x*: REAL;
- y*: LONGREAL;
- c*: CHAR;
- len*: INTEGER;
- s*: ARRAY 32 OF CHAR
- END;
-
- Buffer* = POINTER TO BufDesc;
- BufDesc* = RECORD
- len*: LONGINT;
- header, last: Piece
- END;
-
- Writer* = RECORD
- buf*: Buffer;
- fnt*: Fonts.Font;
- col*, voff*: INTEGER;
- rider: Files.Rider
- END;
-
- VAR TrailerFile: Files.File;
-
- (* voc adaptation by noch *)
- PROCEDURE FLOOR(x : REAL): INTEGER;
- BEGIN
- RETURN ENTIER(x)
- END FLOOR;
-
- PROCEDURE LSL (x, n : INTEGER): INTEGER;
- BEGIN
- RETURN ASH(x, n);
- END LSL;
-
- PROCEDURE ASR (x, n : INTEGER): INTEGER;
- BEGIN
- RETURN ASH(x, n);
- END ASR;
-
-
- (* -------------------- Filing ------------------------*)
-
- PROCEDURE Trailer(): Piece;
- VAR Q: Piece;
- BEGIN NEW(Q);
- Q.f := TrailerFile; Q.off := -1; Q.len := 1; Q.fnt := NIL; Q.col := 0; Q.voff := 0; RETURN Q
- END Trailer;
-
- PROCEDURE Load* (VAR R: Files.Rider; T: Text);
- VAR Q, q, p: Piece;
- off: LONGINT;
- N, fno: INTEGER; bt: BYTE;
- f: Files.File;
- FName: ARRAY 32 OF CHAR;
- Dict: ARRAY 32 OF Fonts.Font;
- BEGIN f := Files.Base(R); N := 1; Q := Trailer(); p := Q;
- Files.ReadInt(R, off); Files.ReadByte(R, bt);
- (*fno := bt;*)
- fno := ORD(bt); (* voc adaptation by noch *)
- WHILE fno # 0 DO
- IF fno = N THEN
- Files.ReadString(R, FName);
- Dict[N] := Fonts.This(FName); INC(N)
- END;
- NEW(q); q.fnt := Dict[fno];
- Files.ReadByte(R, bt);
- (*q.col := bt;*)
- q.col := ORD(bt); (* voc adaptation by noch *)
- Files.ReadByte(R, bt);
- (*q.voff := ASR(LSL(bt, -24), 24);*)
- q.voff := ASR(LSL(ORD(bt), -24), 24); (* voc adaptation by noch *)
- Files.ReadInt(R, q.len);
- Files.ReadByte(R, bt);
- (*fno := bt;*)
- fno := ORD(bt); (* voc adaptation by noch *)
- q.f := f; q.off := off; off := off + q.len;
- p.next := q; q.prev := p; p := q
- END;
- p.next := Q; Q.prev := p;
- T.trailer := Q; Files.ReadInt(R, T.len); (*Files.Set(R, f, Files.Pos(R) + T.len)*)
- END Load;
-
- PROCEDURE Open* (T: Text; name: ARRAY OF CHAR);
- VAR f: Files.File; R: Files.Rider; Q, q: Piece;
- tag: CHAR; len: LONGINT;
- BEGIN f := Files.Old(name);
- IF f # NIL THEN
- Files.Set(R, f, 0); Files.Read(R, tag);
- IF tag = TextTag THEN Load(R, T)
- ELSE (*Ascii file*)
- len := Files.Length(f); Q := Trailer();
- NEW(q); q.fnt := Fonts.Default; q.col := 1; q.voff := 0; q.f := f; q.off := 0; q.len := len;
- Q.next := q; q.prev := Q; q.next := Q; Q.prev := q; T.trailer := Q; T.len := len
- END
- ELSE (*create new text*)
- Q := Trailer(); Q.next := Q; Q.prev := Q; T.trailer := Q; T.len := 0
- END ;
- T.changed := FALSE; T.org := -1; T.pce := T.trailer (*init cache*)
- END Open;
-
- PROCEDURE Store* (VAR W: Files.Rider; T: Text);
- VAR p, q: Piece;
- R: Files.Rider;
- off, rlen, pos: LONGINT;
- N, n: INTEGER;
- ch: CHAR;
- Dict: ARRAY 32, 32 OF CHAR;
- BEGIN pos := Files.Pos(W); Files.WriteInt(W, 0); (*place holder*)
- N := 1; p := T.trailer.next;
- WHILE p # T.trailer DO
- rlen := p.len; q := p.next;
- WHILE (q # T.trailer) & (q.fnt = p.fnt) & (q.col = p.col) & (q.voff = p.voff) DO
- rlen := rlen + q.len; q := q.next
- END;
- (*Dict[N] := p.fnt.name;*)
- IF p.fnt # NIL THEN COPY(p.fnt.name, Dict[N]) END; (* voc adaptation by noch *)
- n := 1;
- IF p.fnt # NIL THEN (* voc adaptation by noch *)
- WHILE Dict[n] # p.fnt.name DO INC(n) END;
- END;
- (*Files.WriteByte(W, n);*)
- Files.WriteByte(W, SHORT(SHORT(n))); (* voc adaptation by noch *)
- IF p.fnt # NIL THEN (* voc adaptation by noch *)
- IF n = N THEN Files.WriteString(W, p.fnt.name); INC(N) END;
- END;
- (*Files.WriteByte(W, p.col);*)
- Files.WriteByte(W, SHORT(SHORT(p.col))); (* voc adaptation by noch *)
- (*Files.WriteByte(W, p.voff);*)
- Files.WriteByte(W, SHORT(SHORT(p.voff))); (* voc adaptation by noch *)
- Files.WriteInt(W, rlen);
- p := q
- END;
- Files.WriteByte(W, 0); Files.WriteInt(W, T.len);
- off := Files.Pos(W); p := T.trailer.next;
- WHILE p # T.trailer DO
- rlen := p.len; Files.Set(R, p.f, p.off);
- WHILE rlen > 0 DO Files.Read(R, ch); Files.Write(W, ch); DEC(rlen) END ;
- p := p.next
- END ;
- Files.Set(W, Files.Base(W), pos); Files.WriteInt(W, off); (*fixup*)
- T.changed := FALSE;
- IF T.notify # NIL THEN T.notify(T, unmark, 0, 0) END
- END Store;
-
- PROCEDURE Close*(T: Text; name: ARRAY OF CHAR);
- VAR f: Files.File; w: Files.Rider;
- BEGIN f := Files.New(name); Files.Set(w, f, 0);
- Files.Write(w, TextTag); Store(w, T); Files.Register(f)
- END Close;
-
- (* -------------------- Editing ----------------------- *)
-
- PROCEDURE OpenBuf* (B: Buffer);
- BEGIN NEW(B.header); (*null piece*)
- B.last := B.header; B.len := 0
- END OpenBuf;
-
- PROCEDURE FindPiece (T: Text; pos: LONGINT; VAR org: LONGINT; VAR pce: Piece);
- VAR p: Piece; porg: LONGINT;
- BEGIN p := T.pce; porg := T.org;
- IF pos >= porg THEN
- WHILE pos >= porg + p.len DO INC(porg, p.len); p := p.next END
- ELSE p := p.prev; DEC(porg, p.len);
- WHILE pos < porg DO p := p.prev; DEC(porg, p.len) END
- END ;
- T.pce := p; T.org := porg; (*update cache*)
- pce := p; org := porg
- END FindPiece;
-
- PROCEDURE SplitPiece (p: Piece; off: LONGINT; VAR pr: Piece);
- VAR q: Piece;
- BEGIN
- IF off > 0 THEN NEW(q);
- q.fnt := p.fnt; q.col := p.col; q.voff := p.voff;
- q.len := p.len - off;
- q.f := p.f; q.off := p.off + off;
- p.len := off;
- q.next := p.next; p.next := q;
- q.prev := p; q.next.prev := q;
- pr := q
- ELSE pr := p
- END
- END SplitPiece;
-
- PROCEDURE Save* (T: Text; beg, end: LONGINT; B: Buffer);
- VAR p, q, qb, qe: Piece; org: LONGINT;
- BEGIN
- IF end > T.len THEN end := T.len END;
- FindPiece(T, beg, org, p);
- NEW(qb); qb^ := p^;
- qb.len := qb.len - (beg - org);
- qb.off := qb.off + (beg - org);
- qe := qb;
- WHILE end > org + p.len DO
- org := org + p.len; p := p.next;
- NEW(q); q^ := p^; qe.next := q; q.prev := qe; qe := q
- END;
- qe.next := NIL; qe.len := qe.len - (org + p.len - end);
- B.last.next := qb; qb.prev := B.last; B.last := qe;
- B.len := B.len + (end - beg)
- END Save;
-
- PROCEDURE Copy* (SB, DB: Buffer);
- VAR Q, q, p: Piece;
- BEGIN p := SB.header; Q := DB.last;
- WHILE p # SB.last DO p := p.next;
- NEW(q); q^ := p^; Q.next := q; q.prev := Q; Q := q
- END;
- DB.last := Q; DB.len := DB.len + SB.len
- END Copy;
-
- PROCEDURE Insert* (T: Text; pos: LONGINT; B: Buffer);
- VAR pl, pr, p, qb, qe: Piece; org, end: LONGINT;
- BEGIN
- FindPiece(T, pos, org, p); SplitPiece(p, pos - org, pr);
- IF T.org >= org THEN T.org := org - p.prev.len; T.pce := p.prev END ;
- pl := pr.prev; qb := B.header.next;
- IF (qb # NIL) & (qb.f = pl.f) & (qb.off = pl.off + pl.len)
- & (qb.fnt = pl.fnt) & (qb.col = pl.col) & (qb.voff = pl.voff) THEN
- pl.len := pl.len + qb.len; qb := qb.next
- END;
- IF qb # NIL THEN qe := B.last;
- qb.prev := pl; pl.next := qb; qe.next := pr; pr.prev := qe
- END;
- T.len := T.len + B.len; end := pos + B.len;
- B.last := B.header; B.last.next := NIL; B.len := 0;
- T.changed := TRUE;
- (*T.notify(T, insert, pos, end)*)
- IF T.notify # NIL THEN
- T.notify(T, insert, pos, end)
- END(* voc adaptation by noch *)
- END Insert;
-
- PROCEDURE Append* (T: Text; B: Buffer);
- BEGIN Insert(T, T.len, B)
- END Append;
-
- PROCEDURE Delete* (T: Text; beg, end: LONGINT; B: Buffer);
- VAR pb, pe, pbr, per: Piece; orgb, orge: LONGINT;
- BEGIN
- IF end > T.len THEN end := T.len END;
- FindPiece(T, beg, orgb, pb); SplitPiece(pb, beg - orgb, pbr);
- FindPiece(T, end, orge, pe);
- SplitPiece(pe, end - orge, per);
- IF T.org >= orgb THEN (*adjust cache*)
- T.org := orgb - pb.prev.len; T.pce := pb.prev
- END;
- B.header.next := pbr; B.last := per.prev;
- B.last.next := NIL; B.len := end - beg;
- per.prev := pbr.prev; pbr.prev.next := per;
- T.len := T.len - B.len;
- T.changed := TRUE;
- IF T.notify # NIL THEN (* noch *)
- T.notify(T, delete, beg, end)
- END
- END Delete;
-
- PROCEDURE ChangeLooks* (T: Text; beg, end: LONGINT; sel: SET; fnt: Fonts.Font; col, voff: INTEGER);
- VAR pb, pe, p: Piece; org: LONGINT;
- BEGIN
- IF end > T.len THEN end := T.len END;
- FindPiece(T, beg, org, p); SplitPiece(p, beg - org, pb);
- FindPiece(T, end, org, p); SplitPiece(p, end - org, pe);
- p := pb;
- REPEAT
- IF 0 IN sel THEN p.fnt := fnt END;
- IF 1 IN sel THEN p.col := col END;
- IF 2 IN sel THEN p.voff := voff END;
- p := p.next
- UNTIL p = pe;
- T.changed := TRUE;
- IF T.notify # NIL THEN (* noch *)
- T.notify(T, replace, beg, end)
- END
- END ChangeLooks;
-
- PROCEDURE Attributes*(T: Text; pos: LONGINT; VAR fnt: Fonts.Font; VAR col, voff: INTEGER);
- VAR p: Piece; org: LONGINT;
- BEGIN FindPiece(T, pos, org, p); fnt := p.fnt; col := p.col; voff := p.voff
- END Attributes;
-
- (* ------------------ Access: Readers ------------------------- *)
-
- PROCEDURE OpenReader* (VAR R: Reader; T: Text; pos: LONGINT);
- VAR p: Piece; org: LONGINT;
- BEGIN FindPiece(T, pos, org, p);
- R.ref := p; R.org := org; R.off := pos - org;
- Files.Set(R.rider, p.f, p.off + R.off); R.eot := FALSE
- END OpenReader;
-
- PROCEDURE Read* (VAR R: Reader; VAR ch: CHAR);
- BEGIN Files.Read(R.rider, ch);
- R.fnt := R.ref.fnt; R.col := R.ref.col; R.voff := R.ref.voff;
- INC(R.off);
- IF R.off = R.ref.len THEN
- IF R.ref.f = TrailerFile THEN R.eot := TRUE END;
- R.org := R.org + R.off; R.off := 0;
- R.ref := R.ref.next; R.org := R.org + R.off; R.off := 0;
- Files.Set(R.rider, R.ref.f, R.ref.off)
- END
- END Read;
-
- PROCEDURE Pos* (VAR R: Reader): LONGINT;
- BEGIN RETURN R.org + R.off
- END Pos;
-
- (* ------------------ Access: Scanners (NW) ------------------------- *)
-
- PROCEDURE OpenScanner* (VAR S: Scanner; T: Text; pos: LONGINT);
- BEGIN OpenReader(S, T, pos); S.line := 0; S.nextCh := " "
- END OpenScanner;
-
- (*floating point formats:
- x = 1.m * 2^(e-127) bit 0: sign, bits 1- 8: e, bits 9-31: m
- x = 1.m * 2^(e-1023) bit 0: sign, bits 1-11: e, bits 12-63: m *)
-
- PROCEDURE Ten(n: INTEGER): REAL;
- VAR t, p: REAL;
- BEGIN t := 1.0; p := 10.0; (*compute 10^n *)
- WHILE n > 0 DO
- IF ODD(n) THEN t := p * t END ;
- p := p*p; n := n DIV 2
- END ;
- RETURN t
- END Ten;
-
- PROCEDURE Scan* (VAR S: Scanner);
- CONST maxExp = 38; maxM = 16777216; (*2^24*)
- VAR ch, term: CHAR;
- neg, negE, hex: BOOLEAN;
- i, j, h, d, e, n, s: INTEGER;
- k: LONGINT;
- x: REAL;
- BEGIN ch := S.nextCh; i := 0;
- WHILE (ch = " ") OR (ch = TAB) OR (ch = CR) DO
- IF ch = CR THEN INC(S.line) END ;
- Read(S, ch)
- END ;
- IF ("A" <= ch) & (ch <= "Z") OR ("a" <= ch) & (ch <= "z") THEN (*name*)
- REPEAT S.s[i] := ch; INC(i); Read(S, ch)
- UNTIL ((ch < "0") & (ch # ".") OR ("9" < ch) & (ch < "A") OR ("Z" < ch) & (ch < "a") OR ("z" < ch)) OR (i = 31);
- S.s[i] := 0X; S.len := i; S.class := Name
- ELSIF ch = 22X THEN (*string*)
- Read(S, ch);
- WHILE (ch # 22X) & (ch >= " ") & (i # 31) DO S.s[i] := ch; INC(i); Read(S, ch) END;
- S.s[i] := 0X; S.len := i+1; Read(S, ch); S.class := String
- ELSE hex := FALSE;
- IF ch = "-" THEN neg := TRUE; Read(S, ch) ELSE neg := FALSE END ;
- IF ("0" <= ch) & (ch <= "9") THEN (*number*)
- n := ORD(ch) - 30H; h := n; Read(S, ch);
- WHILE ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F") DO
- IF ch <= "9" THEN d := ORD(ch) - 30H ELSE d := ORD(ch) - 37H; hex := TRUE END ;
- n := 10*n + d; h := 10H*h + d; Read(S, ch)
- END ;
- IF ch = "H" THEN (*hex integer*) Read(S, ch); S.i := h; S.class := Int (*neg?*)
- ELSIF ch = "." THEN (*real number*)
- Read(S, ch); x := 0.0; e := 0; j := 0;
- WHILE ("0" <= ch) & (ch <= "9") DO (*fraction*)
- h := 10*n + (ORD(ch) - 30H);
- IF h < maxM THEN n := h; INC(j) END ;
- Read(S, ch)
- END ;
- IF ch = "E" THEN (*scale factor*)
- s := 0; Read(S, ch);
- IF ch = "-" THEN negE := TRUE; Read(S, ch)
- ELSE negE := FALSE;
- IF ch = "+" THEN Read(S, ch) END
- END ;
- WHILE ("0" <= ch) & (ch <= "9") DO
- s := s*10 + ORD(ch) - 30H; Read(S, ch)
- END ;
- IF negE THEN DEC(e, s) ELSE INC(e, s) END ;
- END ;
- (*x := FLT(n);*)
- x := n; (* voc adaptation by noch *)
- DEC(e, j);
- IF e < 0 THEN
- IF e >= -maxExp THEN x := x / Ten(-e) ELSE x := 0.0 END
- ELSIF e > 0 THEN
- IF e <= maxExp THEN x := Ten(e) * x ELSE x := 0.0 END
- END ;
- IF neg THEN S.x := -x ELSE S.x := x END ;
- IF hex THEN S.class := 0 ELSE S.class := Real END
- ELSE (*decimal integer*)
- IF neg THEN S.i := -n ELSE S.i := n END;
- IF hex THEN S.class := Inval ELSE S.class := Int END
- END
- ELSE (*spectal character*) S.class := Char;
- IF neg THEN S.c := "-" ELSE S.c := ch; Read(S, ch) END
- END
- END ;
- S.nextCh := ch
- END Scan;
-
- (* --------------- Access: Writers (NW) ------------------ *)
-
- PROCEDURE OpenWriter* (VAR W: Writer);
- BEGIN NEW(W.buf);
- OpenBuf(W.buf); W.fnt := Fonts.Default; W.col := 15; W.voff := 0;
- Files.Set(W.rider, Files.New(""), 0)
- END OpenWriter;
-
- PROCEDURE SetFont* (VAR W: Writer; fnt: Fonts.Font);
- BEGIN W.fnt := fnt
- END SetFont;
-
- PROCEDURE SetColor* (VAR W: Writer; col: INTEGER);
- BEGIN W.col := col
- END SetColor;
-
- PROCEDURE SetOffset* (VAR W: Writer; voff: INTEGER);
- BEGIN W.voff := voff
- END SetOffset;
-
- PROCEDURE Write* (VAR W: Writer; ch: CHAR);
- VAR p: Piece;
- BEGIN
- IF (W.buf.last.fnt # W.fnt) OR (W.buf.last.col # W.col) OR (W.buf.last.voff # W.voff) THEN
- NEW(p); p.f := Files.Base(W.rider); p.off := Files.Pos(W.rider); p.len := 0;
- p.fnt := W.fnt; p.col := W.col; p.voff:= W.voff;
- p.next := NIL; W.buf.last.next := p;
- p.prev := W.buf.last; W.buf.last := p
- END;
- Files.Write(W.rider, ch);
- INC(W.buf.last.len); INC(W.buf.len)
- END Write;
-
- PROCEDURE WriteLn* (VAR W: Writer);
- BEGIN Write(W, CR)
- END WriteLn;
-
- PROCEDURE WriteString* (VAR W: Writer; s: ARRAY OF CHAR);
- VAR i: INTEGER;
- BEGIN i := 0;
- WHILE s[i] >= " " DO Write(W, s[i]); INC(i) END
- END WriteString;
-
- PROCEDURE WriteInt* (VAR W: Writer; x, n: LONGINT);
- VAR i: INTEGER; x0: LONGINT;
- a: ARRAY 10 OF CHAR;
- BEGIN
- (*IF ROR(x, 31) = 1 THEN WriteString(W, " -2147483648")
- ELSE*) i := 0; (* voc adaptation by noch *)
- IF x < 0 THEN DEC(n); x0 := -x ELSE x0 := x END;
- REPEAT
- a[i] := CHR(x0 MOD 10 + 30H); x0 := x0 DIV 10; INC(i)
- UNTIL x0 = 0;
- WHILE n > i DO Write(W, " "); DEC(n) END;
- IF x < 0 THEN Write(W, "-") END;
- REPEAT DEC(i); Write(W, a[i]) UNTIL i = 0
- (*END*)
- END WriteInt;
-
- PROCEDURE WriteHex* (VAR W: Writer; x: LONGINT);
- VAR i: INTEGER; y: LONGINT;
- a: ARRAY 10 OF CHAR;
- BEGIN i := 0; Write(W, " ");
- REPEAT y := x MOD 10H;
- IF y < 10 THEN a[i] := CHR(y + 30H) ELSE a[i] := CHR(y + 37H) END;
- x := x DIV 10H; INC(i)
- UNTIL i = 8;
- REPEAT DEC(i); Write(W, a[i]) UNTIL i = 0
- END WriteHex;
-(* commented out because it's not necessary to compile OR compiler; -- noch
- PROCEDURE WriteReal* (VAR W: Writer; x: REAL; n: INTEGER);
- VAR e, i, m: INTEGER; x0: REAL; neg: BOOLEAN;
- d: ARRAY 16 OF CHAR;
- BEGIN
- IF x = 0.0 THEN
- WriteString(W, " 0.0"); i := 5;
- WHILE i < n DO Write(W, " "); INC(i) END
- ELSE
- IF x < 0.0 THEN x := -x; neg := TRUE ELSE neg := FALSE END ;
- x0 := x; UNPK(x0, e);
- IF e = 255 THEN WriteString(W, " NaN")
- ELSE
- REPEAT Write(W, " "); DEC(n) UNTIL n <= 14;
- IF neg THEN Write(W, "-") ELSE Write(W, " ") END ;
- e := e * 77 DIV 256 - 6;
- IF e >= 0 THEN x := x / Ten(e) ELSE x := x * Ten(-e) END ;
- IF x >= 10.0E6 THEN x := 0.1*x; INC(e) END ;
- m := FLOOR(x + 0.5); i := 0;
- IF x >= 10.0E6 THEN x := 0.1*x; INC(e) END ;
- REPEAT d[i] := CHR(m MOD 10 + 30H); m := m DIV 10; INC(i) UNTIL m = 0;
- DEC(i); Write(W, d[i]); Write(W, ".");
- IF i < n-6 THEN n := 0 ELSE n := 13-n END ;
- WHILE i > n DO DEC(i); Write(W, d[i]) END ;
- Write(W, "E"); INC(e, 6);
- IF e < 0 THEN Write(W, "-"); e := -e ELSE Write(W, "+") END ;
- Write(W, CHR(e DIV 10 + 30H)); Write(W, CHR(e MOD 10 + 30H))
- END
- END
- END WriteReal;
- *)
- PROCEDURE WriteRealFix* (VAR W: Writer; x: REAL; n, k: INTEGER);
- VAR i, m: INTEGER; neg: BOOLEAN;
- d: ARRAY 12 OF CHAR;
- BEGIN
- IF x = 0.0 THEN WriteString(W, " 0")
- ELSE
- IF x < 0.0 THEN x := -x; neg := TRUE ELSE neg := FALSE END ;
- IF k > 7 THEN k := 7 END ;
- x := Ten(k) * x; m := FLOOR(x + 0.5);
- i := 0;
- REPEAT d[i] := CHR(m MOD 10 + 30H); m := m DIV 10; INC(i) UNTIL m = 0;
- REPEAT Write(W, " "); DEC(n) UNTIL n <= i+3;
- IF neg THEN Write(W, "-"); DEC(n) ELSE Write(W, " ") END ;
- WHILE i > k DO DEC(i); Write(W, d[i]) END ;
- Write(W, ".");
- WHILE k > i DO DEC(k); Write(W, "0") END ;
- WHILE i > 0 DO DEC(i); Write(W, d[i]) END
- END
- END WriteRealFix;
-
- PROCEDURE WritePair(VAR W: Writer; ch: CHAR; x: LONGINT);
- BEGIN Write(W, ch);
- Write(W, CHR(x DIV 10 + 30H)); Write(W, CHR(x MOD 10 + 30H))
- END WritePair;
-
- PROCEDURE WriteClock* (VAR W: Writer; d: LONGINT);
- BEGIN
- WritePair(W, " ", d DIV 20000H MOD 20H); (*day*)
- WritePair(W, ".", d DIV 400000H MOD 10H); (*month*)
- WritePair(W, ".", d DIV 4000000H MOD 40H); (*year*)
- WritePair(W, " ", d DIV 1000H MOD 20H); (*hour*)
- WritePair(W, ":", d DIV 40H MOD 40H); (*min*)
- WritePair(W, ":", d MOD 40H) (*sec*)
- END WriteClock;
-
-BEGIN TrailerFile := Files.New("")
-END CompatTexts.
diff --git a/src/voc07R/Fonts.Mod b/src/voc07R/Fonts.Mod
deleted file mode 100644
index 15dabaf1..00000000
--- a/src/voc07R/Fonts.Mod
+++ /dev/null
@@ -1,146 +0,0 @@
-MODULE Fonts; (*JG 18.11.90; PDR 8.6.12; NW 25.3.2013*)
- IMPORT SYSTEM, Files := CompatFiles;
-
- TYPE INTEGER = LONGINT; (* voc adaptation by noch *)
- BYTE = CHAR;
-
- CONST FontFileId = 0DBH;
-
- TYPE Font* = POINTER TO FontDesc;
- FontDesc* = RECORD
- name*: ARRAY 32 OF CHAR;
- height*, minX*, maxX*, minY*, maxY*: INTEGER;
- next*: Font;
- T: ARRAY 128 OF INTEGER;
- raster: ARRAY 2360 OF BYTE
- END ;
-
- LargeFontDesc = RECORD (FontDesc) ext: ARRAY 2560 OF BYTE END ;
- LargeFont = POINTER TO LargeFontDesc;
-
- (* raster sizes: Syntax8 1367, Syntax10 1628, Syntax12 1688, Syntax14 1843, Syntax14b 1983,
- Syntax16 2271, Syntax20 3034, Syntac24 4274, Syntax24b 4302 *)
-
-VAR Default*, root*: Font;
-
-PROCEDURE GetPat*(fnt: Font; ch: CHAR; VAR dx, x, y, w, h, patadr: INTEGER);
- VAR pa: INTEGER; dxb, xb, yb, wb, hb: BYTE;
-BEGIN pa := fnt.T[ORD(ch) MOD 80H]; patadr := pa;
- SYSTEM.GET(pa-3, dxb); SYSTEM.GET(pa-2, xb); SYSTEM.GET(pa-1, yb); SYSTEM.GET(pa, wb); SYSTEM.GET(pa+1, hb);
- (*dx := dxb;*)
- dx := ORD(dxb); (* voc adaptation by noch *)
- (*x := xb;*)
- x := ORD(xb); (* voc adaptation by noch *)
- (*y := yb;*)
- y := ORD(yb); (* voc adaptation by noch *)
- (*w := wb;*)
- w := ORD(wb); (* voc adaptation by noch *)
- (*h := hb;*)
- h := ORD(hb); (* voc adaptation by noch *)
- (*IF yb < 128 THEN y := yb ELSE y := yb - 256 END*)
- IF ORD(yb) < 128 THEN y := ORD(yb) ELSE y := ORD(yb) - 256 END (* voc adaptation by noch *)
-END GetPat;
-
-PROCEDURE This*(name: ARRAY OF CHAR): Font;
-
- TYPE RunRec = RECORD beg, end: BYTE END ;
- BoxRec = RECORD dx, x, y, w, h: BYTE END ;
-
- VAR F: Font; LF: LargeFont;
- f: Files.File; R: Files.Rider;
- NofRuns, NofBoxes: BYTE;
- NofBytes: INTEGER;
- height, minX, maxX, minY, maxY: BYTE;
- i, j, k, m, n: INTEGER;
- a, a0: INTEGER;
- b, beg, end: BYTE;
- run: ARRAY 16 OF RunRec;
- box: ARRAY 512 OF BoxRec;
-
- PROCEDURE RdInt16(VAR R: Files.Rider; VAR b0: BYTE);
- VAR b1: BYTE;
- BEGIN Files.ReadByte(R, b0); Files.ReadByte(R, b1)
- END RdInt16;
-
-BEGIN F := root;
- WHILE (F # NIL) & (name # F.name) DO F := F.next END;
- IF F = NIL THEN
- f := Files.Old(name);
- IF f # NIL THEN
- Files.Set(R, f, 0); Files.ReadByte(R, b);
- (*IF b = FontFileId THEN*)
- IF ORD(b) = FontFileId THEN (* voc adaptation by noch *)
- Files.ReadByte(R, b); (*abstraction*)
- Files.ReadByte(R, b); (*family*)
- Files.ReadByte(R, b); (*variant*)
- NEW(F);
- (*F.name := name;*)
- COPY(name, F.name); (* voc adaptation by noch *)
- RdInt16(R, height); RdInt16(R, minX); RdInt16(R, maxX); RdInt16(R, minY); RdInt16(R, maxY); RdInt16(R, NofRuns);
- (*NofBoxes := 0;*) (* voc adaptation by noch *)
- NofBoxes := 0X;
- k := 0;
- (*WHILE k # NofRuns DO*)
- WHILE k # ORD(NofRuns) DO (* voc adaptation by noch *)
- RdInt16(R, beg);
- run[k].beg := beg; RdInt16(R, end);
- run[k].end := end;
- (*NofBoxes := NofBoxes + end - beg;*)
- NofBoxes := CHR(ORD(NofBoxes) + ORD(end) - ORD(beg)); (* voc adaptation by noch *)
- INC(k)
- END;
- NofBytes := 5; j := 0;
- (*WHILE j # NofBoxes DO*)
- WHILE j # ORD(NofBoxes) DO (* voc adaptation by noch *)
- RdInt16(R, box[j].dx); RdInt16(R, box[j].x); RdInt16(R, box[j].y);
- RdInt16(R, box[j].w); RdInt16(R, box[j].h);
- (*NofBytes := NofBytes + 5 + (box[j].w + 7) DIV 8 * box[j].h;*)
- NofBytes := (NofBytes + 5 + (ORD(box[j].w) + 7) DIV 8 * ORD(box[j].h)); (* voc adaptation by noch *)
- INC(j)
- END;
- IF NofBytes < 2300 THEN NEW(F) ELSE NEW(LF); F := LF END ;
- (*F.name := name;*)
- COPY(name, F.name); (* voc adaptation by noch *)
- (*F.height := height; F.minX := minX; F.maxX := maxX; F.maxY := maxY;*)
- F.height := ORD(height); F.minX := ORD(minX); F.maxX := ORD(maxX); F.maxY := ORD(maxY); (* voc adaptation by noch *)
- (*IF minY >= 80H THEN F.minY := minY - 100H ELSE F.minY := minY END ;*)
- IF ORD(minY) >= 80H THEN F.minY := ORD(minY) - 100H ELSE F.minY := ORD(minY) END ; (* voc adaptation by noch *)
- a0 := SYSTEM.ADR(F.raster);
- SYSTEM.PUT(a0, 0X); SYSTEM.PUT(a0+1, 0X); SYSTEM.PUT(a0+2, 0X); SYSTEM.PUT(a0+3, 0X); SYSTEM.PUT(a0+4, 0X);
- (*null pattern for characters not in a run*)
- INC(a0, 2); a := a0+3; j := 0; k := 0; m := 0;
- (*WHILE k < NofRuns DO*)
- WHILE k < ORD(NofRuns) DO
- (*WHILE (m < run[k].beg) & (m < 128) DO F.T[m] := a0; INC(m) END;*)
- WHILE (m < ORD(run[k].beg)) & (m < 128) DO F.T[m] := a0; INC(m) END; (* voc adaptation by noch *)
- (*WHILE (m < run[k].end) & (m < 128) DO*) (* voc adaptation by noch *)
- WHILE (m < ORD(run[k].end)) & (m < 128) DO
- F.T[m] := a+3;
- SYSTEM.PUT(a, box[j].dx); SYSTEM.PUT(a+1, box[j].x); SYSTEM.PUT(a+2, box[j].y);
- SYSTEM.PUT(a+3, box[j].w); SYSTEM.PUT(a+4, box[j].h); INC(a, 5);
- (*n := (box[j].w + 7) DIV 8 * box[j].h;*)
- n := (ORD(box[j].w) + 7) DIV 8 * ORD(box[j].h); (* voc adaptation by noch *)
- WHILE n # 0 DO DEC(n); Files.ReadByte(R, b); SYSTEM.PUT(a, b); INC(a) END ;
- INC(j); INC(m)
- END;
- INC(k)
- END;
- WHILE m < 128 DO F.T[m] := a0; INC(m) END ;
- F.next := root; root := F
- ELSE (*bad file id*) F := Default
- END
- ELSE (*font file not available*) F := Default
- END
- END;
- RETURN F
-END This;
-
-PROCEDURE Free*; (*remove all but first two from font list*)
- VAR f: Font;
-BEGIN f := root.next;
- IF f # NIL THEN f := f.next END ;
- f.next := NIL
-END Free;
-
-BEGIN root := NIL; Default := This("Oberon10.Scn.Fnt")
-END Fonts.
diff --git a/src/voc07R/ORB.Mod b/src/voc07R/ORB.Mod
deleted file mode 100644
index 3427bb2e..00000000
--- a/src/voc07R/ORB.Mod
+++ /dev/null
@@ -1,447 +0,0 @@
-MODULE ORB; (*NW 25.6.2014 in Oberon-07*)
- IMPORT Files := CompatFiles (* voc adaptation by noch *)
- , ORS;
- (*Definition of data types Object and Type, which together form the data structure
- called "symbol table". Contains procedures for creation of Objects, and for search:
- NewObj, this, thisimport, thisfield (and OpenScope, CloseScope).
- Handling of import and export, i.e. reading and writing of "symbol files" is done by procedures
- Import and Export. This module contains the list of standard identifiers, with which
- the symbol table (universe), and that of the pseudo-module SYSTEM are initialized. *)
-
- TYPE INTEGER = LONGINT; (* voc adaptation by noch *)
- BYTE = CHAR;
-
- CONST versionkey* = 1; maxTypTab = 64;
- (* class values*) Head* = 0;
- Const* = 1; Var* = 2; Par* = 3; Fld* = 4; Typ* = 5;
- SProc* = 6; SFunc* = 7; Mod* = 8;
-
- (* form values*)
- Byte* = 1; Bool* = 2; Char* = 3; Int* = 4; Real* = 5; Set* = 6;
- Pointer* = 7; NilTyp* = 8; NoTyp* = 9; Proc* = 10;
- String* = 11; Array* = 12; Record* = 13;
-
- TYPE Object* = POINTER TO ObjDesc;
- Module* = POINTER TO ModDesc;
- Type* = POINTER TO TypeDesc;
-
- ObjDesc*= RECORD
- class*, lev*, exno*: INTEGER;
- expo*, rdo*: BOOLEAN; (*exported / read-only*)
- next*, dsc*: Object;
- type*: Type;
- name*: ORS.Ident;
- val*: LONGINT
- END ;
-
- ModDesc* = RECORD (ObjDesc) orgname*: ORS.Ident END ;
-
- TypeDesc* = RECORD
- form*, ref*, mno*: INTEGER; (*ref is only used for import/export*)
- nofpar*: INTEGER; (*for procedures, extension level for records*)
- len*: LONGINT; (*for arrays, len < 0 => open array; for records: adr of descriptor*)
- dsc*, typobj*: Object;
- base*: Type; (*for arrays, records, pointers*)
- size*: LONGINT; (*in bytes; always multiple of 4, except for Byte, Bool and Char*)
- END ;
-
- (* Object classes and the meaning of "val":
- class val
- ----------
- Var address
- Par address
- Const value
- Fld offset
- Typ type descriptor (TD) address
- SProc inline code number
- SFunc inline code number
- Mod key
-
- Type forms and the meaning of "dsc" and "base":
- form dsc base
- ------------------------
- Pointer - type of dereferenced object
- Proc params result type
- Array - type of elements
- Record fields extension *)
-
- VAR topScope*, universe, system*: Object;
- byteType*, boolType*, charType*: Type;
- intType*, realType*, setType*, nilType*, noType*, strType*: Type;
- nofmod, Ref: INTEGER;
- typtab: ARRAY maxTypTab OF Type;
-
- PROCEDURE NewObj*(VAR obj: Object; id: ORS.Ident; class: INTEGER); (*insert new Object with name id*)
- VAR new, x: Object;
- BEGIN x := topScope;
- WHILE (x.next # NIL) & (x.next.name # id) DO x := x.next END ;
- IF x.next = NIL THEN
- NEW(new); new.name := id; new.class := class; new.next := NIL; new.rdo := FALSE; new.dsc := NIL;
- x.next := new; obj := new
- ELSE obj := x.next; ORS.Mark("mult def")
- END
- END NewObj;
-
- PROCEDURE thisObj*(): Object;
- VAR s, x: Object;
- BEGIN s := topScope;
- REPEAT x := s.next;
- WHILE (x # NIL) & (x.name # ORS.id) DO x := x.next END ;
- s := s.dsc
- UNTIL (x # NIL) OR (s = NIL);
- RETURN x
- END thisObj;
-
- PROCEDURE thisimport*(mod: Object): Object;
- VAR obj: Object;
- BEGIN
- IF mod.rdo THEN
- IF mod.name[0] # 0X THEN
- obj := mod.dsc;
- WHILE (obj # NIL) & (obj.name # ORS.id) DO obj := obj.next END
- ELSE obj := NIL
- END
- ELSE obj := NIL
- END ;
- RETURN obj
- END thisimport;
-
- PROCEDURE thisfield*(rec: Type): Object;
- VAR fld: Object;
- BEGIN fld := rec.dsc;
- WHILE (fld # NIL) & (fld.name # ORS.id) DO fld := fld.next END ;
- RETURN fld
- END thisfield;
-
- PROCEDURE OpenScope*;
- VAR s: Object;
- BEGIN NEW(s); s.class := Head; s.dsc := topScope; s.next := NIL; topScope := s
- END OpenScope;
-
- PROCEDURE CloseScope*;
- BEGIN topScope := topScope.dsc
- END CloseScope;
-
- (*------------------------------- Import ---------------------------------*)
-
- PROCEDURE MakeFileName*(VAR FName: ORS.Ident; name, ext: ARRAY OF CHAR);
- VAR i, j: INTEGER;
- BEGIN i := 0; j := 0; (*assume name suffix less than 4 characters*)
- WHILE (i < ORS.IdLen-5) & (name[i] > 0X) DO FName[i] := name[i]; INC(i) END ;
- REPEAT FName[i]:= ext[j]; INC(i); INC(j) UNTIL ext[j] = 0X;
- FName[i] := 0X
- END MakeFileName;
-
- PROCEDURE ThisModule(name, orgname: ORS.Ident; non: BOOLEAN; key: LONGINT): Object;
- VAR mod: Module; obj, obj1: Object;
- BEGIN obj1 := topScope; obj := obj1.next; (*search for module*)
- WHILE (obj # NIL) & (obj.name # name) DO obj1 := obj; obj := obj1.next END ;
- IF obj = NIL THEN (*insert new module*)
- NEW(mod); mod.class := Mod; mod.rdo := FALSE;
- mod.name := name; mod.orgname := orgname; mod.val := key;
- mod.lev := nofmod; INC(nofmod); mod.type := noType; mod.dsc := NIL; mod.next := NIL;
- obj1.next := mod; obj := mod
- ELSE (*module already present*)
- IF non THEN ORS.Mark("invalid import order") END
- END ;
- RETURN obj
- END ThisModule;
-
- PROCEDURE Read(VAR R: Files.Rider; VAR x: INTEGER);
- VAR b: BYTE;
- BEGIN Files.ReadByte(R, b);
- (*IF b < 80H THEN x := b ELSE x := b - 100H END*)
- IF b < 80X THEN x := ORD(b) ELSE x := ORD(b) - 100H END (* voc adaptation by noch *)
- END Read;
-
- PROCEDURE InType(VAR R: Files.Rider; thismod: Object; VAR T: Type);
- VAR key: LONGINT;
- ref, class, mno, form, np, readonly: INTEGER;
- new, fld, par, obj, mod, impmod: Object;
- t: Type;
- name, modname: ORS.Ident;
- BEGIN Read(R, ref);
- IF ref < 0 THEN T := typtab[-ref] (*already read*)
- ELSE NEW(t); T := t; typtab[ref] := t; t.mno := thismod.lev;
- Read(R, form); t.form := form;
- IF form = Pointer THEN InType(R, thismod, t.base); t.size := 4
- ELSIF form = Array THEN
- InType(R, thismod, t.base); Files.ReadNum(R, t.len); Files.ReadNum(R, t.size)
- ELSIF form = Record THEN
- InType(R, thismod, t.base);
- IF t.base.form = NoTyp THEN t.base := NIL; obj := NIL ELSE obj := t.base.dsc END ;
- Files.ReadNum(R, t.len); (*TD adr/exno*)
- Files.ReadNum(R, t.nofpar); (*ext level*)
- Files.ReadNum(R, t.size);
- Read(R, class);
- WHILE class # 0 DO (*fields*)
- NEW(fld); fld.class := class; Files.ReadString(R, fld.name);
- IF fld.name[0] # 0X THEN fld.expo := TRUE; InType(R, thismod, fld.type) ELSE fld.expo := FALSE; fld.type := nilType END ;
- Files.ReadNum(R, fld.val); fld.next := obj; obj := fld; Read(R, class)
- END ;
- t.dsc := obj
- ELSIF form = Proc THEN
- InType(R, thismod, t.base);
- obj := NIL; np := 0; Read(R, class);
- WHILE class # 0 DO (*parameters*)
- NEW(par); par.class := class; Read(R, readonly); par.rdo := readonly = 1;
- InType(R, thismod, par.type); par.next := obj; obj := par; INC(np); Read(R, class)
- END ;
- t.dsc := obj; t.nofpar := np; t.size := 4
- END ;
- Files.ReadString(R, modname);
- IF modname[0] # 0X THEN (*re-import*)
- Files.ReadInt(R, key); Files.ReadString(R, name);
- mod := ThisModule(modname, modname, FALSE, key);
- obj := mod.dsc; (*search type*)
- WHILE (obj # NIL) & (obj.name # name) DO obj := obj.next END ;
- IF obj # NIL THEN T := obj.type (*type object found in object list of mod*)
- ELSE (*insert new type object in object list of mod*)
- NEW(obj); obj.name := name; obj.class := Typ; obj.next := mod.dsc; mod.dsc := obj; obj.type := t;
- t.mno := mod.lev; t.typobj := obj; T := t
- END ;
- typtab[ref] := T
- END
- END
- END InType;
-
- PROCEDURE Import*(VAR modid, modid1: ORS.Ident);
- VAR key: LONGINT; class, k: INTEGER;
- obj: Object; t: Type;
- thismod: Object;
- modname, fname: ORS.Ident;
- F: Files.File; R: Files.Rider;
- BEGIN
- IF modid1 = "SYSTEM" THEN
- thismod := ThisModule(modid, modid1, TRUE, key); DEC(nofmod);
- thismod.lev := 0; thismod.dsc := system; thismod.rdo := TRUE
- ELSE MakeFileName(fname, modid1, ".smb"); F := Files.Old(fname);
- IF F # NIL THEN
- Files.Set(R, F, 0); Files.ReadInt(R, key); Files.ReadInt(R, key); Files.ReadString(R, modname);
- thismod := ThisModule(modid, modid1, TRUE, key); thismod.rdo := TRUE;
- Read(R, class); (*version key*)
- IF class # versionkey THEN ORS.Mark("wrong version") END ;
- Read(R, class);
- WHILE class # 0 DO
- NEW(obj); obj.class := class; Files.ReadString(R, obj.name);
- InType(R, thismod, obj.type); obj.lev := -thismod.lev;
- IF class = Typ THEN
- t := obj.type; t.typobj := obj; Read(R, k); (*fixup bases of previously declared pointer types*)
- WHILE k # 0 DO typtab[k].base := t; Read(R, k) END
- ELSE
- IF class = Const THEN
- IF obj.type.form = Real THEN Files.ReadInt(R, obj.val) ELSE Files.ReadNum(R, obj.val) END
- ELSIF class = Var THEN Files.ReadNum(R, obj.val); obj.rdo := TRUE
- END
- END ;
- obj.next := thismod.dsc; thismod.dsc := obj; Read(R, class)
- END ;
- ELSE ORS.Mark("import not available")
- END
- END
- END Import;
-
- (*-------------------------------- Export ---------------------------------*)
-
- PROCEDURE Write(VAR R: Files.Rider; x: INTEGER);
- BEGIN
- (*Files.WriteByte(R, x)*)
- Files.WriteByte(R, SHORT(SHORT(x))) (* voc adaptation by noch *)
- END Write;
-
- PROCEDURE OutType(VAR R: Files.Rider; t: Type);
- VAR obj, mod, fld: Object;
-
- PROCEDURE OutPar(VAR R: Files.Rider; par: Object; n: INTEGER);
- VAR cl: INTEGER;
- BEGIN
- IF n > 0 THEN
- OutPar(R, par.next, n-1); cl := par.class;
- Write(R, cl);
- IF par.rdo THEN Write(R, 1) ELSE Write(R, 0) END ;
- OutType(R, par.type)
- END
- END OutPar;
-
- PROCEDURE FindHiddenPointers(VAR R: Files.Rider; typ: Type; offset: LONGINT);
- VAR fld: Object; i, n: LONGINT;
- BEGIN
- IF (typ.form = Pointer) OR (typ.form = NilTyp) THEN Write(R, Fld); Write(R, 0); Files.WriteNum(R, offset)
- ELSIF typ.form = Record THEN fld := typ.dsc;
- WHILE fld # NIL DO FindHiddenPointers(R, fld.type, fld.val + offset); fld := fld.next END
- ELSIF typ.form = Array THEN i := 0; n := typ.len;
- WHILE i < n DO FindHiddenPointers(R, typ.base, typ.base.size * i + offset); INC(i) END
- END
- END FindHiddenPointers;
-
- BEGIN
- IF t.ref > 0 THEN (*type was already output*) Write(R, -t.ref)
- ELSE obj := t.typobj;
- IF obj # NIL THEN Write(R, Ref); t.ref := Ref; INC(Ref) ELSE (*anonymous*) Write(R, 0) END ;
- Write(R, t.form);
- IF t.form = Pointer THEN OutType(R, t.base)
- ELSIF t.form = Array THEN OutType(R, t.base); Files.WriteNum(R, t.len); Files.WriteNum(R, t.size)
- ELSIF t.form = Record THEN
- IF t.base # NIL THEN OutType(R, t.base) ELSE OutType(R, noType) END ;
- IF obj # NIL THEN Files.WriteNum(R, obj.exno) ELSE Write(R, 0) END ;
- Files.WriteNum(R, t.nofpar); Files.WriteNum(R, t.size);
- fld := t.dsc;
- WHILE fld # NIL DO (*fields*)
- IF fld.expo THEN
- Write(R, Fld); Files.WriteString(R, fld.name); OutType(R, fld.type); Files.WriteNum(R, fld.val)
- ELSE FindHiddenPointers(R, fld.type, fld.val) (*offset*)
- END ;
- fld := fld.next
- END ;
- Write(R, 0)
- ELSIF t.form = Proc THEN OutType(R, t.base); OutPar(R, t.dsc, t.nofpar); Write(R, 0)
- END ;
- IF (t.mno > 0) & (obj # NIL) THEN (*re-export, output name*)
- mod := topScope.next;
- WHILE (mod # NIL) & (mod.lev # t.mno) DO mod := mod.next END ;
- IF mod # NIL THEN Files.WriteString(R, mod.name); Files.WriteInt(R, mod.val); Files.WriteString(R, obj.name)
- ELSE ORS.Mark("re-export not found"); Write(R, 0)
- END
- ELSE Write(R, 0)
- END
- END
- END OutType;
-
- PROCEDURE Export*(VAR modid: ORS.Ident; VAR newSF: BOOLEAN; VAR key: LONGINT);
- VAR x, sum, oldkey: LONGINT;
- obj, obj0: Object;
- filename: ORS.Ident;
- F, F1: Files.File; R, R1: Files.Rider;
- BEGIN Ref := Record + 1; MakeFileName(filename, modid, ".smb");
- F := Files.New(filename); Files.Set(R, F, 0);
- Files.WriteInt(R, 0); (*placeholder*)
- Files.WriteInt(R, 0); (*placeholder for key to be inserted at the end*)
- Files.WriteString(R, modid); Write(R, versionkey);
- obj := topScope.next;
- WHILE obj # NIL DO
- IF obj.expo THEN
- Write(R, obj.class); Files.WriteString(R, obj.name);
- OutType(R, obj.type);
- IF obj.class = Typ THEN
- IF obj.type.form = Record THEN
- obj0 := topScope.next; (*check whether this is base of previously declared pointer types*)
- WHILE obj0 # obj DO
- IF (obj0.type.form = Pointer) & (obj0.type.base = obj.type) & (obj0.type.ref > 0) THEN Write(R, obj0.type.ref) END ;
- obj0 := obj0.next
- END
- END ;
- Write(R, 0)
- ELSIF obj.class = Const THEN
- IF obj.type.form = Proc THEN Files.WriteNum(R, obj.exno)
- ELSIF obj.type.form = Real THEN Files.WriteInt(R, obj.val)
- ELSE Files.WriteNum(R, obj.val)
- END
- ELSIF obj.class = Var THEN
- Files.WriteNum(R, obj.exno);
- IF obj.type.form = String THEN
- Files.WriteNum(R, obj.val DIV 10000H); obj.val := obj.val MOD 10000H
- END
- END
- END ;
- obj := obj.next
- END ;
- REPEAT Write(R, 0) UNTIL Files.Length(F) MOD 4 = 0;
- FOR Ref := Record+1 TO maxTypTab-1 DO typtab[Ref] := NIL END ;
- Files.Set(R, F, 0); sum := 0; Files.ReadInt(R, x); (* compute key (checksum) *)
- WHILE ~R.eof DO sum := sum + x; Files.ReadInt(R, x) END ;
- F1 := Files.Old(filename); (*sum is new key*)
- IF F1 # NIL THEN Files.Set(R1, F1, 4); Files.ReadInt(R1, oldkey) ELSE oldkey := sum+1 END ;
- IF sum # oldkey THEN
- IF newSF OR (F1 = NIL) THEN
- key := sum; newSF := TRUE; Files.Set(R, F, 4); Files.WriteInt(R, sum); Files.Register(F) (*insert checksum*)
- ELSE ORS.Mark("new symbol file inhibited")
- END
- ELSE newSF := FALSE; key := sum
- END
- END Export;
-
- PROCEDURE Init*;
- BEGIN topScope := universe; nofmod := 1
- END Init;
-
- PROCEDURE type(ref, form: INTEGER; size: LONGINT): Type;
- VAR tp: Type;
- BEGIN NEW(tp); tp.form := form; tp.size := size; tp.ref := ref; tp.base := NIL;
- typtab[ref] := tp; RETURN tp
- END type;
-
- PROCEDURE enter(name: ARRAY OF CHAR; cl: INTEGER; type: Type; n: LONGINT);
- VAR obj: Object;
- BEGIN
- NEW(obj);
- (*obj.name := name; *)
- COPY(name, obj.name); (* voc adaptation by noch *)
- obj.class := cl;
- obj.type := type;
- obj.val := n;
- obj.dsc := NIL;
- IF cl = Typ THEN type.typobj := obj END ;
- obj.next := system; system := obj
- END enter;
-
-BEGIN
- byteType := type(Byte, Int, 1);
- boolType := type(Bool, Bool, 1);
- charType := type(Char, Char,1);
- intType := type(Int, Int, 4);
- realType := type(Real, Real, 4);
- setType := type(Set, Set,4);
- nilType := type(NilTyp, NilTyp, 4);
- noType := type(NoTyp, NoTyp, 4);
- strType := type(String, String, 8);
-
- (*initialize universe with data types and in-line procedures;
- LONGINT is synonym to INTEGER, LONGREAL to REAL.
- LED, ADC, SBC; LDPSR, LDREG, REG, COND are not in language definition*)
- system := NIL; (*n = procno*10 + nofpar*)
- enter("UML", SFunc, intType, 132); (*functions*)
- enter("SBC", SFunc, intType, 122);
- enter("ADC", SFunc, intType, 112);
- enter("ROR", SFunc, intType, 92);
- enter("ASR", SFunc, intType, 82);
- enter("LSL", SFunc, intType, 72);
- enter("LEN", SFunc, intType, 61);
- enter("CHR", SFunc, charType, 51);
- enter("ORD", SFunc, intType, 41);
- enter("FLT", SFunc, realType, 31);
- enter("FLOOR", SFunc, intType, 21);
- enter("ODD", SFunc, boolType, 11);
- enter("ABS", SFunc, intType, 1);
- enter("LED", SProc, noType, 81); (*procedures*)
- enter("UNPK", SProc, noType, 72);
- enter("PACK", SProc, noType, 62);
- enter("NEW", SProc, noType, 51);
- enter("ASSERT", SProc, noType, 41);
- enter("EXCL", SProc, noType, 32);
- enter("INCL", SProc, noType, 22);
- enter("DEC", SProc, noType, 11);
- enter("INC", SProc, noType, 1);
- enter("SET", Typ, setType, 0); (*types*)
- enter("BOOLEAN", Typ, boolType, 0);
- enter("BYTE", Typ, byteType, 0);
- enter("CHAR", Typ, charType, 0);
- enter("LONGREAL", Typ, realType, 0);
- enter("REAL", Typ, realType, 0);
- enter("LONGINT", Typ, intType, 0);
- enter("INTEGER", Typ, intType, 0);
- topScope := NIL; OpenScope; topScope.next := system; universe := topScope;
-
- system := NIL; (* initialize "unsafe" pseudo-module SYSTEM*)
- enter("H", SFunc, intType, 201); (*functions*)
- enter("COND", SFunc, boolType, 191);
- enter("SIZE", SFunc, intType, 181);
- enter("ADR", SFunc, intType, 171);
- enter("VAL", SFunc, intType, 162);
- enter("REG", SFunc, intType, 151);
- enter("BIT", SFunc, boolType, 142);
- enter("LDREG", SProc, noType, 142); (*procedures*)
- enter("LDPSR", SProc, noType, 131);
- enter("COPY", SProc, noType, 123);
- enter("PUT", SProc, noType, 112);
- enter("GET", SProc, noType, 102);
-END ORB.
diff --git a/src/voc07R/ORG.Mod b/src/voc07R/ORG.Mod
deleted file mode 100644
index fef42932..00000000
--- a/src/voc07R/ORG.Mod
+++ /dev/null
@@ -1,1134 +0,0 @@
-MODULE ORG; (* NW 24.6.2014 code generator in Oberon-07 for RISC*)
- IMPORT SYSTEM, Files := CompatFiles, ORS, ORB;
- (*Code generator for Oberon compiler for RISC processor.
- Procedural interface to Parser OSAP; result in array "code".
- Procedure Close writes code-files*)
-
- (* voc adaptation by noch *)
- TYPE INTEGER = LONGINT;
- BYTE = CHAR;
-
- CONST WordSize* = 4;
- StkOrg0 = -64; VarOrg0 = 0; (*for RISC-0 only*)
- MT = 12; SB = 13; SP = 14; LNK = 15; (*dedicated registers*)
- maxCode = 8000; maxStrx = 2400; maxTD = 120; C24 = 1000000H;
- Reg = 10; RegI = 11; Cond = 12; (*internal item modes*)
-
- (*frequently used opcodes*) U = 2000H; V = 1000H;
- Mov = 0; Lsl = 1; Asr = 2; Ror= 3; And = 4; Ann = 5; Ior = 6; Xor = 7;
- Add = 8; Sub = 9; Cmp = 9; Mul = 10; Div = 11;
- Fad = 12; Fsb = 13; Fml = 14; Fdv = 15;
- Ldr = 8; Str = 10;
- BR = 0; BLR = 1; BC = 2; BL = 3;
- MI = 0; PL = 8; EQ = 1; NE = 9; LT = 5; GE = 13; LE = 6; GT = 14;
-
- TYPE Item* = RECORD
- mode*: INTEGER;
- type*: ORB.Type;
- a*, b*, r: LONGINT;
- rdo*: BOOLEAN (*read only*)
- END ;
-
- (* Item forms and meaning of fields:
- mode r a b
- --------------------------------
- Const - value (proc adr) (immediate value)
- Var base off - (direct adr)
- Par - off0 off1 (indirect adr)
- Reg regno
- RegI regno off -
- Cond cond Fchain Tchain *)
-
- VAR pc*, varsize: LONGINT; (*program counter, data index*)
- tdx, strx: LONGINT;
- entry: LONGINT; (*main entry point*)
- RH: LONGINT; (*available registers R[0] ... R[H-1]*)
- curSB: LONGINT; (*current static base in SB*)
- frame: LONGINT; (*frame offset changed in SaveRegs and RestoreRegs*)
- fixorgP, fixorgD, fixorgT: LONGINT; (*origins of lists of locations to be fixed up by loader*)
- check: BOOLEAN; (*emit run-time checks*)
- version: INTEGER; (* 0 = RISC-0, 1 = RISC-5 *)
-
- relmap: ARRAY 6 OF INTEGER; (*condition codes for relations*)
- code: ARRAY maxCode OF LONGINT;
- data: ARRAY maxTD OF LONGINT; (*type descriptors*)
- str: ARRAY maxStrx OF CHAR;
-
- (* voc adaptation by noch *)
- PROCEDURE LSL (x, n : INTEGER): INTEGER;
-
- BEGIN
-
- RETURN ASH(x, n);
- END LSL;
-
-
- (*instruction assemblers according to formats*)
-
- PROCEDURE Put0(op, a, b, c: LONGINT);
- BEGIN (*emit format-0 instruction*)
- code[pc] := ((a*10H + b) * 10H + op) * 10000H + c; INC(pc)
- END Put0;
-
- PROCEDURE Put1(op, a, b, im: LONGINT);
- BEGIN (*emit format-1 instruction, -10000H <= im < 10000H*)
- IF im < 0 THEN INC(op, V) END ;
- code[pc] := (((a+40H) * 10H + b) * 10H + op) * 10000H + (im MOD 10000H); INC(pc)
- END Put1;
-
- PROCEDURE Put1a(op, a, b, im: LONGINT);
- BEGIN (*same as Pu1, but with range test -10000H <= im < 10000H*)
- IF (im >= -10000H) & (im <= 0FFFFH) THEN Put1(op, a, b, im)
- ELSE Put1(Mov+U, RH, 0, im DIV 10000H);
- IF im MOD 10000H # 0 THEN Put1(Ior, RH, RH, im MOD 10000H) END ;
- Put0(op, a, b, RH)
- END
- END Put1a;
-
- PROCEDURE Put2(op, a, b, off: LONGINT);
- BEGIN (*emit load/store instruction*)
- code[pc] := ((op * 10H + a) * 10H + b) * 100000H + (off MOD 100000H); INC(pc)
- END Put2;
-
- PROCEDURE Put3(op, cond, off: LONGINT);
- BEGIN (*emit branch instruction*)
- code[pc] := ((op+12) * 10H + cond) * 1000000H + (off MOD 1000000H); INC(pc)
- END Put3;
-
- PROCEDURE incR;
- BEGIN
- IF RH < MT-1 THEN INC(RH) ELSE ORS.Mark("register stack overflow") END
- END incR;
-
- PROCEDURE CheckRegs*;
- BEGIN
- IF RH # 0 THEN ORS.Mark("Reg Stack"); RH := 0 END ;
- IF pc >= maxCode - 40 THEN ORS.Mark("Program too long") END
- END CheckRegs;
-
- PROCEDURE SetCC(VAR x: Item; n: LONGINT);
- BEGIN x.mode := Cond; x.a := 0; x.b := 0; x.r := n
- END SetCC;
-
- PROCEDURE Trap(cond, num: LONGINT);
- BEGIN num := ORS.Pos()*100H + num*10H + MT; Put3(BLR, cond, num)
- END Trap;
-
- (*handling of forward reference, fixups of branch addresses and constant tables*)
-
- PROCEDURE negated(cond: LONGINT): LONGINT;
- BEGIN
- IF cond < 8 THEN cond := cond+8 ELSE cond := cond-8 END ;
- RETURN cond
- END negated;
-
- PROCEDURE invalSB;
- BEGIN curSB := 1
- END invalSB;
-
- PROCEDURE fix(at, with: LONGINT);
- BEGIN code[at] := code[at] DIV C24 * C24 + (with MOD C24)
- END fix;
-
- PROCEDURE FixLink*(L: LONGINT);
- VAR L1: LONGINT;
- BEGIN invalSB;
- WHILE L # 0 DO L1 := code[L] MOD 40000H; fix(L, pc-L-1); L := L1 END
- END FixLink;
-
- PROCEDURE FixLinkWith(L0, dst: LONGINT);
- VAR L1: LONGINT;
- BEGIN
- WHILE L0 # 0 DO
- L1 := code[L0] MOD C24;
- code[L0] := code[L0] DIV C24 * C24 + ((dst - L0 - 1) MOD C24); L0 := L1
- END
- END FixLinkWith;
-
- PROCEDURE merged(L0, L1: LONGINT): LONGINT;
- VAR L2, L3: LONGINT;
- BEGIN
- IF L0 # 0 THEN L3 := L0;
- REPEAT L2 := L3; L3 := code[L2] MOD 40000H UNTIL L3 = 0;
- code[L2] := code[L2] + L1; L1 := L0
- END ;
- RETURN L1
- END merged;
-
- (* loading of operands and addresses into registers *)
-
- PROCEDURE GetSB(base: LONGINT);
- BEGIN
- IF (version # 0) & ((base # curSB) OR (base # 0)) THEN
- Put2(Ldr, SB, -base, pc-fixorgD); fixorgD := pc-1; curSB := base
- END
- END GetSB;
-
- PROCEDURE NilCheck;
- BEGIN IF check THEN Trap(EQ, 4) END
- END NilCheck;
-
- PROCEDURE load(VAR x: Item);
- VAR op: LONGINT;
- BEGIN
- IF x.type.size = 1 THEN op := Ldr+1 ELSE op := Ldr END ;
- IF x.mode # Reg THEN
- IF x.mode = ORB.Const THEN
- IF x.type.form = ORB.Proc THEN
- IF x.r > 0 THEN ORS.Mark("not allowed")
- ELSIF x.r = 0 THEN Put3(BL, 7, 0); Put1a(Sub, RH, LNK, pc*4 - x.a)
- ELSE GetSB(x.r); Put1(Add, RH, SB, x.a + 100H) (*mark as progbase-relative*)
- END
- ELSIF (x.a <= 0FFFFH) & (x.a >= -10000H) THEN Put1(Mov, RH, 0, x.a)
- ELSE Put1(Mov+U, RH, 0, x.a DIV 10000H MOD 10000H);
- IF x.a MOD 10000H # 0 THEN Put1(Ior, RH, RH, x.a MOD 10000H) END
- END ;
- x.r := RH; incR
- ELSIF x.mode = ORB.Var THEN
- IF x.r > 0 THEN (*local*) Put2(op, RH, SP, x.a + frame)
- ELSE GetSB(x.r); Put2(op, RH, SB, x.a)
- END ;
- x.r := RH; incR
- ELSIF x.mode = ORB.Par THEN Put2(Ldr, RH, SP, x.a + frame); Put2(op, RH, RH, x.b); x.r := RH; incR
- ELSIF x.mode = RegI THEN Put2(op, x.r, x.r, x.a)
- ELSIF x.mode = Cond THEN
- Put3(BC, negated(x.r), 2);
- FixLink(x.b); Put1(Mov, RH, 0, 1); Put3(BC, 7, 1);
- FixLink(x.a); Put1(Mov, RH, 0, 0); x.r := RH; incR
- END ;
- x.mode := Reg
- END
- END load;
-
- PROCEDURE loadAdr(VAR x: Item);
- BEGIN
- IF x.mode = ORB.Var THEN
- IF x.r > 0 THEN (*local*) Put1a(Add, RH, SP, x.a + frame)
- ELSE GetSB(x.r); Put1a(Add, RH, SB, x.a)
- END ;
- x.r := RH; incR
- ELSIF x.mode = ORB.Par THEN Put2(Ldr, RH, SP, x.a + frame);
- IF x.b # 0 THEN Put1a(Add, RH, RH, x.b) END ;
- x.r := RH; incR
- ELSIF x.mode = RegI THEN
- IF x.a # 0 THEN Put1a(Add, x.r, x.r, x.a) END
- ELSE ORS.Mark("address error")
- END ;
- x.mode := Reg
- END loadAdr;
-
- PROCEDURE loadCond(VAR x: Item);
- BEGIN
- IF x.type.form = ORB.Bool THEN
- IF x.mode = ORB.Const THEN x.r := 15 - x.a*8
- ELSE load(x);
- IF code[pc-1] DIV 40000000H # -2 THEN Put1(Cmp, x.r, x.r, 0) END ;
- x.r := NE; DEC(RH)
- END ;
- x.mode := Cond; x.a := 0; x.b := 0
- ELSE ORS.Mark("not Boolean?")
- END
- END loadCond;
-
- PROCEDURE loadTypTagAdr(T: ORB.Type);
- VAR x: Item;
- BEGIN x.mode := ORB.Var; x.a := T.len; x.r := -T.mno; loadAdr(x)
- END loadTypTagAdr;
-
- PROCEDURE loadStringAdr(VAR x: Item);
- BEGIN GetSB(0); Put1a(Add, RH, SB, varsize+x.a); x.mode := Reg; x.r := RH; incR
- END loadStringAdr;
-
- (* Items: Conversion from constants or from Objects on the Heap to Items on the Stack*)
-
- PROCEDURE MakeConstItem*(VAR x: Item; typ: ORB.Type; val: LONGINT);
- BEGIN x.mode := ORB.Const; x.type := typ; x.a := val
- END MakeConstItem;
-
- PROCEDURE MakeRealItem*(VAR x: Item; val: REAL);
- BEGIN x.mode := ORB.Const; x.type := ORB.realType; x.a := SYSTEM.VAL(LONGINT, val)
- END MakeRealItem;
-
- PROCEDURE MakeStringItem*(VAR x: Item; len: LONGINT); (*copies string from ORS-buffer to ORG-string array*)
- VAR i: LONGINT;
- BEGIN x.mode := ORB.Const; x.type := ORB.strType; x.a := strx; x.b := len; i := 0;
- IF strx + len + 4 < maxStrx THEN
- WHILE len > 0 DO str[strx] := ORS.str[i]; INC(strx); INC(i); DEC(len) END ;
- WHILE strx MOD 4 # 0 DO str[strx] := 0X; INC(strx) END
- ELSE ORS.Mark("too many strings")
- END
- END MakeStringItem;
-
- PROCEDURE MakeItem*(VAR x: Item; y: ORB.Object; curlev: LONGINT);
- BEGIN x.mode := y.class; x.type := y.type; x.a := y.val; x.rdo := y.rdo;
- IF y.class = ORB.Par THEN x.b := 0
- ELSIF y.class = ORB.Typ THEN x.a := y.type.len; x.r := -y.lev
- ELSIF (y.class = ORB.Const) & (y.type.form = ORB.String) THEN x.b := y.lev (*len*)
- ELSE x.r := y.lev
- END ;
- IF (y.lev > 0) & (y.lev # curlev) & (y.class # ORB.Const) THEN ORS.Mark("level error, not accessible") END
- END MakeItem;
-
- (* Code generation for Selectors, Variables, Constants *)
-
- PROCEDURE Field*(VAR x: Item; y: ORB.Object); (* x := x.y *)
- BEGIN;
- IF x.mode = ORB.Var THEN
- IF x.r >= 0 THEN x.a := x.a + y.val
- ELSE loadAdr(x); x.mode := RegI; x.a := y.val
- END
- ELSIF x.mode = RegI THEN x.a := x.a + y.val
- ELSIF x.mode = ORB.Par THEN x.b := x.b + y.val
- END
- END Field;
-
- PROCEDURE Index*(VAR x, y: Item); (* x := x[y] *)
- VAR s, lim: LONGINT;
- BEGIN s := x.type.base.size; lim := x.type.len;
- IF (y.mode = ORB.Const) & (lim >= 0) THEN
- IF (y.a < 0) OR (y.a >= lim) THEN ORS.Mark("bad index") END ;
- IF x.mode IN {ORB.Var, RegI} THEN x.a := y.a * s + x.a
- ELSIF x.mode = ORB.Par THEN x.b := y.a * s + x.b
- END
- ELSE load(y);
- IF check THEN (*check array bounds*)
- IF lim >= 0 THEN Put1a(Cmp, RH, y.r, lim)
- ELSE (*open array*)
- IF x.mode IN {ORB.Var, ORB.Par} THEN Put2(Ldr, RH, SP, x.a+4+frame); Put0(Cmp, RH, y.r, RH)
- ELSE ORS.Mark("error in Index")
- END
- END ;
- Trap(10, 1) (*BCC*)
- END ;
- IF s = 4 THEN Put1(Lsl, y.r, y.r, 2) ELSIF s > 1 THEN Put1a(Mul, y.r, y.r, s) END ;
- IF x.mode = ORB.Var THEN
- IF x.r > 0 THEN Put0(Add, y.r, SP, y.r); INC(x.a, frame)
- ELSE GetSB(x.r);
- IF x.r = 0 THEN Put0(Add, y.r, SB, y.r)
- ELSE Put1a(Add, RH, SB, x.a); Put0(Add, y.r, RH, y.r); x.a := 0
- END
- END ;
- x.r := y.r; x.mode := RegI
- ELSIF x.mode = ORB.Par THEN
- Put2(Ldr, RH, SP, x.a + frame);
- Put0(Add, y.r, RH, y.r); x.mode := RegI; x.r := y.r; x.a := x.b
- ELSIF x.mode = RegI THEN Put0(Add, x.r, x.r, y.r); DEC(RH)
- END
- END
- END Index;
-
- PROCEDURE DeRef*(VAR x: Item);
- BEGIN
- IF x.mode = ORB.Var THEN
- IF x.r > 0 THEN (*local*) Put2(Ldr, RH, SP, x.a + frame) ELSE GetSB(x.r); Put2(Ldr, RH, SB, x.a) END ;
- NilCheck; x.r := RH; incR
- ELSIF x.mode = ORB.Par THEN
- Put2(Ldr, RH, SP, x.a + frame); Put2(Ldr, RH, RH, x.b); NilCheck; x.r := RH; incR
- ELSIF x.mode = RegI THEN Put2(Ldr, x.r, x.r, x.a); NilCheck
- ELSIF x.mode # Reg THEN ORS.Mark("bad mode in DeRef")
- END ;
- x.mode := RegI; x.a := 0; x.b := 0
- END DeRef;
-
- PROCEDURE Q(T: ORB.Type; VAR dcw: LONGINT);
- BEGIN (*one entry of type descriptor extension table*)
- IF T.base # NIL THEN
- Q(T.base, dcw); data[dcw] := (T.mno*1000H + T.len) * 1000H + dcw - fixorgT;
- fixorgT := dcw; INC(dcw)
- END
- END Q;
-
- PROCEDURE FindPtrFlds(typ: ORB.Type; off: LONGINT; VAR dcw: LONGINT);
- VAR fld: ORB.Object; i, s: LONGINT;
- BEGIN
- IF (typ.form = ORB.Pointer) OR (typ.form = ORB.NilTyp) THEN data[dcw] := off; INC(dcw)
- ELSIF typ.form = ORB.Record THEN
- fld := typ.dsc;
- WHILE fld # NIL DO FindPtrFlds(fld.type, fld.val + off, dcw); fld := fld.next END
- ELSIF typ.form = ORB.Array THEN
- s := typ.base.size;
- FOR i := 0 TO typ.len-1 DO FindPtrFlds(typ.base, i*s + off, dcw) END
- END
- END FindPtrFlds;
-
- PROCEDURE BuildTD*(T: ORB.Type; VAR dc: LONGINT);
- VAR dcw, k, s: LONGINT; (*dcw = word address*)
- BEGIN dcw := dc DIV 4; s := T.size; (*convert size for heap allocation*)
- IF s <= 24 THEN s := 32 ELSIF s <= 56 THEN s := 64 ELSIF s <= 120 THEN s := 128
- ELSE s := (s+263) DIV 256 * 256
- END ;
- T.len := dc; data[dcw] := s; INC(dcw);
- k := T.nofpar; (*extension level!*)
- IF k > 3 THEN ORS.Mark("ext level too large")
- ELSE Q(T, dcw);
- WHILE k < 3 DO data[dcw] := -1; INC(dcw); INC(k) END
- END ;
- FindPtrFlds(T, 0, dcw); data[dcw] := -1; INC(dcw); tdx := dcw; dc := dcw*4;
- IF tdx >= maxTD THEN ORS.Mark("too many record types"); tdx := 0 END
- END BuildTD;
-
- PROCEDURE TypeTest*(VAR x: Item; T: ORB.Type; varpar, isguard: BOOLEAN);
- VAR pc0: LONGINT;
- BEGIN (*fetch tag into RH*)
- IF varpar THEN Put2(Ldr, RH, SP, x.a+4+frame)
- ELSE load(x);
- pc0 := pc; Put3(BC, EQ, 0); (*NIL belongs to every pointer type*)
- Put2(Ldr, RH, x.r, -8)
- END ;
- Put2(Ldr, RH, RH, T.nofpar*4); incR;
- loadTypTagAdr(T); (*tag of T*)
- Put0(Cmp, RH-1, RH-1, RH-2); DEC(RH, 2);
- IF ~varpar THEN fix(pc0, pc - pc0 - 1) END ;
- IF isguard THEN
- IF check THEN Trap(NE, 2) END
- ELSE SetCC(x, EQ);
- IF ~varpar THEN DEC(RH) END
- END
- END TypeTest;
-
- (* Code generation for Boolean operators *)
-
- PROCEDURE Not*(VAR x: Item); (* x := ~x *)
- VAR t: LONGINT;
- BEGIN
- IF x.mode # Cond THEN loadCond(x) END ;
- x.r := negated(x.r); t := x.a; x.a := x.b; x.b := t
- END Not;
-
- PROCEDURE And1*(VAR x: Item); (* x := x & *)
- BEGIN
- IF x.mode # Cond THEN loadCond(x) END ;
- Put3(BC, negated(x.r), x.a); x.a := pc-1; FixLink(x.b); x.b := 0
- END And1;
-
- PROCEDURE And2*(VAR x, y: Item);
- BEGIN
- IF y.mode # Cond THEN loadCond(y) END ;
- x.a := merged(y.a, x.a); x.b := y.b; x.r := y.r
- END And2;
-
- PROCEDURE Or1*(VAR x: Item); (* x := x OR *)
- BEGIN
- IF x.mode # Cond THEN loadCond(x) END ;
- Put3(BC, x.r, x.b); x.b := pc-1; FixLink(x.a); x.a := 0
- END Or1;
-
- PROCEDURE Or2*(VAR x, y: Item);
- BEGIN
- IF y.mode # Cond THEN loadCond(y) END ;
- x.a := y.a; x.b := merged(y.b, x.b); x.r := y.r
- END Or2;
-
- (* Code generation for arithmetic operators *)
-
- PROCEDURE Neg*(VAR x: Item); (* x := -x *)
- BEGIN
- IF x.type.form = ORB.Int THEN
- IF x.mode = ORB.Const THEN x.a := -x.a
- ELSE load(x); Put1(Mov, RH, 0, 0); Put0(Sub, x.r, RH, x.r)
- END
- ELSIF x.type.form = ORB.Real THEN
- IF x.mode = ORB.Const THEN x.a := x.a + 7FFFFFFFH + 1
- ELSE load(x); Put1(Mov, RH, 0, 0); Put0(Fsb, x.r, RH, x.r)
- END
- ELSE (*form = Set*)
- IF x.mode = ORB.Const THEN x.a := -x.a-1
- ELSE load(x); Put1(Xor, x.r, x.r, -1)
- END
- END
- END Neg;
-
- PROCEDURE AddOp*(op: LONGINT; VAR x, y: Item); (* x := x +- y *)
- BEGIN
- IF op = ORS.plus THEN
- IF (x.mode = ORB.Const) & (y.mode = ORB.Const) THEN x.a := x.a + y.a
- ELSIF y.mode = ORB.Const THEN load(x);
- IF y.a # 0 THEN Put1a(Add, x.r, x.r, y.a) END
- ELSE load(x); load(y); Put0(Add, RH-2, x.r, y.r); DEC(RH); x.r := RH-1
- END
- ELSE (*op = ORS.minus*)
- IF (x.mode = ORB.Const) & (y.mode = ORB.Const) THEN x.a := x.a - y.a
- ELSIF y.mode = ORB.Const THEN load(x);
- IF y.a # 0 THEN Put1a(Sub, x.r, x.r, y.a) END
- ELSE load(x); load(y); Put0(Sub, RH-2, x.r, y.r); DEC(RH); x.r := RH-1
- END
- END
- END AddOp;
-
- PROCEDURE log2(m: LONGINT; VAR e: LONGINT): LONGINT;
- BEGIN e := 0;
- WHILE ~ODD(m) DO m := m DIV 2; INC(e) END ;
- RETURN m
- END log2;
-
- PROCEDURE MulOp*(VAR x, y: Item); (* x := x * y *)
- VAR e: LONGINT;
- BEGIN
- IF (x.mode = ORB.Const) & (y.mode = ORB.Const) THEN x.a := x.a * y.a
- ELSIF (y.mode = ORB.Const) & (y.a >= 2) & (log2(y.a, e) = 1) THEN load(x); Put1(Lsl, x.r, x.r, e)
- ELSIF y.mode = ORB.Const THEN load(x); Put1a(Mul, x.r, x.r, y.a)
- ELSIF (x.mode = ORB.Const) & (x.a >= 2) & (log2(x.a, e) = 1) THEN load(y); Put1(Lsl, y.r, y.r, e); x.mode := Reg; x.r := y.r
- ELSIF x.mode = ORB.Const THEN load(y); Put1a(Mul, y.r, y.r, x.a); x.mode := Reg; x.r := y.r
- ELSE load(x); load(y); Put0(Mul, RH-2, x.r, y.r); DEC(RH); x.r := RH-1
- END
- END MulOp;
-
- PROCEDURE DivOp*(op: LONGINT; VAR x, y: Item); (* x := x op y *)
- VAR e: LONGINT;
- BEGIN
- IF op = ORS.div THEN
- IF (x.mode = ORB.Const) & (y.mode = ORB.Const) THEN
- IF y.a > 0 THEN x.a := x.a DIV y.a ELSE ORS.Mark("bad divisor") END
- ELSIF (y.mode = ORB.Const) & (y.a >= 2) & (log2(y.a, e) = 1) THEN load(x); Put1(Asr, x.r, x.r, e)
- ELSIF y.mode = ORB.Const THEN
- IF y.a > 0 THEN load(x); Put1a(Div, x.r, x.r, y.a) ELSE ORS.Mark("bad divisor") END
- ELSE load(y);
- IF check THEN Trap(LE, 6) END ;
- load(x); Put0(Div, RH-2, x.r, y.r); DEC(RH); x.r := RH-1
- END
- ELSE (*op = ORS.mod*)
- IF (x.mode = ORB.Const) & (y.mode = ORB.Const) THEN
- IF y.a > 0 THEN x.a := x.a MOD y.a ELSE ORS.Mark("bad modulus") END
- ELSIF (y.mode = ORB.Const) & (y.a >= 2) & (log2(y.a, e) = 1) THEN load(x);
- IF e <= 16 THEN Put1(And, x.r, x.r, y.a-1) ELSE Put1(Lsl, x.r, x.r, 32-e); Put1(Ror, x.r, x.r, 32-e) END
- ELSIF y.mode = ORB.Const THEN
- IF y.a > 0 THEN load(x); Put1a(Div, x.r, x.r, y.a); Put0(Mov+U, x.r, 0, 0) ELSE ORS.Mark("bad modulus") END
- ELSE load(y);
- IF check THEN Trap(LE, 6) END ;
- load(x); Put0(Div, RH-2, x.r, y.r); Put0(Mov+U, RH-2, 0, 0); DEC(RH); x.r := RH-1
- END
- END
- END DivOp;
-
- (* Code generation for REAL operators *)
-
- PROCEDURE RealOp*(op: INTEGER; VAR x, y: Item); (* x := x op y *)
- BEGIN load(x); load(y);
- IF op = ORS.plus THEN Put0(Fad, RH-2, x.r, y.r)
- ELSIF op = ORS.minus THEN Put0(Fsb, RH-2, x.r, y.r)
- ELSIF op = ORS.times THEN Put0(Fml, RH-2, x.r, y.r)
- ELSIF op = ORS.rdiv THEN Put0(Fdv, RH-2, x.r, y.r)
- END ;
- DEC(RH); x.r := RH-1
- END RealOp;
-
- (* Code generation for set operators *)
-
- PROCEDURE Singleton*(VAR x: Item); (* x := {x} *)
- BEGIN
- IF x.mode = ORB.Const THEN
- x.a := LSL(1, x.a)
- ELSE load(x); Put1(Mov, RH, 0, 1); Put0(Lsl, x.r, RH, x.r)
- END
- END Singleton;
-
- PROCEDURE Set*(VAR x, y: Item); (* x := {x .. y} *)
- BEGIN
- IF (x.mode = ORB.Const) & ( y.mode = ORB.Const) THEN
- IF x.a <= y.a THEN x.a := LSL(2, y.a) - LSL(1, x.a) ELSE x.a := 0 END
- ELSE
- IF (x.mode = ORB.Const) & (x.a < 16) THEN x.a := LSL(-1, x.a)
- ELSE load(x); Put1(Mov, RH, 0, -1); Put0(Lsl, x.r, RH, x.r)
- END ;
- IF (y.mode = ORB.Const) & (y.a < 16) THEN Put1(Mov, RH, 0, LSL(-2, y.a)); y.mode := Reg; y.r := RH; incR
- ELSE load(y); Put1(Mov, RH, 0, -2); Put0(Lsl, y.r, RH, y.r)
- END ;
- IF x.mode = ORB.Const THEN
- IF x.a # 0 THEN Put1(Xor, y.r, y.r, -1); Put1a(And, RH-1, y.r, x.a) END ;
- x.mode := Reg; x.r := RH-1
- ELSE DEC(RH); Put0(Ann, RH-1, x.r, y.r)
- END
- END
- END Set;
-
- PROCEDURE In*(VAR x, y: Item); (* x := x IN y *)
- BEGIN load(y);
- IF x.mode = ORB.Const THEN Put1(Ror, y.r, y.r, (x.a + 1) MOD 20H); DEC(RH)
- ELSE load(x); Put1(Add, x.r, x.r, 1); Put0(Ror, y.r, y.r, x.r); DEC(RH, 2)
- END ;
- SetCC(x, MI)
- END In;
-
- PROCEDURE SetOp*(op: LONGINT; VAR x, y: Item); (* x := x op y *)
- VAR xset, yset: SET; (*x.type.form = Set*)
- BEGIN
- IF (x.mode = ORB.Const) & (y.mode = ORB.Const) THEN
- xset := SYSTEM.VAL(SET, x.a); yset := SYSTEM.VAL(SET, y.a);
- IF op = ORS.plus THEN xset := xset + yset
- ELSIF op = ORS.minus THEN xset := xset - yset
- ELSIF op = ORS.times THEN xset := xset * yset
- ELSIF op = ORS.rdiv THEN xset := xset / yset
- END ;
- x.a := SYSTEM.VAL(LONGINT, xset)
- ELSIF y.mode = ORB.Const THEN
- load(x);
- IF op = ORS.plus THEN Put1a(Ior, x.r, x.r, y.a)
- ELSIF op = ORS.minus THEN Put1a(Ann, x.r, x.r, y.a)
- ELSIF op = ORS.times THEN Put1a(And, x.r, x.r, y.a)
- ELSIF op = ORS.rdiv THEN Put1a(Xor, x.r, x.r, y.a)
- END ;
- ELSE load(x); load(y);
- IF op = ORS.plus THEN Put0(Ior, RH-2, x.r, y.r)
- ELSIF op = ORS.minus THEN Put0(Ann, RH-2, x.r, y.r)
- ELSIF op = ORS.times THEN Put0(And, RH-2, x.r, y.r)
- ELSIF op = ORS.rdiv THEN Put0(Xor, RH-2, x.r, y.r)
- END ;
- DEC(RH); x.r := RH-1
- END
- END SetOp;
-
- (* Code generation for relations *)
-
- PROCEDURE IntRelation*(op: INTEGER; VAR x, y: Item); (* x := x < y *)
- BEGIN
- IF (y.mode = ORB.Const) & (y.type.form # ORB.Proc) THEN
- load(x);
- IF (y.a # 0) OR ~(op IN {ORS.eql, ORS.neq}) OR (code[pc-1] DIV 40000000H # -2) THEN Put1a(Cmp, x.r, x.r, y.a) END ;
- DEC(RH)
- ELSE load(x); load(y); Put0(Cmp, x.r, x.r, y.r); DEC(RH, 2)
- END ;
- SetCC(x, relmap[op - ORS.eql])
- END IntRelation;
-
- PROCEDURE SetRelation*(op: INTEGER; VAR x, y: Item); (* x := x < y *)
- BEGIN load(x);
- IF (op = ORS.eql) OR (op = ORS.neq) THEN
- IF y.mode = ORB.Const THEN Put1a(Cmp, x.r, x.r, y.a); DEC(RH)
- ELSE load(y); Put0(Cmp, x.r, x.r, y.r); DEC(RH, 2)
- END ;
- SetCC(x, relmap[op - ORS.eql])
- ELSE ORS.Mark("illegal relation")
- END
- END SetRelation;
-
- PROCEDURE RealRelation*(op: INTEGER; VAR x, y: Item); (* x := x < y *)
- BEGIN load(x);
- IF (y.mode = ORB.Const) & (y.a = 0) THEN DEC(RH)
- ELSE load(y); Put0(Fsb, x.r, x.r, y.r); DEC(RH, 2)
- END ;
- SetCC(x, relmap[op - ORS.eql])
- END RealRelation;
-
- PROCEDURE StringRelation*(op: INTEGER; VAR x, y: Item); (* x := x < y *)
- (*x, y are char arrays or strings*)
- BEGIN
- IF x.type.form = ORB.String THEN loadStringAdr(x) ELSE loadAdr(x) END ;
- IF y.type.form = ORB.String THEN loadStringAdr(y) ELSE loadAdr(y) END ;
- Put2(Ldr+1, RH, x.r, 0); Put1(Add, x.r, x.r, 1);
- Put2(Ldr+1, RH+1, y.r, 0); Put1(Add, y.r, y.r, 1);
- Put0(Cmp, RH+2, RH, RH+1); Put3(BC, NE, 2);
- Put1(Cmp, RH+2, RH, 0); Put3(BC, NE, -8);
- DEC(RH, 2); SetCC(x, relmap[op - ORS.eql])
- END StringRelation;
-
- (* Code generation of Assignments *)
-
- PROCEDURE StrToChar*(VAR x: Item);
- BEGIN x.type := ORB.charType; DEC(strx, 4); x.a := ORD(str[x.a])
- END StrToChar;
-
- PROCEDURE Store*(VAR x, y: Item); (* x := y *)
- VAR op: LONGINT;
- BEGIN load(y);
- IF x.type.size = 1 THEN op := Str+1 ELSE op := Str END ;
- IF x.mode = ORB.Var THEN
- IF x.r > 0 THEN (*local*) Put2(op, y.r, SP, x.a + frame)
- ELSE GetSB(x.r); Put2(op, y.r, SB, x.a)
- END
- ELSIF x.mode = ORB.Par THEN Put2(Ldr, RH, SP, x.a + frame); Put2(op, y.r, RH, x.b);
- ELSIF x.mode = RegI THEN Put2(op, y.r, x.r, x.a); DEC(RH);
- ELSE ORS.Mark("bad mode in Store")
- END ;
- DEC(RH)
- END Store;
-
- PROCEDURE StoreStruct*(VAR x, y: Item); (* x := y, frame = 0 *)
- VAR s, pc0: LONGINT;
- BEGIN loadAdr(x); loadAdr(y);
- IF (x.type.form = ORB.Array) & (x.type.len > 0) THEN
- IF y.type.len >= 0 THEN
- IF x.type.len >= y.type.len THEN Put1a(Mov, RH, 0, (y.type.size+3) DIV 4)
- ELSE ORS.Mark("source array too long")
- END
- ELSE (*y is open array*)
- Put2(Ldr, RH, SP, y.a+4); s := y.type.base.size; (*element size*)
- pc0 := pc; Put3(BC, EQ, 0);
- IF s = 1 THEN Put1(Add, RH, RH, 3); Put1(Asr, RH, RH, 2)
- ELSIF s # 4 THEN Put1a(Mul, RH, RH, s DIV 4)
- END ;
- IF check THEN
- Put1a(Mov, RH+1, 0, (x.type.size+3) DIV 4); Put0(Cmp, RH+1, RH, RH+1); Trap(GT, 3)
- END ;
- fix(pc0, pc + 5 - pc0)
- END
- ELSIF x.type.form = ORB.Record THEN Put1a(Mov, RH, 0, x.type.size DIV 4)
- ELSE ORS.Mark("inadmissible assignment")
- END ;
- Put2(Ldr, RH+1, y.r, 0); Put1(Add, y.r, y.r, 4);
- Put2(Str, RH+1, x.r, 0); Put1(Add, x.r, x.r, 4);
- Put1(Sub, RH, RH, 1); Put3(BC, NE, -6); DEC(RH, 2)
- END StoreStruct;
-
- PROCEDURE CopyString*(VAR x, y: Item); (*from x to y*)
- VAR len: LONGINT;
- BEGIN loadAdr(y); len := y.type.len;
- IF len >= 0 THEN
- IF x.b > len THEN ORS.Mark("string too long") END
- ELSIF check THEN Put2(Ldr, RH, y.r, 4); (*array length check*)
- Put1(Cmp, RH, RH, x.b); Trap(NE, 3)
- END ;
- loadStringAdr(x);
- Put2(Ldr, RH, x.r, 0); Put1(Add, x.r, x.r, 4);
- Put2(Str, RH, y.r, 0); Put1(Add, y.r, y.r, 4);
- Put1(Asr, RH, RH, 24); Put3(BC, NE, -6); DEC(RH, 2)
- END CopyString;
-
- (* Code generation for parameters *)
-
- PROCEDURE VarParam*(VAR x: Item; ftype: ORB.Type);
- VAR xmd: INTEGER;
- BEGIN xmd := x.mode; loadAdr(x);
- IF (ftype.form = ORB.Array) & (ftype.len < 0) THEN (*open array*)
- IF x.type.len >= 0 THEN Put1a(Mov, RH, 0, x.type.len) ELSE Put2(Ldr, RH, SP, x.a+4+frame) END ;
- incR
- ELSIF ftype.form = ORB.Record THEN
- IF xmd = ORB.Par THEN Put2(Ldr, RH, SP, x.a+4+frame); incR ELSE loadTypTagAdr(x.type) END
- END
- END VarParam;
-
- PROCEDURE ValueParam*(VAR x: Item);
- BEGIN load(x)
- END ValueParam;
-
- PROCEDURE OpenArrayParam*(VAR x: Item);
- BEGIN loadAdr(x);
- IF x.type.len >= 0 THEN Put1a(Mov, RH, 0, x.type.len) ELSE Put2(Ldr, RH, SP, x.a+4+frame) END ;
- incR
- END OpenArrayParam;
-
- PROCEDURE StringParam*(VAR x: Item);
- BEGIN loadStringAdr(x); Put1(Mov, RH, 0, x.b); incR (*len*)
- END StringParam;
-
- (*For Statements*)
-
- PROCEDURE For0*(VAR x, y: Item);
- BEGIN load(y)
- END For0;
-
- PROCEDURE For1*(VAR x, y, z, w: Item; VAR L: LONGINT);
- BEGIN
- IF z.mode = ORB.Const THEN Put1a(Cmp, RH, y.r, z.a)
- ELSE load(z); Put0(Cmp, RH-1, y.r, z.r); DEC(RH)
- END ;
- L := pc;
- IF w.a > 0 THEN Put3(BC, GT, 0)
- ELSIF w.a < 0 THEN Put3(BC, LT, 0)
- ELSE ORS.Mark("zero increment"); Put3(BC, MI, 0)
- END ;
- Store(x, y)
- END For1;
-
- PROCEDURE For2*(VAR x, y, w: Item);
- BEGIN load(x); DEC(RH); Put1a(Add, x.r, x.r, w.a)
- END For2;
-
- (* Branches, procedure calls, procedure prolog and epilog *)
-
- PROCEDURE Here*(): LONGINT;
- BEGIN invalSB; RETURN pc
- END Here;
-
- PROCEDURE FJump*(VAR L: LONGINT);
- BEGIN Put3(BC, 7, L); L := pc-1
- END FJump;
-
- PROCEDURE CFJump*(VAR x: Item);
- BEGIN
- IF x.mode # Cond THEN loadCond(x) END ;
- Put3(BC, negated(x.r), x.a); FixLink(x.b); x.a := pc-1
- END CFJump;
-
- PROCEDURE BJump*(L: LONGINT);
- BEGIN Put3(BC, 7, L-pc-1)
- END BJump;
-
- PROCEDURE CBJump*(VAR x: Item; L: LONGINT);
- BEGIN
- IF x.mode # Cond THEN loadCond(x) END ;
- Put3(BC, negated(x.r), L-pc-1); FixLink(x.b); FixLinkWith(x.a, L)
- END CBJump;
-
- PROCEDURE Fixup*(VAR x: Item);
- BEGIN FixLink(x.a)
- END Fixup;
-
- PROCEDURE SaveRegs(r: LONGINT); (* R[0 .. r-1]*)
- VAR r0: LONGINT;
- BEGIN (*r > 0*) r0 := 0;
- Put1(Sub, SP, SP, r*4); INC(frame, 4*r);
- REPEAT Put2(Str, r0, SP, (r-r0-1)*4); INC(r0) UNTIL r0 = r
- END SaveRegs;
-
- PROCEDURE RestoreRegs(r: LONGINT); (*R[0 .. r-1]*)
- VAR r0: LONGINT;
- BEGIN (*r > 0*) r0 := r;
- REPEAT DEC(r0); Put2(Ldr, r0, SP, (r-r0-1)*4) UNTIL r0 = 0;
- Put1(Add, SP, SP, r*4); DEC(frame, 4*r)
- END RestoreRegs;
-
- PROCEDURE PrepCall*(VAR x: Item; VAR r: LONGINT);
- BEGIN (*x.type.form = ORB.Proc*)
- IF x.mode > ORB.Par THEN load(x) END ;
- r := RH;
- IF RH > 0 THEN SaveRegs(RH); RH := 0 END
- END PrepCall;
-
- PROCEDURE Call*(VAR x: Item; r: LONGINT);
- BEGIN (*x.type.form = ORB.Proc*)
- IF x.mode = ORB.Const THEN
- IF x.r >= 0 THEN Put3(BL, 7, (x.a DIV 4)-pc-1)
- ELSE (*imported*)
- IF pc - fixorgP < 1000H THEN
- Put3(BL, 7, ((-x.r) * 100H + x.a) * 1000H + pc-fixorgP); fixorgP := pc-1
- ELSE ORS.Mark("fixup impossible")
- END
- END
- ELSE
- IF x.mode <= ORB.Par THEN load(x); DEC(RH)
- ELSE Put2(Ldr, RH, SP, 0); Put1(Add, SP, SP, 4); DEC(r); DEC(frame, 4)
- END ;
- IF check THEN Trap(EQ, 5) END ;
- Put3(BLR, 7, RH)
- END ;
- IF x.type.base.form = ORB.NoTyp THEN (*procedure*) RH := 0
- ELSE (*function*)
- IF r > 0 THEN Put0(Mov, r, 0, 0); RestoreRegs(r) END ;
- x.mode := Reg; x.r := r; RH := r+1
- END ;
- invalSB
- END Call;
-
- PROCEDURE Enter*(parblksize, locblksize: LONGINT; int: BOOLEAN);
- VAR a, r: LONGINT;
- BEGIN invalSB; frame := 0;
- IF ~int THEN (*procedure prolog*)
- a := 4; r := 0;
- Put1(Sub, SP, SP, locblksize); Put2(Str, LNK, SP, 0);
- WHILE a < parblksize DO Put2(Str, r, SP, a); INC(r); INC(a, 4) END
- ELSE (*interrupt procedure*)
- Put1(Sub, SP, SP, 12); Put2(Str, 0, SP, 0); Put2(Str, 1, SP, 4); Put2(Str, SB, SP, 8)
- (*R0, R1, SB saved os stack*)
- END
- END Enter;
-
- PROCEDURE Return*(form: INTEGER; VAR x: Item; size: LONGINT; int: BOOLEAN);
- BEGIN
- IF form # ORB.NoTyp THEN load(x) END ;
- IF ~int THEN (*procedure epilog*)
- Put2(Ldr, LNK, SP, 0); Put1(Add, SP, SP, size); Put3(BR, 7, LNK)
- ELSE (*interrupt return, restore SB, R1, R0*)
- Put2(Ldr, SB, SP, 8); Put2(Ldr, 1, SP, 4); Put2(Ldr, 0, SP, 0); Put1(Add, SP, SP, 12); Put3(BR, 7, 10H)
- END ;
- RH := 0
- END Return;
-
- (* In-line code procedures*)
-
- PROCEDURE Increment*(upordown: LONGINT; VAR x, y: Item);
- VAR op, zr, v: LONGINT;
- BEGIN (*frame = 0*)
- IF upordown = 0 THEN op := Add ELSE op := Sub END ;
- IF x.type = ORB.byteType THEN v := 1 ELSE v := 0 END ;
- IF y.type.form = ORB.NoTyp THEN y.mode := ORB.Const; y.a := 1 END ;
- IF (x.mode = ORB.Var) & (x.r > 0) THEN
- zr := RH; Put2(Ldr+v, zr, SP, x.a); incR;
- IF y.mode = ORB.Const THEN Put1a(op, zr, zr, y.a) ELSE load(y); Put0(op, zr, zr, y.r); DEC(RH) END ;
- Put2(Str+v, zr, SP, x.a); DEC(RH)
- ELSE loadAdr(x); zr := RH; Put2(Ldr+v, RH, x.r, 0); incR;
- IF y.mode = ORB.Const THEN Put1a(op, zr, zr, y.a) ELSE load(y); Put0(op, zr, zr, y.r); DEC(RH) END ;
- Put2(Str+v, zr, x.r, 0); DEC(RH, 2)
- END
- END Increment;
-
- PROCEDURE Include*(inorex: LONGINT; VAR x, y: Item);
- VAR op, zr: LONGINT;
- BEGIN loadAdr(x); zr := RH; Put2(Ldr, RH, x.r, 0); incR;
- IF inorex = 0 THEN op := Ior ELSE op := Ann END ;
- IF y.mode = ORB.Const THEN Put1a(op, zr, zr, LSL(1, y.a))
- ELSE load(y); Put1(Mov, RH, 0, 1); Put0(Lsl, y.r, RH, y.r); Put0(op, zr, zr, y.r); DEC(RH)
- END ;
- Put2(Str, zr, x.r, 0); DEC(RH, 2)
- END Include;
-
- PROCEDURE Assert*(VAR x: Item);
- VAR cond: LONGINT;
- BEGIN
- IF x.mode # Cond THEN loadCond(x) END ;
- IF x.a = 0 THEN cond := negated(x.r)
- ELSE Put3(BC, x.r, x.b); FixLink(x.a); x.b := pc-1; cond := 7
- END ;
- Trap(cond, 7); FixLink(x.b)
- END Assert;
-
- PROCEDURE New*(VAR x: Item);
- BEGIN loadAdr(x); loadTypTagAdr(x.type.base); Put3(BLR, 7, MT); RH := 0; invalSB
- END New;
-
- PROCEDURE Pack*(VAR x, y: Item);
- VAR z: Item;
- BEGIN z := x; load(x); load(y);
- Put1(Lsl, y.r, y.r, 23); Put0(Add, x.r, x.r, y.r); DEC(RH); Store(z, x)
- END Pack;
-
- PROCEDURE Unpk*(VAR x, y: Item);
- VAR z, e0: Item;
- BEGIN z := x; load(x); e0.mode := Reg; e0.r := RH; e0.type := ORB.intType;
- Put1(Asr, RH, x.r, 23); Put1(Sub, RH, RH, 127); Store(y, e0); incR;
- Put1(Lsl, RH, RH, 23); Put0(Sub, x.r, x.r, RH); Store(z, x)
- END Unpk;
-
- PROCEDURE Led*(VAR x: Item);
- BEGIN load(x); Put1(Mov, RH, 0, -60); Put2(Str, x.r, RH, 0); DEC(RH)
- END Led;
-
- PROCEDURE Get*(VAR x, y: Item);
- BEGIN load(x); x.type := y.type; x.mode := RegI; x.a := 0; Store(y, x)
- END Get;
-
- PROCEDURE Put*(VAR x, y: Item);
- BEGIN load(x); x.type := y.type; x.mode := RegI; x.a := 0; Store(x, y)
- END Put;
-
- PROCEDURE Copy*(VAR x, y, z: Item);
- BEGIN load(x); load(y);
- IF z.mode = ORB.Const THEN
- IF z.a > 0 THEN load(z) ELSE ORS.Mark("bad count") END
- ELSE load(z);
- IF check THEN Trap(LT, 3) END ;
- Put3(BC, EQ, 6)
- END ;
- Put2(Ldr, RH, x.r, 0); Put1(Add, x.r, x.r, 4);
- Put2(Str, RH, y.r, 0); Put1(Add, y.r, y.r, 4);
- Put1(Sub, z.r, z.r, 1); Put3(BC, NE, -6); DEC(RH, 3)
- END Copy;
-
- PROCEDURE LDPSR*(VAR x: Item);
- BEGIN (*x.mode = Const*) Put3(0, 15, x.a + 20H)
- END LDPSR;
-
- PROCEDURE LDREG*(VAR x, y: Item);
- BEGIN
- IF y.mode = ORB.Const THEN Put1a(Mov, x.a, 0, y.a)
- ELSE load(y); Put0(Mov, x.a, 0, y.r); DEC(RH)
- END
- END LDREG;
-
- (*In-line code functions*)
-
- PROCEDURE Abs*(VAR x: Item);
- BEGIN
- IF x.mode = ORB.Const THEN x.a := ABS(x.a)
- ELSE load(x);
- IF x.type.form = ORB.Real THEN Put1(Lsl, x.r, x.r, 1); Put1(Ror, x.r, x.r, 1)
- ELSE Put1(Cmp, x.r, x.r, 0); Put3(BC, GE, 2); Put1(Mov, RH, 0, 0); Put0(Sub, x.r, RH, x.r)
- END
- END
- END Abs;
-
- PROCEDURE Odd*(VAR x: Item);
- BEGIN load(x); Put1(And, x.r, x.r, 1); SetCC(x, NE); DEC(RH)
- END Odd;
-
- PROCEDURE Floor*(VAR x: Item);
- BEGIN load(x); Put1(Mov+U, RH, 0, 4B00H); Put0(Fad+V, x.r, x.r, RH)
- END Floor;
-
- PROCEDURE Float*(VAR x: Item);
- BEGIN load(x); Put1(Mov+U, RH, 0, 4B00H); Put0(Fad+U, x.r, x.r, RH)
- END Float;
-
- PROCEDURE Ord*(VAR x: Item);
- BEGIN
- IF x.mode IN {ORB.Var, ORB.Par, RegI} THEN load(x) END
- END Ord;
-
- PROCEDURE Len*(VAR x: Item);
- BEGIN
- IF x.type.len >= 0 THEN x.mode := ORB.Const; x.a := x.type.len
- ELSE (*open array*) Put2(Ldr, RH, SP, x.a + 4 + frame); x.mode := Reg; x.r := RH; incR
- END
- END Len;
-
- PROCEDURE Shift*(fct: LONGINT; VAR x, y: Item);
- VAR op: LONGINT;
- BEGIN load(x);
- IF fct = 0 THEN op := Lsl ELSIF fct = 1 THEN op := Asr ELSE op := Ror END ;
- IF y.mode = ORB.Const THEN Put1(op, x.r, x.r, y.a MOD 20H)
- ELSE load(y); Put0(op, RH-2, x.r, y.r); DEC(RH); x.r := RH-1
- END
- END Shift;
-
- PROCEDURE ADC*(VAR x, y: Item);
- BEGIN load(x); load(y); Put0(Add+2000H, x.r, x.r, y.r); DEC(RH)
- END ADC;
-
- PROCEDURE SBC*(VAR x, y: Item);
- BEGIN load(x); load(y); Put0(Sub+2000H, x.r, x.r, y.r); DEC(RH)
- END SBC;
-
- PROCEDURE UML*(VAR x, y: Item);
- BEGIN load(x); load(y); Put0(Mul+2000H, x.r, x.r, y.r); DEC(RH)
- END UML;
-
- PROCEDURE Bit*(VAR x, y: Item);
- BEGIN load(x); Put2(Ldr, x.r, x.r, 0);
- IF y.mode = ORB.Const THEN Put1(Ror, x.r, x.r, y.a+1); DEC(RH)
- ELSE load(y); Put1(Add, y.r, y.r, 1); Put0(Ror, x.r, x.r, y.r); DEC(RH, 2)
- END ;
- SetCC(x, MI)
- END Bit;
-
- PROCEDURE Register*(VAR x: Item);
- BEGIN (*x.mode = Const*)
- Put0(Mov, RH, 0, x.a MOD 10H); x.mode := Reg; x.r := RH; incR
- END Register;
-
- PROCEDURE H*(VAR x: Item);
- BEGIN (*x.mode = Const*)
- Put0(Mov + U + x.a MOD 2 * V, RH, 0, 0); x.mode := Reg; x.r := RH; incR
- END H;
-
- PROCEDURE Adr*(VAR x: Item);
- BEGIN
- IF x.mode IN {ORB.Var, ORB.Par, RegI} THEN loadAdr(x)
- ELSIF (x.mode = ORB.Const) & (x.type.form = ORB.Proc) THEN load(x)
- ELSIF (x.mode = ORB.Const) & (x.type.form = ORB.String) THEN loadStringAdr(x)
- ELSE ORS.Mark("not addressable")
- END
- END Adr;
-
- PROCEDURE Condition*(VAR x: Item);
- BEGIN (*x.mode = Const*) SetCC(x, x.a)
- END Condition;
-
- PROCEDURE Open*(v: INTEGER);
- BEGIN pc := 0; tdx := 0; strx := 0; RH := 0; fixorgP := 0; fixorgD := 0; fixorgT := 0; check := v # 0; version := v;
- IF v = 0 THEN pc := 8 END
- END Open;
-
- PROCEDURE SetDataSize*(dc: LONGINT);
- BEGIN varsize := dc
- END SetDataSize;
-
- PROCEDURE Header*;
- BEGIN entry := pc*4;
- IF version = 0 THEN code[0] := 0E7000000H-1 + pc; Put1a(Mov, SB, 0, VarOrg0); Put1a(Mov, SP, 0, StkOrg0) (*RISC-0*)
- ELSE Put1(Sub, SP, SP, 4); Put2(Str, LNK, SP, 0); invalSB
- END
- END Header;
-
- PROCEDURE NofPtrs(typ: ORB.Type): LONGINT;
- VAR fld: ORB.Object; n: LONGINT;
- BEGIN
- IF (typ.form = ORB.Pointer) OR (typ.form = ORB.NilTyp) THEN n := 1
- ELSIF typ.form = ORB.Record THEN
- fld := typ.dsc; n := 0;
- WHILE fld # NIL DO n := NofPtrs(fld.type) + n; fld := fld.next END
- ELSIF typ.form = ORB.Array THEN n := NofPtrs(typ.base) * typ.len
- ELSE n := 0
- END ;
- RETURN n
- END NofPtrs;
-
- PROCEDURE FindPtrs(VAR R: Files.Rider; typ: ORB.Type; adr: LONGINT);
- VAR fld: ORB.Object; i, s: LONGINT;
- BEGIN
- IF (typ.form = ORB.Pointer) OR (typ.form = ORB.NilTyp) THEN Files.WriteInt(R, adr)
- ELSIF typ.form = ORB.Record THEN
- fld := typ.dsc;
- WHILE fld # NIL DO FindPtrs(R, fld.type, fld.val + adr); fld := fld.next END
- ELSIF typ.form = ORB.Array THEN
- s := typ.base.size;
- FOR i := 0 TO typ.len-1 DO FindPtrs(R, typ.base, i*s + adr) END
- END
- END FindPtrs;
-
- PROCEDURE Close*(VAR modid: ORS.Ident; key, nofent: LONGINT);
- VAR obj: ORB.Object;
- i, comsize, nofimps, nofptrs, size: LONGINT;
- name: ORS.Ident;
- F: Files.File; R: Files.Rider;
- BEGIN (*exit code*)
- IF version = 0 THEN Put1(Mov, 0, 0, 0); Put3(BR, 7, 0) (*RISC-0*)
- ELSE Put2(Ldr, LNK, SP, 0); Put1(Add, SP, SP, 4); Put3(BR, 7, LNK)
- END ;
- obj := ORB.topScope.next; nofimps := 0; comsize := 4; nofptrs := 0;
- WHILE obj # NIL DO
- IF (obj.class = ORB.Mod) & (obj.dsc # ORB.system) THEN INC(nofimps) (*count imports*)
- ELSIF (obj.exno # 0) & (obj.class = ORB.Const) & (obj.type.form = ORB.Proc)
- & (obj.type.nofpar = 0) & (obj.type.base = ORB.noType) THEN i := 0; (*count commands*)
- WHILE obj.name[i] # 0X DO INC(i) END ;
- i := (i+4) DIV 4 * 4; INC(comsize, i+4)
- ELSIF obj.class = ORB.Var THEN INC(nofptrs, NofPtrs(obj.type)) (*count pointers*)
- END ;
- obj := obj.next
- END ;
- size := varsize + strx + comsize + (pc + nofimps + nofent + nofptrs + 1)*4; (*varsize includes type descriptors*)
-
- ORB.MakeFileName(name, modid, ".rsc"); (*write code file*)
- F := Files.New(name); Files.Set(R, F, 0); Files.WriteString(R, modid); Files.WriteInt(R, key);
- (*Files.WriteByte(R, version);*) (* who writes like that? -- noch *)
- Files.WriteByte(R, SHORT(SHORT(version))); (* voc adaptation by noch *)
- Files.WriteInt(R, size);
- obj := ORB.topScope.next;
- WHILE (obj # NIL) & (obj.class = ORB.Mod) DO (*imports*)
- IF obj.dsc # ORB.system THEN Files.WriteString(R, obj(ORB.Module).orgname); Files.WriteInt(R, obj.val) END ;
- obj := obj.next
- END ;
- Files.Write(R, 0X);
- Files.WriteInt(R, tdx*4);
- i := 0;
- WHILE i < tdx DO Files.WriteInt(R, data[i]); INC(i) END ; (*type descriptors*)
- Files.WriteInt(R, varsize - tdx*4); (*data*)
- Files.WriteInt(R, strx);
- FOR i := 0 TO strx-1 DO Files.Write(R, str[i]) END ; (*strings*)
- Files.WriteInt(R, pc); (*code len*)
- FOR i := 0 TO pc-1 DO Files.WriteInt(R, code[i]) END ; (*program*)
- obj := ORB.topScope.next;
- WHILE obj # NIL DO (*commands*)
- IF (obj.exno # 0) & (obj.class = ORB.Const) & (obj.type.form = ORB.Proc) &
- (obj.type.nofpar = 0) & (obj.type.base = ORB.noType) THEN
- Files.WriteString(R, obj.name); Files.WriteInt(R, obj.val)
- END ;
- obj := obj.next
- END ;
- Files.Write(R, 0X);
- Files.WriteInt(R, nofent); Files.WriteInt(R, entry);
- obj := ORB.topScope.next;
- WHILE obj # NIL DO (*entries*)
- IF obj.exno # 0 THEN
- IF (obj.class = ORB.Const) & (obj.type.form = ORB.Proc) OR (obj.class = ORB.Var) THEN
- Files.WriteInt(R, obj.val)
- ELSIF obj.class = ORB.Typ THEN
- IF obj.type.form = ORB.Record THEN Files.WriteInt(R, obj.type.len MOD 10000H)
- ELSIF (obj.type.form = ORB.Pointer) & ((obj.type.base.typobj = NIL) OR (obj.type.base.typobj.exno = 0)) THEN
- Files.WriteInt(R, obj.type.base.len MOD 10000H)
- END
- END
- END ;
- obj := obj.next
- END ;
- obj := ORB.topScope.next;
- WHILE obj # NIL DO (*pointer variables*)
- IF obj.class = ORB.Var THEN FindPtrs(R, obj.type, obj.val) END ;
- obj := obj.next
- END ;
- Files.WriteInt(R, -1);
- Files.WriteInt(R, fixorgP); Files.WriteInt(R, fixorgD); Files.WriteInt(R, fixorgT); Files.WriteInt(R, entry);
- Files.Write(R, "O"); Files.Register(F)
- END Close;
-
-BEGIN
- relmap[0] := 1; relmap[1] := 9; relmap[2] := 5; relmap[3] := 6; relmap[4] := 14; relmap[5] := 13
-END ORG.
diff --git a/src/voc07R/ORP.Mod b/src/voc07R/ORP.Mod
deleted file mode 100644
index 99e6ee83..00000000
--- a/src/voc07R/ORP.Mod
+++ /dev/null
@@ -1,997 +0,0 @@
-MODULE ORP; (*N. Wirth 1.7.97 / 7.6.2014 Oberon compiler for RISC in Oberon-07*)
- IMPORT Texts := CompatTexts, Oberon, ORS, ORB, ORG;
- (*Author: Niklaus Wirth, 2014.
- Parser of Oberon-RISC compiler. Uses Scanner ORS to obtain symbols (tokens),
- ORB for definition of data structures and for handling import and export, and
- ORG to produce binary code. ORP performs type checking and data allocation.
- Parser is target-independent, except for part of the handling of allocations.*)
-
- TYPE INTEGER = LONGINT; (* voc adaptation by noch *)
-
- TYPE PtrBase = POINTER TO PtrBaseDesc;
- PtrBaseDesc = RECORD (*list of names of pointer base types*)
- name: ORS.Ident; type: ORB.Type; next: PtrBase
- END ;
-
- VAR sym: INTEGER; (*last symbol read*)
- dc: LONGINT; (*data counter*)
- level, exno, version: INTEGER;
- newSF: BOOLEAN; (*option flag*)
- expression: PROCEDURE (VAR x: ORG.Item); (*to avoid forward reference*)
- Type: PROCEDURE (VAR type: ORB.Type);
- FormalType: PROCEDURE (VAR typ: ORB.Type; dim: INTEGER);
- modid: ORS.Ident;
- pbsList: PtrBase; (*list of names of pointer base types*)
- dummy: ORB.Object;
- W: Texts.Writer;
-
- PROCEDURE Check(s: INTEGER; msg: ARRAY OF CHAR);
- BEGIN
- IF sym = s THEN ORS.Get(sym) ELSE ORS.Mark(msg) END
- END Check;
-
- PROCEDURE qualident(VAR obj: ORB.Object);
- BEGIN obj := ORB.thisObj(); ORS.Get(sym);
- IF obj = NIL THEN ORS.Mark("undef"); obj := dummy END ;
- IF (sym = ORS.period) & (obj.class = ORB.Mod) THEN
- ORS.Get(sym);
- IF sym = ORS.ident THEN obj := ORB.thisimport(obj); ORS.Get(sym);
- IF obj = NIL THEN ORS.Mark("undef"); obj := dummy END
- ELSE ORS.Mark("identifier expected"); obj := dummy
- END
- END
- END qualident;
-
- PROCEDURE CheckBool(VAR x: ORG.Item);
- BEGIN
- IF x.type.form # ORB.Bool THEN ORS.Mark("not Boolean"); x.type := ORB.boolType END
- END CheckBool;
-
- PROCEDURE CheckInt(VAR x: ORG.Item);
- BEGIN
- IF x.type.form # ORB.Int THEN ORS.Mark("not Integer"); x.type := ORB.intType END
- END CheckInt;
-
- PROCEDURE CheckReal(VAR x: ORG.Item);
- BEGIN
- IF x.type.form # ORB.Real THEN ORS.Mark("not Real"); x.type := ORB.realType END
- END CheckReal;
-
- PROCEDURE CheckSet(VAR x: ORG.Item);
- BEGIN
- IF x.type.form # ORB.Set THEN ORS.Mark("not Set"); x.type := ORB.setType END
- END CheckSet;
-
- PROCEDURE CheckSetVal(VAR x: ORG.Item);
- BEGIN
- IF x.type.form # ORB.Int THEN ORS.Mark("not Int"); x.type := ORB.setType
- ELSIF x.mode = ORB.Const THEN
- IF (x.a < 0) OR (x.a >= 32) THEN ORS.Mark("invalid set") END
- END
- END CheckSetVal;
-
- PROCEDURE CheckConst(VAR x: ORG.Item);
- BEGIN
- IF x.mode # ORB.Const THEN ORS.Mark("not a constant"); x.mode := ORB.Const END
- END CheckConst;
-
- PROCEDURE CheckReadOnly(VAR x: ORG.Item);
- BEGIN
- IF x.rdo THEN ORS.Mark("read-only") END
- END CheckReadOnly;
-
- PROCEDURE CheckExport(VAR expo: BOOLEAN);
- BEGIN
- IF sym = ORS.times THEN
- expo := TRUE; ORS.Get(sym);
- IF level # 0 THEN ORS.Mark("remove asterisk") END
- ELSE expo := FALSE
- END
- END CheckExport;
-
- PROCEDURE IsExtension(t0, t1: ORB.Type): BOOLEAN;
- BEGIN (*t1 is an extension of t0*)
- RETURN (t0 = t1) OR (t1 # NIL) & IsExtension(t0, t1.base)
- END IsExtension;
-
- (* expressions *)
-
- PROCEDURE TypeTest(VAR x: ORG.Item; T: ORB.Type; guard: BOOLEAN);
- VAR xt: ORB.Type;
- BEGIN xt := x.type;
- WHILE (xt # T) & (xt # NIL) DO xt := xt.base END ;
- IF xt # T THEN xt := x.type;
- IF (xt.form = ORB.Pointer) & (T.form = ORB.Pointer) THEN
- IF IsExtension(xt.base, T.base) THEN ORG.TypeTest(x, T.base, FALSE, guard); x.type := T
- ELSE ORS.Mark("not an extension")
- END
- ELSIF (xt.form = ORB.Record) & (T.form = ORB.Record) & (x.mode = ORB.Par) THEN
- IF IsExtension(xt, T) THEN ORG.TypeTest(x, T, TRUE, guard); x.type := T
- ELSE ORS.Mark("not an extension")
- END
- ELSE ORS.Mark("incompatible types")
- END
- ELSIF ~guard THEN ORG.MakeConstItem(x, ORB.boolType, 1)
- END ;
- IF ~guard THEN x.type := ORB.boolType END
- END TypeTest;
-
- PROCEDURE selector(VAR x: ORG.Item);
- VAR y: ORG.Item; obj: ORB.Object;
- BEGIN
- WHILE (sym = ORS.lbrak) OR (sym = ORS.period) OR (sym = ORS.arrow)
- OR (sym = ORS.lparen) & (x.type.form IN {ORB.Record, ORB.Pointer}) DO
- IF sym = ORS.lbrak THEN
- REPEAT ORS.Get(sym); expression(y);
- IF x.type.form = ORB.Array THEN
- CheckInt(y); ORG.Index(x, y); x.type := x.type.base
- ELSE ORS.Mark("not an array")
- END
- UNTIL sym # ORS.comma;
- Check(ORS.rbrak, "no ]")
- ELSIF sym = ORS.period THEN ORS.Get(sym);
- IF sym = ORS.ident THEN
- IF x.type.form = ORB.Pointer THEN ORG.DeRef(x); x.type := x.type.base END ;
- IF x.type.form = ORB.Record THEN
- obj := ORB.thisfield(x.type); ORS.Get(sym);
- IF obj # NIL THEN ORG.Field(x, obj); x.type := obj.type
- ELSE ORS.Mark("undef")
- END
- ELSE ORS.Mark("not a record")
- END
- ELSE ORS.Mark("ident?")
- END
- ELSIF sym = ORS.arrow THEN
- ORS.Get(sym);
- IF x.type.form = ORB.Pointer THEN ORG.DeRef(x); x.type := x.type.base
- ELSE ORS.Mark("not a pointer")
- END
- ELSIF (sym = ORS.lparen) & (x.type.form IN {ORB.Record, ORB.Pointer}) THEN (*type guard*)
- ORS.Get(sym);
- IF sym = ORS.ident THEN
- qualident(obj);
- IF obj.class = ORB.Typ THEN TypeTest(x, obj.type, TRUE)
- ELSE ORS.Mark("guard type expected")
- END
- ELSE ORS.Mark("not an identifier")
- END ;
- Check(ORS.rparen, " ) missing")
- END
- END
- END selector;
-
- PROCEDURE CompTypes(t0, t1: ORB.Type; varpar: BOOLEAN): BOOLEAN;
-
- PROCEDURE EqualSignatures(t0, t1: ORB.Type): BOOLEAN;
- VAR p0, p1: ORB.Object; com: BOOLEAN;
- BEGIN com := TRUE;
- IF (t0.base = t1.base) & (t0.nofpar = t1.nofpar) THEN
- p0 := t0.dsc; p1 := t1.dsc;
- WHILE p0 # NIL DO
- IF (p0.class = p1.class) & CompTypes(p0.type, p1.type, TRUE) &
- (*(ORD(p0.rdo) = ORD(p1.rdo))*)
- (p0.rdo = p1.rdo) (* voc adaptation by noch *)
- THEN
- IF p0.type.form >= ORB.Array THEN com := CompTypes(p0.type, p1.type, (p0.class = ORB.Par)) END ;
- p0 := p0.next; p1 := p1.next
- ELSE p0 := NIL; com := FALSE
- END
- END
- ELSE com := FALSE
- END ;
- RETURN com
- END EqualSignatures;
-
- BEGIN (*Compatible Types*)
- RETURN (t0 = t1)
- OR (t0.form = ORB.Array) & (t1.form = ORB.Array) & CompTypes(t0.base, t1.base, varpar)
- OR (t0.form = ORB.Pointer) & (t1.form = ORB.Pointer) & IsExtension(t0.base, t1.base)
- OR (t0.form = ORB.Record) & (t1.form = ORB.Record) & IsExtension(t0, t1)
- OR (t0.form = ORB.Proc) & (t1.form = ORB.Proc) & EqualSignatures(t0, t1)
- OR (t0.form IN {ORB.Pointer, ORB.Proc}) & (t1.form = ORB.NilTyp)
- OR (t0.form = ORB.NilTyp) & (t1.form IN {ORB.Pointer, ORB.Proc})
- OR ~varpar & (t0.form = ORB.Int) & (t1.form = ORB.Int)
- END CompTypes;
-
- PROCEDURE Parameter(par: ORB.Object);
- VAR x: ORG.Item; varpar: BOOLEAN;
- BEGIN expression(x);
- IF par # NIL THEN
- varpar := par.class = ORB.Par;
- IF CompTypes(par.type, x.type, varpar) THEN
- IF ~varpar THEN ORG.ValueParam(x)
- ELSE (*par.class = Par*)
- IF ~par.rdo THEN CheckReadOnly(x) END ;
- ORG.VarParam(x, par.type)
- END
- ELSIF ~varpar & (par.type.form = ORB.Int) & (x.type.form = ORB.Int) THEN
- ORG.ValueParam(x)
- ELSIF (x.type.form = ORB.String) & (x.b = 2) & (par.class = ORB.Var) & (par.type.form = ORB.Char) THEN
- ORG.StrToChar(x); ORG.ValueParam(x)
- ELSIF (x.type.form = ORB.Array) & (par.type.form = ORB.Array) &
- (x.type.base.form = par.type.base.form) & (par.type.len < 0) THEN
- ORG.OpenArrayParam(x);
- ELSIF (x.type.form = ORB.String) & varpar & par.rdo & (par.type.form = ORB.Array) &
- (par.type.base.form = ORB.Char) & (par.type.len < 0) THEN ORG.StringParam(x)
- ELSIF (par.type.form = ORB.Array) & (par.type.base.form = ORB.Int) & (par.type.size = x.type.size) THEN
- ORG.VarParam(x, par.type)
- ELSE ORS.Mark("incompatible parameters")
- END
- END
- END Parameter;
-
- PROCEDURE ParamList(VAR x: ORG.Item);
- VAR n: INTEGER; par: ORB.Object;
- BEGIN par := x.type.dsc; n := 0;
- IF sym # ORS.rparen THEN
- Parameter(par); n := 1;
- WHILE sym <= ORS.comma DO
- Check(sym, "comma?");
- IF par # NIL THEN par := par.next END ;
- INC(n); Parameter(par)
- END ;
- Check(ORS.rparen, ") missing")
- ELSE ORS.Get(sym);
- END ;
- IF n < x.type.nofpar THEN ORS.Mark("too few params")
- ELSIF n > x.type.nofpar THEN ORS.Mark("too many params")
- END
- END ParamList;
-
- PROCEDURE StandFunc(VAR x: ORG.Item; fct: LONGINT; restyp: ORB.Type);
- VAR y: ORG.Item; n, npar: LONGINT;
- BEGIN Check(ORS.lparen, "no (");
- npar := fct MOD 10; fct := fct DIV 10; expression(x); n := 1;
- WHILE sym = ORS.comma DO ORS.Get(sym); expression(y); INC(n) END ;
- Check(ORS.rparen, "no )");
- IF n = npar THEN
- IF fct = 0 THEN (*ABS*)
- IF x.type.form IN {ORB.Int, ORB.Real} THEN ORG.Abs(x); restyp := x.type ELSE ORS.Mark("bad type") END
- ELSIF fct = 1 THEN (*ODD*) CheckInt(x); ORG.Odd(x)
- ELSIF fct = 2 THEN (*FLOOR*) CheckReal(x); ORG.Floor(x)
- ELSIF fct = 3 THEN (*FLT*) CheckInt(x); ORG.Float(x)
- ELSIF fct = 4 THEN (*ORD*)
- IF x.type.form <= ORB.Proc THEN ORG.Ord(x)
- ELSIF (x.type.form = ORB.String) & (x.b = 2) THEN ORG.StrToChar(x)
- ELSE ORS.Mark("bad type")
- END
- ELSIF fct = 5 THEN (*CHR*) CheckInt(x); ORG.Ord(x)
- ELSIF fct = 6 THEN (*LEN*)
- IF x.type.form = ORB.Array THEN ORG.Len(x) ELSE ORS.Mark("not an array") END
- ELSIF fct IN {7, 8, 9} THEN (*LSL, ASR, ROR*) CheckInt(y);
- IF x.type.form IN {ORB.Int, ORB.Set} THEN ORG.Shift(fct-7, x, y); restyp := x.type ELSE ORS.Mark("bad type") END
- ELSIF fct = 11 THEN (*ADC*) ORG.ADC(x, y)
- ELSIF fct = 12 THEN (*SBC*) ORG.SBC(x, y)
- ELSIF fct = 13 THEN (*UML*) ORG.UML(x, y)
- ELSIF fct = 14 THEN (*BIT*) CheckInt(x); CheckInt(y); ORG.Bit(x, y)
- ELSIF fct = 15 THEN (*REG*) CheckConst(x); CheckInt(x); ORG.Register(x)
- ELSIF fct = 16 THEN (*VAL*)
- IF (x.mode= ORB.Typ) & (x.type.size <= y.type.size) THEN restyp := x.type; x := y
- ELSE ORS.Mark("casting not allowed")
- END
- ELSIF fct = 17 THEN (*ADR*) ORG.Adr(x)
- ELSIF fct = 18 THEN (*SIZE*)
- IF x.mode = ORB.Typ THEN ORG.MakeConstItem(x, ORB.intType, x.type.size)
- ELSE ORS.Mark("must be a type")
- END
- ELSIF fct = 19 THEN (*COND*) CheckConst(x); CheckInt(x); ORG.Condition(x)
- ELSIF fct = 20 THEN (*H*) CheckConst(x); CheckInt(x); ORG.H(x)
- END ;
- x.type := restyp
- ELSE ORS.Mark("wrong nof params")
- END
- END StandFunc;
-
- PROCEDURE element(VAR x: ORG.Item);
- VAR y: ORG.Item;
- BEGIN expression(x); CheckSetVal(x);
- IF sym = ORS.upto THEN ORS.Get(sym); expression(y); CheckSetVal(y); ORG.Set(x, y)
- ELSE ORG.Singleton(x)
- END ;
- x.type := ORB.setType
- END element;
-
- PROCEDURE set(VAR x: ORG.Item);
- VAR y: ORG.Item;
- BEGIN
- IF sym >= ORS.if THEN
- IF sym # ORS.rbrace THEN ORS.Mark(" } missing") END ;
- ORG.MakeConstItem(x, ORB.setType, 0) (*empty set*)
- ELSE element(x);
- WHILE (sym < ORS.rparen) OR (sym > ORS.rbrace) DO
- IF sym = ORS.comma THEN ORS.Get(sym)
- ELSIF sym # ORS.rbrace THEN ORS.Mark("missing comma")
- END ;
- element(y); ORG.SetOp(ORS.plus, x, y)
- END
- END
- END set;
-
- PROCEDURE factor(VAR x: ORG.Item);
- VAR obj: ORB.Object; rx: LONGINT;
- BEGIN (*sync*)
- IF (sym < ORS.char) OR (sym > ORS.ident) THEN ORS.Mark("expression expected");
- REPEAT ORS.Get(sym) UNTIL (sym >= ORS.char) & (sym <= ORS.ident)
- END ;
- IF sym = ORS.ident THEN
- qualident(obj);
- IF obj.class = ORB.SFunc THEN StandFunc(x, obj.val, obj.type)
- ELSE ORG.MakeItem(x, obj, level); selector(x);
- IF sym = ORS.lparen THEN
- ORS.Get(sym);
- IF (x.type.form = ORB.Proc) & (x.type.base.form # ORB.NoTyp) THEN
- ORG.PrepCall(x, rx); ParamList(x); ORG.Call(x, rx); x.type := x.type.base
- ELSE ORS.Mark("not a function"); ParamList(x)
- END
- END
- END
- ELSIF sym = ORS.int THEN ORG.MakeConstItem(x, ORB.intType, ORS.ival); ORS.Get(sym)
- ELSIF sym = ORS.real THEN ORG.MakeRealItem(x, ORS.rval); ORS.Get(sym)
- ELSIF sym = ORS.char THEN ORG.MakeConstItem(x, ORB.charType, ORS.ival); ORS.Get(sym)
- ELSIF sym = ORS.nil THEN ORS.Get(sym); ORG.MakeConstItem(x, ORB.nilType, 0)
- ELSIF sym = ORS.string THEN ORG.MakeStringItem(x, ORS.slen); ORS.Get(sym)
- ELSIF sym = ORS.lparen THEN ORS.Get(sym); expression(x); Check(ORS.rparen, "no )")
- ELSIF sym = ORS.lbrace THEN ORS.Get(sym); set(x); Check(ORS.rbrace, "no }")
- ELSIF sym = ORS.not THEN ORS.Get(sym); factor(x); CheckBool(x); ORG.Not(x)
- ELSIF sym = ORS.false THEN ORS.Get(sym); ORG.MakeConstItem(x, ORB.boolType, 0)
- ELSIF sym = ORS.true THEN ORS.Get(sym); ORG.MakeConstItem(x, ORB.boolType, 1)
- ELSE ORS.Mark("not a factor"); ORG.MakeItem(x, NIL, level)
- END
- END factor;
-
- PROCEDURE term(VAR x: ORG.Item);
- VAR y: ORG.Item; op, f: INTEGER;
- BEGIN factor(x); f := x.type.form;
- WHILE (sym >= ORS.times) & (sym <= ORS.and) DO
- op := sym; ORS.Get(sym);
- IF op = ORS.times THEN
- IF f = ORB.Int THEN factor(y); CheckInt(y); ORG.MulOp(x, y)
- ELSIF f = ORB.Real THEN factor(y); CheckReal(y); ORG.RealOp(op, x, y)
- ELSIF f = ORB.Set THEN factor(y); CheckSet(y); ORG.SetOp(op, x, y)
- ELSE ORS.Mark("bad type")
- END
- ELSIF (op = ORS.div) OR (op = ORS.mod) THEN
- CheckInt(x); factor(y); CheckInt(y); ORG.DivOp(op, x, y)
- ELSIF op = ORS.rdiv THEN
- IF f = ORB.Real THEN factor(y); CheckReal(y); ORG.RealOp(op, x, y)
- ELSIF f = ORB.Set THEN factor(y); CheckSet(y); ORG.SetOp(op, x, y)
- ELSE ORS.Mark("bad type")
- END
- ELSE (*op = and*) CheckBool(x); ORG.And1(x); factor(y); CheckBool(y); ORG.And2(x, y)
- END
- END
- END term;
-
- PROCEDURE SimpleExpression(VAR x: ORG.Item);
- VAR y: ORG.Item; op: INTEGER;
- BEGIN
- IF sym = ORS.minus THEN ORS.Get(sym); term(x);
- IF x.type.form IN {ORB.Int, ORB.Real, ORB.Set} THEN ORG.Neg(x) ELSE CheckInt(x) END
- ELSIF sym = ORS.plus THEN ORS.Get(sym); term(x);
- ELSE term(x)
- END ;
- WHILE (sym >= ORS.plus) & (sym <= ORS.or) DO
- op := sym; ORS.Get(sym);
- IF op = ORS.or THEN ORG.Or1(x); CheckBool(x); term(y); CheckBool(y); ORG.Or2(x, y)
- ELSIF x.type.form = ORB.Int THEN term(y); CheckInt(y); ORG.AddOp(op, x, y)
- ELSIF x.type.form = ORB.Real THEN term(y); CheckReal(y); ORG.RealOp(op, x, y)
- ELSE CheckSet(x); term(y); CheckSet(y); ORG.SetOp(op, x, y)
- END
- END
- END SimpleExpression;
-
- PROCEDURE expression0(VAR x: ORG.Item);
- VAR y: ORG.Item; obj: ORB.Object; rel, xf, yf: INTEGER;
- BEGIN SimpleExpression(x);
- IF (sym >= ORS.eql) & (sym <= ORS.geq) THEN
- rel := sym; ORS.Get(sym); SimpleExpression(y); xf := x.type.form; yf := y.type.form;
- IF CompTypes(x.type, y.type, FALSE) OR
- (xf = ORB.Pointer) & (yf = ORB.Pointer) & IsExtension(y.type.base, x.type.base) THEN
- IF (xf IN {ORB.Char, ORB.Int}) THEN ORG.IntRelation(rel, x, y)
- ELSIF xf = ORB.Real THEN ORG.RealRelation(rel, x, y)
- ELSIF xf = ORB.Set THEN ORG.SetRelation(rel, x, y)
- ELSIF (xf IN {ORB.Pointer, ORB.Proc, ORB.NilTyp}) THEN
- IF rel <= ORS.neq THEN ORG.IntRelation(rel, x, y) ELSE ORS.Mark("only = or #") END
- ELSIF (xf = ORB.Array) & (x.type.base.form = ORB.Char) OR (xf = ORB.String) THEN
- ORG.StringRelation(rel, x, y)
- ELSE ORS.Mark("illegal comparison")
- END
- ELSIF (xf = ORB.Array) & (x.type.base.form = ORB.Char) &
- ((yf = ORB.String) OR (yf = ORB.Array) & (y.type.base.form = ORB.Char))
- OR (yf = ORB.Array) & (y.type.base.form = ORB.Char) & (xf = ORB.String) THEN
- ORG.StringRelation(rel, x, y)
- ELSIF (xf = ORB.Char) & (yf = ORB.String) & (y.b = 2) THEN
- ORG.StrToChar(y); ORG.IntRelation(rel, x, y)
- ELSIF (yf = ORB.Char) & (xf = ORB.String) & (x.b = 2) THEN
- ORG.StrToChar(x); ORG.IntRelation(rel, x, y)
- ELSE ORS.Mark("illegal comparison")
- END ;
- x.type := ORB.boolType
- ELSIF sym = ORS.in THEN
- ORS.Get(sym); SimpleExpression(y);
- IF (x.type.form = ORB.Int) & (y.type.form = ORB.Set) THEN ORG.In(x, y)
- ELSE ORS.Mark("illegal operands of IN")
- END ;
- x.type := ORB.boolType
- ELSIF sym = ORS.is THEN
- ORS.Get(sym); qualident(obj); TypeTest(x, obj.type, FALSE) ;
- x.type := ORB.boolType
- END
- END expression0;
-
- (* statements *)
-
- PROCEDURE StandProc(pno: LONGINT);
- VAR nap, npar: LONGINT; (*nof actual/formal parameters*)
- x, y, z: ORG.Item;
- BEGIN Check(ORS.lparen, "no (");
- npar := pno MOD 10; pno := pno DIV 10; expression(x); nap := 1;
- IF sym = ORS.comma THEN
- ORS.Get(sym); expression(y); nap := 2; z.type := ORB.noType;
- WHILE sym = ORS.comma DO ORS.Get(sym); expression(z); INC(nap) END
- ELSE y.type := ORB.noType
- END ;
- Check(ORS.rparen, "no )");
- IF (npar = nap) OR (pno IN {0, 1}) THEN
- IF pno IN {0, 1} THEN (*INC, DEC*)
- CheckInt(x); CheckReadOnly(x);
- IF y.type # ORB.noType THEN CheckInt(y) END ;
- ORG.Increment(pno, x, y)
- ELSIF pno IN {2, 3} THEN (*INCL, EXCL*)
- CheckSet(x); CheckReadOnly(x); CheckInt(y); ORG.Include(pno-2, x, y)
- ELSIF pno = 4 THEN CheckBool(x); ORG.Assert(x)
- ELSIF pno = 5 THEN(*NEW*) CheckReadOnly(x);
- IF (x.type.form = ORB.Pointer) & (x.type.base.form = ORB.Record) THEN ORG.New(x)
- ELSE ORS.Mark("not a pointer to record")
- END
- ELSIF pno = 6 THEN CheckReal(x); CheckInt(y); CheckReadOnly(x); ORG.Pack(x, y)
- ELSIF pno = 7 THEN CheckReal(x); CheckInt(y); CheckReadOnly(x); ORG.Unpk(x, y)
- ELSIF pno = 8 THEN
- IF x.type.form <= ORB.Set THEN ORG.Led(x) ELSE ORS.Mark("bad type") END
- ELSIF pno = 10 THEN CheckInt(x); ORG.Get(x, y)
- ELSIF pno = 11 THEN CheckInt(x); ORG.Put(x, y)
- ELSIF pno = 12 THEN CheckInt(x); CheckInt(y); CheckInt(z); ORG.Copy(x, y, z)
- ELSIF pno = 13 THEN CheckConst(x); CheckInt(x); ORG.LDPSR(x)
- ELSIF pno = 14 THEN CheckInt(x); ORG.LDREG(x, y)
- END
- ELSE ORS.Mark("wrong nof parameters")
- END
- END StandProc;
-
- PROCEDURE StatSequence;
- VAR obj: ORB.Object;
- orgtype: ORB.Type; (*original type of case var*)
- x, y, z, w: ORG.Item;
- L0, L1, rx: LONGINT;
-
- PROCEDURE TypeCase(obj: ORB.Object; VAR x: ORG.Item);
- VAR typobj: ORB.Object;
- BEGIN
- IF sym = ORS.ident THEN
- qualident(typobj); ORG.MakeItem(x, obj, level);
- IF typobj.class # ORB.Typ THEN ORS.Mark("not a type") END ;
- TypeTest(x, typobj.type, FALSE); obj.type := typobj.type;
- ORG.CFJump(x); Check(ORS.colon, ": expected"); StatSequence
- ELSE ORG.CFJump(x); ORS.Mark("type id expected")
- END
- END TypeCase;
-
- PROCEDURE SkipCase;
- BEGIN
- WHILE sym # ORS.colon DO ORS.Get(sym) END ;
- ORS.Get(sym); StatSequence
- END SkipCase;
-
- BEGIN (* StatSequence *)
- REPEAT (*sync*) obj := NIL;
- IF ~((sym = ORS.ident) OR (sym >= ORS.if) & (sym <= ORS.for) OR (sym >= ORS.semicolon)) THEN
- ORS.Mark("statement expected");
- REPEAT ORS.Get(sym) UNTIL (sym = ORS.ident) OR (sym >= ORS.if)
- END ;
- IF sym = ORS.ident THEN
- qualident(obj); ORG.MakeItem(x, obj, level);
- IF x.mode = ORB.SProc THEN StandProc(obj.val)
- ELSE selector(x);
- IF sym = ORS.becomes THEN (*assignment*)
- ORS.Get(sym); CheckReadOnly(x); expression(y);
- IF CompTypes(x.type, y.type, FALSE) OR (x.type.form = ORB.Int) & (y.type.form = ORB.Int) THEN
- IF (x.type.form <= ORB.Pointer) OR (x.type.form = ORB.Proc) THEN ORG.Store(x, y)
- ELSIF y.type.size # 0 THEN ORG.StoreStruct(x, y)
- END
- ELSIF (x.type.form = ORB.Char) & (y.type.form = ORB.String) & (y.b = 2) THEN
- ORG.StrToChar(y); ORG.Store(x, y)
- ELSIF (x.type.form = ORB.Array) & (x.type.base.form = ORB.Char) &
- (y.type.form = ORB.String) THEN ORG.CopyString(y, x)
- ELSE ORS.Mark("illegal assignment")
- END
- ELSIF sym = ORS.eql THEN ORS.Mark("should be :="); ORS.Get(sym); expression(y)
- ELSIF sym = ORS.lparen THEN (*procedure call*)
- ORS.Get(sym);
- IF (x.type.form = ORB.Proc) & (x.type.base.form = ORB.NoTyp) THEN
- ORG.PrepCall(x, rx); ParamList(x); ORG.Call(x, rx)
- ELSE ORS.Mark("not a procedure"); ParamList(x)
- END
- ELSIF x.type.form = ORB.Proc THEN (*procedure call without parameters*)
- IF x.type.nofpar > 0 THEN ORS.Mark("missing parameters") END ;
- IF x.type.base.form = ORB.NoTyp THEN ORG.PrepCall(x, rx); ORG.Call(x, rx) ELSE ORS.Mark("not a procedure") END
- ELSIF x.mode = ORB.Typ THEN ORS.Mark("illegal assignment")
- ELSE ORS.Mark("not a procedure")
- END
- END
- ELSIF sym = ORS.if THEN
- ORS.Get(sym); expression(x); CheckBool(x); ORG.CFJump(x);
- Check(ORS.then, "no THEN");
- StatSequence; L0 := 0;
- WHILE sym = ORS.elsif DO
- ORS.Get(sym); ORG.FJump(L0); ORG.Fixup(x); expression(x); CheckBool(x);
- ORG.CFJump(x); Check(ORS.then, "no THEN"); StatSequence
- END ;
- IF sym = ORS.else THEN ORS.Get(sym); ORG.FJump(L0); ORG.Fixup(x); StatSequence
- ELSE ORG.Fixup(x)
- END ;
- ORG.FixLink(L0); Check(ORS.end, "no END")
- ELSIF sym = ORS.while THEN
- ORS.Get(sym); L0 := ORG.Here(); expression(x); CheckBool(x); ORG.CFJump(x);
- Check(ORS.do, "no DO"); StatSequence; ORG.BJump(L0);
- WHILE sym = ORS.elsif DO
- ORS.Get(sym); ORG.Fixup(x); expression(x); CheckBool(x); ORG.CFJump(x);
- Check(ORS.do, "no DO"); StatSequence; ORG.BJump(L0)
- END ;
- ORG.Fixup(x); Check(ORS.end, "no END")
- ELSIF sym = ORS.repeat THEN
- ORS.Get(sym); L0 := ORG.Here(); StatSequence;
- IF sym = ORS.until THEN
- ORS.Get(sym); expression(x); CheckBool(x); ORG.CBJump(x, L0)
- ELSE ORS.Mark("missing UNTIL")
- END
- ELSIF sym = ORS.for THEN
- ORS.Get(sym);
- IF sym = ORS.ident THEN
- qualident(obj); ORG.MakeItem(x, obj, level); CheckInt(x); CheckReadOnly(x);
- IF sym = ORS.becomes THEN
- ORS.Get(sym); expression(y); CheckInt(y); ORG.For0(x, y); L0 := ORG.Here();
- Check(ORS.to, "no TO"); expression(z); CheckInt(z); obj.rdo := TRUE;
- IF sym = ORS.by THEN ORS.Get(sym); expression(w); CheckConst(w); CheckInt(w)
- ELSE ORG.MakeConstItem(w, ORB.intType, 1)
- END ;
- Check(ORS.do, "no DO"); ORG.For1(x, y, z, w, L1);
- StatSequence; Check(ORS.end, "no END");
- ORG.For2(x, y, w); ORG.BJump(L0); ORG.FixLink(L1); obj.rdo := FALSE
- ELSE ORS.Mark(":= expected")
- END
- ELSE ORS.Mark("identifier expected")
- END
- ELSIF sym = ORS.case THEN
- ORS.Get(sym);
- IF sym = ORS.ident THEN
- qualident(obj); orgtype := obj.type;
- IF (orgtype.form = ORB.Pointer) OR (orgtype.form = ORB.Record) & (obj.class = ORB.Par) THEN
- Check(ORS.of, "OF expected"); TypeCase(obj, x); L0 := 0;
- WHILE sym = ORS.bar DO
- ORS.Get(sym); ORG.FJump(L0); ORG.Fixup(x); obj.type := orgtype; TypeCase(obj, x)
- END ;
- ORG.Fixup(x); ORG.FixLink(L0); obj.type := orgtype
- ELSE ORS.Mark("numeric case not implemented");
- Check(ORS.of, "OF expected"); SkipCase;
- WHILE sym = ORS.bar DO SkipCase END
- END
- ELSE ORS.Mark("ident expected")
- END ;
- Check(ORS.end, "no END")
- END ;
- ORG.CheckRegs;
- IF sym = ORS.semicolon THEN ORS.Get(sym)
- ELSIF sym < ORS.semicolon THEN ORS.Mark("missing semicolon?")
- END
- UNTIL sym > ORS.semicolon
- END StatSequence;
-
- (* Types and declarations *)
-
- PROCEDURE IdentList(class: INTEGER; VAR first: ORB.Object);
- VAR obj: ORB.Object;
- BEGIN
- IF sym = ORS.ident THEN
- ORB.NewObj(first, ORS.id, class); ORS.Get(sym); CheckExport(first.expo);
- WHILE sym = ORS.comma DO
- ORS.Get(sym);
- IF sym = ORS.ident THEN ORB.NewObj(obj, ORS.id, class); ORS.Get(sym); CheckExport(obj.expo)
- ELSE ORS.Mark("ident?")
- END
- END;
- IF sym = ORS.colon THEN ORS.Get(sym) ELSE ORS.Mark(":?") END
- ELSE first := NIL
- END
- END IdentList;
-
- PROCEDURE ArrayType(VAR type: ORB.Type);
- VAR x: ORG.Item; typ: ORB.Type; len: LONGINT;
- BEGIN NEW(typ); typ.form := ORB.NoTyp;
- IF sym = ORS.of THEN (*dynamic array*) len := -1
- ELSE expression(x);
- IF (x.mode = ORB.Const) & (x.type.form = ORB.Int) & (x.a >= 0) THEN len := x.a
- ELSE len := 0; ORS.Mark("not a valid length")
- END
- END ;
- IF sym = ORS.of THEN ORS.Get(sym); Type(typ.base);
- IF (typ.base.form = ORB.Array) & (typ.base.len < 0) THEN ORS.Mark("dyn array not allowed") END
- ELSIF sym = ORS.comma THEN ORS.Get(sym); ArrayType(typ.base)
- ELSE ORS.Mark("missing OF"); typ.base := ORB.intType
- END ;
- IF len >= 0 THEN typ.size := (len * typ.base.size + 3) DIV 4 * 4 ELSE typ.size := 2*ORG.WordSize (*array desc*) END ;
- typ.form := ORB.Array; typ.len := len; type := typ
- END ArrayType;
-
- PROCEDURE RecordType(VAR type: ORB.Type);
- VAR obj, obj0, new, bot, base: ORB.Object;
- typ, tp: ORB.Type;
- offset, off, n: LONGINT;
- BEGIN NEW(typ); typ.form := ORB.NoTyp; typ.base := NIL; typ.mno := -level; typ.nofpar := 0; offset := 0; bot := NIL;
- IF sym = ORS.lparen THEN
- ORS.Get(sym); (*record extension*)
- IF level # 0 THEN ORS.Mark("extension of local types not implemented") END ;
- IF sym = ORS.ident THEN
- qualident(base);
- IF base.class = ORB.Typ THEN
- IF base.type.form = ORB.Record THEN typ.base := base.type
- ELSE typ.base := ORB.intType; ORS.Mark("invalid extension")
- END ;
- typ.nofpar := typ.base.nofpar + 1; (*"nofpar" here abused for extension level*)
- bot := typ.base.dsc; offset := typ.base.size
- ELSE ORS.Mark("type expected")
- END
- ELSE ORS.Mark("ident expected")
- END ;
- Check(ORS.rparen, "no )")
- END ;
- WHILE sym = ORS.ident DO (*fields*)
- n := 0; obj := bot;
- WHILE sym = ORS.ident DO
- obj0 := obj;
- WHILE (obj0 # NIL) & (obj0.name # ORS.id) DO obj0 := obj0.next END ;
- IF obj0 # NIL THEN ORS.Mark("mult def") END ;
- NEW(new); ORS.CopyId(new.name); new.class := ORB.Fld; new.next := obj; obj := new; INC(n);
- ORS.Get(sym); CheckExport(new.expo);
- IF (sym # ORS.comma) & (sym # ORS.colon) THEN ORS.Mark("comma expected")
- ELSIF sym = ORS.comma THEN ORS.Get(sym)
- END
- END ;
- Check(ORS.colon, "colon expected"); Type(tp);
- IF (tp.form = ORB.Array) & (tp.len < 0) THEN ORS.Mark("dyn array not allowed") END ;
- IF tp.size > 1 THEN offset := (offset+3) DIV 4 * 4 END ;
- offset := offset + n * tp.size; off := offset; obj0 := obj;
- WHILE obj0 # bot DO obj0.type := tp; obj0.lev := 0; off := off - tp.size; obj0.val := off; obj0 := obj0.next END ;
- bot := obj;
- IF sym = ORS.semicolon THEN ORS.Get(sym) ELSIF sym # ORS.end THEN ORS.Mark(" ; or END") END
- END ;
- typ.form := ORB.Record; typ.dsc := bot; typ.size := (offset + 3) DIV 4 * 4; type := typ
- END RecordType;
-
- PROCEDURE FPSection(VAR adr: LONGINT; VAR nofpar: INTEGER);
- VAR obj, first: ORB.Object; tp: ORB.Type;
- parsize: LONGINT; cl: INTEGER; rdo: BOOLEAN;
- BEGIN
- IF sym = ORS.var THEN ORS.Get(sym); cl := ORB.Par ELSE cl := ORB.Var END ;
- IdentList(cl, first); FormalType(tp, 0); rdo := FALSE;
- IF (cl = ORB.Var) & (tp.form >= ORB.Array) THEN cl := ORB.Par; rdo := TRUE END ;
- IF (tp.form = ORB.Array) & (tp.len < 0) OR (tp.form = ORB.Record) THEN
- parsize := 2*ORG.WordSize (*open array or record, needs second word for length or type tag*)
- ELSE parsize := ORG.WordSize
- END ;
- obj := first;
- WHILE obj # NIL DO
- INC(nofpar); obj.class := cl; obj.type := tp; obj.rdo := rdo; obj.lev := level; obj.val := adr;
- adr := adr + parsize; obj := obj.next
- END ;
- IF adr >= 52 THEN ORS.Mark("too many parameters") END
- END FPSection;
-
- PROCEDURE ProcedureType(ptype: ORB.Type; VAR parblksize: LONGINT);
- VAR obj: ORB.Object; size: LONGINT; nofpar: INTEGER;
- BEGIN ptype.base := ORB.noType; size := parblksize; nofpar := 0; ptype.dsc := NIL;
- IF sym = ORS.lparen THEN
- ORS.Get(sym);
- IF sym = ORS.rparen THEN ORS.Get(sym)
- ELSE FPSection(size, nofpar);
- WHILE sym = ORS.semicolon DO ORS.Get(sym); FPSection(size, nofpar) END ;
- Check(ORS.rparen, "no )")
- END ;
- ptype.nofpar := nofpar; parblksize := size;
- IF sym = ORS.colon THEN (*function*)
- ORS.Get(sym);
- IF sym = ORS.ident THEN qualident(obj);
- IF (obj.class = ORB.Typ) & (obj.type.form IN {ORB.Byte .. ORB.Pointer, ORB.Proc}) THEN ptype.base := obj.type
- ELSE ORS.Mark("illegal function type")
- END
- ELSE ORS.Mark("type identifier expected")
- END
- END
- END
- END ProcedureType;
-
- PROCEDURE FormalType0(VAR typ: ORB.Type; dim: INTEGER);
- VAR obj: ORB.Object; dmy: LONGINT;
- BEGIN
- IF sym = ORS.ident THEN
- qualident(obj);
- IF obj.class = ORB.Typ THEN typ := obj.type ELSE ORS.Mark("not a type"); typ := ORB.intType END
- ELSIF sym = ORS.array THEN
- ORS.Get(sym); Check(ORS.of, "OF ?");
- IF dim >= 1 THEN ORS.Mark("multi-dimensional open arrays not implemented") END ;
- NEW(typ); typ.form := ORB.Array; typ.len := -1; typ.size := 2*ORG.WordSize;
- FormalType(typ.base, dim+1)
- ELSIF sym = ORS.procedure THEN
- ORS.Get(sym); ORB.OpenScope;
- NEW(typ); typ.form := ORB.Proc; typ.size := ORG.WordSize; dmy := 0; ProcedureType(typ, dmy);
- typ.dsc := ORB.topScope.next; ORB.CloseScope
- ELSE ORS.Mark("identifier expected"); typ := ORB.noType
- END
- END FormalType0;
-
- PROCEDURE CheckRecLevel(lev: INTEGER);
- BEGIN
- IF lev # 0 THEN ORS.Mark("ptr base must be global") END
- END CheckRecLevel;
-
- PROCEDURE Type0(VAR type: ORB.Type);
- VAR dmy: LONGINT; obj: ORB.Object; ptbase: PtrBase;
- BEGIN type := ORB.intType; (*sync*)
- IF (sym # ORS.ident) & (sym < ORS.array) THEN ORS.Mark("not a type");
- REPEAT ORS.Get(sym) UNTIL (sym = ORS.ident) OR (sym >= ORS.array)
- END ;
- IF sym = ORS.ident THEN
- qualident(obj);
- IF obj.class = ORB.Typ THEN
- IF (obj.type # NIL) & (obj.type.form # ORB.NoTyp) THEN type := obj.type END
- ELSE ORS.Mark("not a type or undefined")
- END
- ELSIF sym = ORS.array THEN ORS.Get(sym); ArrayType(type)
- ELSIF sym = ORS.record THEN
- ORS.Get(sym); RecordType(type); Check(ORS.end, "no END")
- ELSIF sym = ORS.pointer THEN
- ORS.Get(sym); Check(ORS.to, "no TO");
- NEW(type); type.form := ORB.Pointer; type.size := ORG.WordSize; type.base := ORB.intType;
- IF sym = ORS.ident THEN
- obj := ORB.thisObj(); ORS.Get(sym);
- IF obj # NIL THEN
- IF (obj.class = ORB.Typ) & (obj.type.form IN {ORB.Record, ORB.NoTyp}) THEN
- CheckRecLevel(obj.lev); type.base := obj.type
- ELSE ORS.Mark("no valid base type")
- END
- ELSE CheckRecLevel(level); (*enter into list of forward references to be fixed in Declarations*)
- NEW(ptbase); ORS.CopyId(ptbase.name); ptbase.type := type; ptbase.next := pbsList; pbsList := ptbase
- END
- ELSE Type(type.base);
- IF type.base.form # ORB.Record THEN ORS.Mark("must point to record") END ;
- CheckRecLevel(level)
- END
- ELSIF sym = ORS.procedure THEN
- ORS.Get(sym); ORB.OpenScope;
- NEW(type); type.form := ORB.Proc; type.size := ORG.WordSize; dmy := 0;
- ProcedureType(type, dmy); type.dsc := ORB.topScope.next; ORB.CloseScope
- ELSE ORS.Mark("illegal type")
- END
- END Type0;
-
- PROCEDURE Declarations(VAR varsize: LONGINT);
- VAR obj, first: ORB.Object;
- x: ORG.Item; tp: ORB.Type; ptbase: PtrBase;
- expo: BOOLEAN; id: ORS.Ident;
- BEGIN (*sync*) pbsList := NIL;
- IF (sym < ORS.const) & (sym # ORS.end) THEN ORS.Mark("declaration?");
- REPEAT ORS.Get(sym) UNTIL (sym >= ORS.const) OR (sym = ORS.end)
- END ;
- IF sym = ORS.const THEN
- ORS.Get(sym);
- WHILE sym = ORS.ident DO
- ORS.CopyId(id); ORS.Get(sym); CheckExport(expo);
- IF sym = ORS.eql THEN ORS.Get(sym) ELSE ORS.Mark("= ?") END;
- expression(x);
- IF (x.type.form = ORB.String) & (x.b = 2) THEN ORG.StrToChar(x) END ;
- ORB.NewObj(obj, id, ORB.Const); obj.expo := expo;
- IF x.mode = ORB.Const THEN obj.val := x.a; obj.lev := x.b; obj.type := x.type
- ELSE ORS.Mark("expression not constant"); obj.type := ORB.intType
- END;
- Check(ORS.semicolon, "; missing")
- END
- END ;
- IF sym = ORS.type THEN
- ORS.Get(sym);
- WHILE sym = ORS.ident DO
- ORS.CopyId(id); ORS.Get(sym); CheckExport(expo);
- IF sym = ORS.eql THEN ORS.Get(sym) ELSE ORS.Mark("=?") END ;
- Type(tp);
- ORB.NewObj(obj, id, ORB.Typ); obj.type := tp; obj.expo := expo; obj.lev := level; tp.typobj := obj;
- IF expo & (obj.type.form = ORB.Record) THEN obj.exno := exno; INC(exno) ELSE obj.exno := 0 END ;
- IF tp.form = ORB.Record THEN
- ptbase := pbsList; (*check whether this is base of a pointer type; search and fixup*)
- WHILE ptbase # NIL DO
- IF obj.name = ptbase.name THEN ptbase.type.base := obj.type END ;
- ptbase := ptbase.next
- END ;
- IF level = 0 THEN ORG.BuildTD(tp, dc) END (*type descriptor; len used as its address*)
- END ;
- Check(ORS.semicolon, "; missing")
- END
- END ;
- IF sym = ORS.var THEN
- ORS.Get(sym);
- WHILE sym = ORS.ident DO
- IdentList(ORB.Var, first); Type(tp);
- obj := first;
- WHILE obj # NIL DO
- obj.type := tp; obj.lev := level;
- IF tp.size > 1 THEN varsize := (varsize + 3) DIV 4 * 4 (*align*) END ;
- obj.val := varsize; varsize := varsize + obj.type.size;
- IF obj.expo THEN obj.exno := exno; INC(exno) END ;
- obj := obj.next
- END ;
- Check(ORS.semicolon, "; missing")
- END
- END ;
- varsize := (varsize + 3) DIV 4 * 4;
- ptbase := pbsList;
- WHILE ptbase # NIL DO
- IF ptbase.type.base.form = ORB.Int THEN ORS.Mark("undefined pointer base of") END ;
- ptbase := ptbase.next
- END ;
- IF (sym >= ORS.const) & (sym <= ORS.var) THEN ORS.Mark("declaration in bad order") END
- END Declarations;
-
- PROCEDURE ProcedureDecl;
- VAR proc: ORB.Object;
- type: ORB.Type;
- procid: ORS.Ident;
- x: ORG.Item;
- locblksize, parblksize, L: LONGINT;
- int: BOOLEAN;
- BEGIN (* ProcedureDecl *) int := FALSE; ORS.Get(sym);
- IF sym = ORS.times THEN ORS.Get(sym); int := TRUE END ;
- IF sym = ORS.ident THEN
- ORS.CopyId(procid); ORS.Get(sym);
- ORB.NewObj(proc, ORS.id, ORB.Const); parblksize := 4;
- NEW(type); type.form := ORB.Proc; type.size := ORG.WordSize; proc.type := type;
- CheckExport(proc.expo);
- IF proc.expo THEN proc.exno := exno; INC(exno) END ;
- ORB.OpenScope; INC(level); proc.val := -1; type.base := ORB.noType;
- ProcedureType(type, parblksize); (*formal parameter list*)
- Check(ORS.semicolon, "no ;"); locblksize := parblksize;
- Declarations(locblksize);
- proc.val := ORG.Here() * 4; proc.type.dsc := ORB.topScope.next;
- IF sym = ORS.procedure THEN
- L := 0; ORG.FJump(L);
- REPEAT ProcedureDecl; Check(ORS.semicolon, "no ;") UNTIL sym # ORS.procedure;
- ORG.FixLink(L); proc.val := ORG.Here() * 4; proc.type.dsc := ORB.topScope.next
- END ;
- ORG.Enter(parblksize, locblksize, int);
- IF sym = ORS.begin THEN ORS.Get(sym); StatSequence END ;
- IF sym = ORS.return THEN
- ORS.Get(sym); expression(x);
- IF type.base = ORB.noType THEN ORS.Mark("this is not a function")
- ELSIF ~CompTypes(type.base, x.type, FALSE) THEN ORS.Mark("wrong result type")
- END
- ELSIF type.base.form # ORB.NoTyp THEN
- ORS.Mark("function without result"); type.base := ORB.noType
- END ;
- ORG.Return(type.base.form, x, locblksize, int);
- ORB.CloseScope; DEC(level); Check(ORS.end, "no END");
- IF sym = ORS.ident THEN
- IF ORS.id # procid THEN ORS.Mark("no match") END ;
- ORS.Get(sym)
- ELSE ORS.Mark("no proc id")
- END
- END ;
- int := FALSE
- END ProcedureDecl;
-
- PROCEDURE Module;
- VAR key: LONGINT;
- obj: ORB.Object;
- impid, impid1: ORS.Ident;
- BEGIN Texts.WriteString(W, " compiling "); ORS.Get(sym);
- IF sym = ORS.module THEN
- ORS.Get(sym);
- IF sym = ORS.times THEN version := 0; Texts.Write(W, "*"); ORS.Get(sym) ELSE version := 1 END ;
- ORB.Init; ORB.OpenScope;
- IF sym = ORS.ident THEN
- ORS.CopyId(modid); ORS.Get(sym);
- Texts.WriteString(W, modid); Texts.Append(Oberon.Log, W.buf);
- Oberon.DumpLog; (* voc adaptation; -- noch *)
- ELSE ORS.Mark("identifier expected")
- END ;
- Check(ORS.semicolon, "no ;"); level := 0; dc := 0; exno := 1; key := 0;
- IF sym = ORS.import THEN
- ORS.Get(sym);
- WHILE sym = ORS.ident DO
- ORS.CopyId(impid); ORS.Get(sym);
- IF sym = ORS.becomes THEN
- ORS.Get(sym);
- IF sym = ORS.ident THEN ORS.CopyId(impid1); ORS.Get(sym)
- ELSE ORS.Mark("id expected")
- END
- ELSE impid1 := impid
- END ;
- ORB.Import(impid, impid1);
- IF sym = ORS.comma THEN ORS.Get(sym)
- ELSIF sym = ORS.ident THEN ORS.Mark("comma missing")
- END
- END ;
- Check(ORS.semicolon, "no ;")
- END ;
- obj := ORB.topScope.next;
- ORG.Open(version); Declarations(dc); ORG.SetDataSize((dc + 3) DIV 4 * 4);
- WHILE sym = ORS.procedure DO ProcedureDecl; Check(ORS.semicolon, "no ;") END ;
- ORG.Header;
- IF sym = ORS.begin THEN ORS.Get(sym); StatSequence END ;
- Check(ORS.end, "no END");
- IF sym = ORS.ident THEN
- IF ORS.id # modid THEN ORS.Mark("no match") END ;
- ORS.Get(sym)
- ELSE ORS.Mark("identifier missing")
- END ;
- IF sym # ORS.period THEN ORS.Mark("period missing") END ;
- IF (ORS.errcnt = 0) & (version # 0) THEN
- ORB.Export(modid, newSF, key);
- IF newSF THEN Texts.WriteString(W, " new symbol file") END
- END ;
- IF ORS.errcnt = 0 THEN
- ORG.Close(modid, key, exno);
- Texts.WriteInt(W, ORG.pc, 6); Texts.WriteInt(W, dc, 6); Texts.WriteHex(W, key)
- ELSE Texts.WriteLn(W); Texts.WriteString(W, "compilation FAILED")
- END ;
- Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
- Oberon.DumpLog; (* voc adaptation; -- noch *)
- ORB.CloseScope; pbsList := NIL
- ELSE ORS.Mark("must start with MODULE")
- END
- END Module;
-
- PROCEDURE Option(VAR S: Texts.Scanner);
- BEGIN newSF := FALSE;
- IF S.nextCh = "/" THEN
- Texts.Scan(S); Texts.Scan(S);
- IF (S.class = Texts.Name) & (S.s[0] = "s") THEN newSF := TRUE END
- END
- END Option;
-
- PROCEDURE Compile*;
- VAR beg, end, time: LONGINT;
- T: Texts.Text;
- S: Texts.Scanner;
- BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
- IF S.class = Texts.Char THEN
- IF S.c = "@" THEN
- Option(S); Oberon.GetSelection(T, beg, end, time);
- IF time >= 0 THEN ORS.Init(T, beg); Module END
- ELSIF S.c = "^" THEN
- Option(S); Oberon.GetSelection(T, beg, end, time);
- IF time >= 0 THEN
- Texts.OpenScanner(S, T, beg); Texts.Scan(S);
- IF S.class = Texts.Name THEN
- Texts.WriteString(W, S.s); NEW(T); Texts.Open(T, S.s);
- IF T.len > 0 THEN ORS.Init(T, 0); Module END
- END
- END
- END
- ELSE
- WHILE S.class = Texts.Name DO
- NEW(T); Texts.Open(T, S.s);
- IF T.len > 0 THEN Option(S); ORS.Init(T, 0); Module
- ELSE Texts.WriteString(W, S.s); Texts.WriteString(W, " not found");
- Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
- Oberon.DumpLog; (* voc adaptation; -- noch *)
- END ;
- IF (T.len # 0) & (ORS.errcnt = 0) THEN Texts.Scan(S) ELSE S.class := 0 END
- END
- END ;
- Oberon.Collect(0)
- END Compile;
-
-BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "OR Compiler 7.6.2014");
- Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
- Oberon.DumpLog; (* voc adaptation; -- noch *)
- NEW(dummy); dummy.class := ORB.Var; dummy.type := ORB.intType;
- expression := expression0; Type := Type0; FormalType := FormalType0;
-
- Compile (* voc adaptation; -- noch *)
-END ORP.
diff --git a/src/voc07R/ORS.Mod b/src/voc07R/ORS.Mod
deleted file mode 100644
index 1d005e38..00000000
--- a/src/voc07R/ORS.Mod
+++ /dev/null
@@ -1,325 +0,0 @@
-MODULE ORS; (* NW 19.9.93 / 1.4.2014 Scanner in Oberon-07*)
- IMPORT SYSTEM, Texts := CompatTexts, Oberon; (* CompatTexts is voc adaptation by noch *)
-
- TYPE INTEGER = LONGINT; (* voc adaptation by noch *)
-
-(* Oberon Scanner does lexical analysis. Input is Oberon-Text, output is
- sequence of symbols, i.e identifiers, numbers, strings, and special symbols.
- Recognises all Oberon keywords and skips comments. The keywords are
- recorded in a table.
- Get(sym) delivers next symbol from input text with Reader R.
- Mark(msg) records error and delivers error message with Writer W.
- If Get delivers ident, then the identifier (a string) is in variable id, if int or char
- in ival, if real in rval, and if string in str (and slen) *)
-
- CONST IdLen* = 32;
- NKW = 34; (*nof keywords*)
- maxExp = 38; stringBufSize = 256;
-
- (*lexical symbols*)
- null = 0; times* = 1; rdiv* = 2; div* = 3; mod* = 4;
- and* = 5; plus* = 6; minus* = 7; or* = 8; eql* = 9;
- neq* = 10; lss* = 11; leq* = 12; gtr* = 13; geq* = 14;
- in* = 15; is* = 16; arrow* = 17; period* = 18;
- char* = 20; int* = 21; real* = 22; false* = 23; true* = 24;
- nil* = 25; string* = 26; not* = 27; lparen* = 28; lbrak* = 29;
- lbrace* = 30; ident* = 31;
- if* = 32; while* = 34; repeat* = 35; case* = 36; for* = 37;
- comma* = 40; colon* = 41; becomes* = 42; upto* = 43; rparen* = 44;
- rbrak* = 45; rbrace* = 46; then* = 47; of* = 48; do* = 49;
- to* = 50; by* = 51; semicolon* = 52; end* = 53; bar* = 54;
- else* = 55; elsif* = 56; until* = 57; return* = 58;
- array* = 60; record* = 61; pointer* = 62; const* = 63; type* = 64;
- var* = 65; procedure* = 66; begin* = 67; import* = 68; module* = 69;
-
- TYPE Ident* = ARRAY IdLen OF CHAR;
-
- VAR ival*, slen*: LONGINT; (*results of Get*)
- rval*: REAL;
- id*: Ident; (*for identifiers*)
- str*: ARRAY stringBufSize OF CHAR;
- errcnt*: INTEGER;
-
- ch: CHAR; (*last character read*)
- errpos: LONGINT;
- R: Texts.Reader;
- W: Texts.Writer;
- k: INTEGER;
- KWX: ARRAY 10 OF INTEGER;
- keyTab: ARRAY NKW OF
- RECORD sym: INTEGER; id: ARRAY 12 OF CHAR END;
-
- PROCEDURE CopyId*(VAR ident: Ident);
- BEGIN ident := id
- END CopyId;
-
- PROCEDURE Pos*(): LONGINT;
- BEGIN RETURN Texts.Pos(R) - 1
- END Pos;
-
- PROCEDURE Mark*(msg: ARRAY OF CHAR);
- VAR p: LONGINT;
- BEGIN p := Pos();
- IF (p > errpos) & (errcnt < 25) THEN
- Texts.WriteLn(W); Texts.WriteString(W, " pos "); Texts.WriteInt(W, p, 1); Texts.Write(W, " ");
- Texts.WriteString(W, msg); Texts.Append(Oberon.Log, W.buf);
- Oberon.DumpLog; (* voc adaptation by noch *)
- END ;
- INC(errcnt); errpos := p + 4
- END Mark;
-
- PROCEDURE Identifier(VAR sym: INTEGER);
- VAR i, k: INTEGER;
- BEGIN i := 0;
- REPEAT
- IF i < IdLen-1 THEN id[i] := ch; INC(i) END ;
- Texts.Read(R, ch)
- UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "Z") & (ch < "a") OR (ch > "z");
- id[i] := 0X;
- IF i < 10 THEN k := KWX[i-1]; (*search for keyword*)
- WHILE (id # keyTab[k].id) & (k < KWX[i]) DO INC(k) END ;
- IF k < KWX[i] THEN sym := keyTab[k].sym ELSE sym := ident END
- ELSE sym := ident
- END
- END Identifier;
-
- PROCEDURE String;
- VAR i: INTEGER;
- BEGIN i := 0; Texts.Read(R, ch);
- WHILE ~R.eot & (ch # 22X) DO
- IF ch >= " " THEN
- IF i < stringBufSize-1 THEN str[i] := ch; INC(i) ELSE Mark("string too long") END ;
- END ;
- Texts.Read(R, ch)
- END ;
- str[i] := 0X; INC(i); Texts.Read(R, ch); slen := i
- END String;
-
- PROCEDURE HexString;
- VAR i, m, n: INTEGER;
- BEGIN i := 0; Texts.Read(R, ch);
- WHILE ~R.eot & (ch # "$") DO
- WHILE (ch = " ") OR (ch = 9X) OR (ch = 0DX) DO Texts.Read(R, ch) END ; (*skip*)
- IF ("0" <= ch) & (ch <= "9") THEN m := ORD(ch) - 30H
- ELSIF ("A" <= ch) & (ch <= "F") THEN m := ORD(ch) - 37H
- ELSE m := 0; Mark("hexdig expected")
- END ;
- Texts.Read(R, ch);
- IF ("0" <= ch) & (ch <= "9") THEN n := ORD(ch) - 30H
- ELSIF ("A" <= ch) & (ch <= "F") THEN n := ORD(ch) - 37H
- ELSE n := 0; Mark("hexdig expected")
- END ;
- IF i < stringBufSize THEN str[i] := CHR(m*10H + n); INC(i) ELSE Mark("string too long") END ;
- Texts.Read(R, ch)
- END ;
- Texts.Read(R, ch); slen := i (*no 0X appended!*)
- END HexString;
-
- PROCEDURE Ten(e: LONGINT): REAL;
- VAR x, t: REAL;
- BEGIN x := 1.0; t := 10.0;
- WHILE e > 0 DO
- IF ODD(e) THEN x := t * x END ;
- t := t * t; e := e DIV 2
- END ;
- RETURN x
- END Ten;
-
- PROCEDURE Number(VAR sym: INTEGER);
- CONST max = 2147483647 (*2^31 - 1*);
- VAR i, k, e, n, s, h: LONGINT; x: REAL;
- d: ARRAY 16 OF INTEGER;
- negE: BOOLEAN;
- BEGIN ival := 0; i := 0; n := 0; k := 0;
- REPEAT
- IF n < 16 THEN d[n] := ORD(ch)-30H; INC(n) ELSE Mark("too many digits"); n := 0 END ;
- Texts.Read(R, ch)
- UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "F");
- IF (ch = "H") OR (ch = "R") OR (ch = "X") THEN (*hex*)
- REPEAT h := d[i];
- IF h >= 10 THEN h := h-7 END ;
- k := k*10H + h; INC(i) (*no overflow check*)
- UNTIL i = n;
- IF ch = "X" THEN sym := char;
- IF k < 100H THEN ival := k ELSE Mark("illegal value"); ival := 0 END
- ELSIF ch = "R" THEN sym := real; rval := SYSTEM.VAL(REAL, k)
- ELSE sym := int; ival := k
- END ;
- Texts.Read(R, ch)
- ELSIF ch = "." THEN
- Texts.Read(R, ch);
- IF ch = "." THEN (*double dot*) ch := 7FX; (*decimal integer*)
- REPEAT
- IF d[i] < 10 THEN
- IF k <= (max-d[i]) DIV 10 THEN k := k *10 + d[i] ELSE Mark("too large"); k := 0 END
- ELSE Mark("bad integer")
- END ;
- INC(i)
- UNTIL i = n;
- sym := int; ival := k
- ELSE (*real number*) x := 0.0; e := 0;
- REPEAT (*integer part*)
- (*x := x * 10.0 + FLT(d[i]); *)
- x := x * 10.0 + (d[i]); (* voc adaptation by noch *)
- INC(i)
- UNTIL i = n;
- WHILE (ch >= "0") & (ch <= "9") DO (*fraction*)
- (*x := x * 10.0 + FLT(ORD(ch) - 30H);*)
- x := x * 10.0 + (ORD(ch) - 30H); (* voc adaptation by noch *)
- DEC(e);
- Texts.Read(R, ch)
- END ;
- IF (ch = "E") OR (ch = "D") THEN (*scale factor*)
- Texts.Read(R, ch); s := 0;
- IF ch = "-" THEN negE := TRUE; Texts.Read(R, ch)
- ELSE negE := FALSE;
- IF ch = "+" THEN Texts.Read(R, ch) END
- END ;
- IF (ch >= "0") & (ch <= "9") THEN
- REPEAT s := s*10 + ORD(ch)-30H; Texts.Read(R, ch)
- UNTIL (ch < "0") OR (ch >"9");
- IF negE THEN e := e-s ELSE e := e+s END
- ELSE Mark("digit?")
- END
- END ;
- IF e < 0 THEN
- IF e >= -maxExp THEN x := x / Ten(-e) ELSE x := 0.0 END
- ELSIF e > 0 THEN
- IF e <= maxExp THEN x := Ten(e) * x ELSE x := 0.0; Mark("too large") END
- END ;
- sym := real; rval := x
- END
- ELSE (*decimal integer*)
- REPEAT
- IF d[i] < 10 THEN
- IF k <= (max-d[i]) DIV 10 THEN k := k*10 + d[i] ELSE Mark("too large"); k := 0 END
- ELSE Mark("bad integer")
- END ;
- INC(i)
- UNTIL i = n;
- sym := int; ival := k
- END
- END Number;
-
- PROCEDURE comment;
- BEGIN Texts.Read(R, ch);
- REPEAT
- WHILE ~R.eot & (ch # "*") DO
- IF ch = "(" THEN Texts.Read(R, ch);
- IF ch = "*" THEN comment END
- ELSE Texts.Read(R, ch)
- END
- END ;
- WHILE ch = "*" DO Texts.Read(R, ch) END
- UNTIL (ch = ")") OR R.eot;
- IF ~R.eot THEN Texts.Read(R, ch) ELSE Mark("unterminated comment") END
- END comment;
-
- PROCEDURE Get*(VAR sym: INTEGER);
- BEGIN
- REPEAT
- WHILE ~R.eot & (ch <= " ") DO Texts.Read(R, ch) END;
- IF ch < "A" THEN
- IF ch < "0" THEN
- IF ch = 22X THEN String; sym := string
- ELSIF ch = "#" THEN Texts.Read(R, ch); sym := neq
- ELSIF ch = "$" THEN HexString; sym := string
- ELSIF ch = "&" THEN Texts.Read(R, ch); sym := and
- ELSIF ch = "(" THEN Texts.Read(R, ch);
- IF ch = "*" THEN sym := null; comment ELSE sym := lparen END
- ELSIF ch = ")" THEN Texts.Read(R, ch); sym := rparen
- ELSIF ch = "*" THEN Texts.Read(R, ch); sym := times
- ELSIF ch = "+" THEN Texts.Read(R, ch); sym := plus
- ELSIF ch = "," THEN Texts.Read(R, ch); sym := comma
- ELSIF ch = "-" THEN Texts.Read(R, ch); sym := minus
- ELSIF ch = "." THEN Texts.Read(R, ch);
- IF ch = "." THEN Texts.Read(R, ch); sym := upto ELSE sym := period END
- ELSIF ch = "/" THEN Texts.Read(R, ch); sym := rdiv
- ELSE Texts.Read(R, ch); (* ! % ' *) sym := null
- END
- ELSIF ch < ":" THEN Number(sym)
- ELSIF ch = ":" THEN Texts.Read(R, ch);
- IF ch = "=" THEN Texts.Read(R, ch); sym := becomes ELSE sym := colon END
- ELSIF ch = ";" THEN Texts.Read(R, ch); sym := semicolon
- ELSIF ch = "<" THEN Texts.Read(R, ch);
- IF ch = "=" THEN Texts.Read(R, ch); sym := leq ELSE sym := lss END
- ELSIF ch = "=" THEN Texts.Read(R, ch); sym := eql
- ELSIF ch = ">" THEN Texts.Read(R, ch);
- IF ch = "=" THEN Texts.Read(R, ch); sym := geq ELSE sym := gtr END
- ELSE (* ? @ *) Texts.Read(R, ch); sym := null
- END
- ELSIF ch < "[" THEN Identifier(sym)
- ELSIF ch < "a" THEN
- IF ch = "[" THEN sym := lbrak
- ELSIF ch = "]" THEN sym := rbrak
- ELSIF ch = "^" THEN sym := arrow
- ELSE (* _ ` *) sym := null
- END ;
- Texts.Read(R, ch)
- ELSIF ch < "{" THEN Identifier(sym) ELSE
- IF ch = "{" THEN sym := lbrace
- ELSIF ch = "}" THEN sym := rbrace
- ELSIF ch = "|" THEN sym := bar
- ELSIF ch = "~" THEN sym := not
- ELSIF ch = 7FX THEN sym := upto
- ELSE sym := null
- END ;
- Texts.Read(R, ch)
- END
- UNTIL sym # null
- END Get;
-
- PROCEDURE Init*(T: Texts.Text; pos: LONGINT);
- BEGIN errpos := pos; errcnt := 0; Texts.OpenReader(R, T, pos); Texts.Read(R, ch)
- END Init;
-
- PROCEDURE EnterKW(sym: INTEGER; name: ARRAY OF CHAR);
- BEGIN
- (*keyTab[k].id := name; *)
- COPY(name, keyTab[k].id); (* voc adaptation by noch *)
- keyTab[k].sym := sym;
- INC(k)
- END EnterKW;
-
-BEGIN Texts.OpenWriter(W); k := 0; KWX[0] := 0; KWX[1] := 0;
- EnterKW(if, "IF");
- EnterKW(do, "DO");
- EnterKW(of, "OF");
- EnterKW(or, "OR");
- EnterKW(to, "TO");
- EnterKW(in, "IN");
- EnterKW(is, "IS");
- EnterKW(by, "BY");
- KWX[2] := k;
- EnterKW(end, "END");
- EnterKW(nil, "NIL");
- EnterKW(var, "VAR");
- EnterKW(div, "DIV");
- EnterKW(mod, "MOD");
- EnterKW(for, "FOR");
- KWX[3] := k;
- EnterKW(else, "ELSE");
- EnterKW(then, "THEN");
- EnterKW(true, "TRUE");
- EnterKW(type, "TYPE");
- EnterKW(case, "CASE");
- KWX[4] := k;
- EnterKW(elsif, "ELSIF");
- EnterKW(false, "FALSE");
- EnterKW(array, "ARRAY");
- EnterKW(begin, "BEGIN");
- EnterKW(const, "CONST");
- EnterKW(until, "UNTIL");
- EnterKW(while, "WHILE");
- KWX[5] := k;
- EnterKW(record, "RECORD");
- EnterKW(repeat, "REPEAT");
- EnterKW(return, "RETURN");
- EnterKW(import, "IMPORT");
- EnterKW(module, "MODULE");
- KWX[6] := k;
- EnterKW(pointer, "POINTER");
- KWX[7] := k; KWX[8] := k;
- EnterKW(procedure, "PROCEDURE");
- KWX[9] := k
-END ORS.
diff --git a/src/voc07R/ORTool.Mod b/src/voc07R/ORTool.Mod
deleted file mode 100644
index e0a08d42..00000000
--- a/src/voc07R/ORTool.Mod
+++ /dev/null
@@ -1,251 +0,0 @@
-MODULE ORTool; (*NW 18.2.2013*)
- IMPORT SYSTEM, Files, Texts, Oberon, ORB;
- VAR W: Texts.Writer;
- Form: INTEGER; (*result of ReadType*)
- mnemo0, mnemo1: ARRAY 16, 4 OF CHAR; (*mnemonics*)
-
- PROCEDURE Read(VAR R: Files.Rider; VAR n: INTEGER);
- VAR b: BYTE;
- BEGIN Files.ReadByte(R, b);
- IF b < 80H THEN n := b ELSE n := b - 100H END
- END Read;
-
- PROCEDURE ReadType(VAR R: Files.Rider);
- VAR key, len, lev, size, off: INTEGER;
- ref, mno, class, form, readonly: INTEGER;
- name, modname: ARRAY 32 OF CHAR;
- BEGIN Read(R, ref); Texts.Write(W, " "); Texts.Write(W, "[");
- IF ref < 0 THEN Texts.Write(W, "^"); Texts.WriteInt(W, -ref, 1)
- ELSE Texts.WriteInt(W, ref, 1);
- Read(R, form); Texts.WriteString(W, " form = "); Texts.WriteInt(W, form, 1);
- IF form = ORB.Pointer THEN ReadType(R)
- ELSIF form = ORB.Array THEN
- ReadType(R); Files.ReadNum(R, len); Files.ReadNum(R, size);
- Texts.WriteString(W, " len = "); Texts.WriteInt(W, len, 1);
- Texts.WriteString(W, " size = "); Texts.WriteInt(W, size, 1)
- ELSIF form = ORB.Record THEN
- ReadType(R); (*base type*)
- Files.ReadNum(R, off); Texts.WriteString(W, " exno = "); Texts.WriteInt(W, off, 1);
- Files.ReadNum(R, off); Texts.WriteString(W, " extlev = "); Texts.WriteInt(W, off, 1);
- Files.ReadNum(R, size); Texts.WriteString(W, " size = "); Texts.WriteInt(W, size, 1);
- Texts.Write(W, " "); Texts.Write(W, "{"); Read(R, class);
- WHILE class # 0 DO (*fields*)
- Files.ReadString(R, name);
- IF name[0] # 0X THEN Texts.Write(W, " "); Texts.WriteString(W, name); ReadType(R)
- ELSE Texts.WriteString(W, " --")
- END ;
- Files.ReadNum(R, off); Texts.WriteInt(W, off, 4); Read(R, class)
- END ;
- Texts.Write(W, "}")
- ELSIF form = ORB.Proc THEN
- ReadType(R); Texts.Write(W, "("); Read(R, class);
- WHILE class # 0 DO
- Texts.WriteString(W, " class = "); Texts.WriteInt(W, class, 1); Read(R, readonly);
- IF readonly = 1 THEN Texts.Write(W, "#") END ;
- ReadType(R); Read(R, class)
- END ;
- Texts.Write(W, ")")
- END ;
- Files.ReadString(R, modname);
- IF modname[0] # 0X THEN
- Files.ReadInt(R, key); Files.ReadString(R, name);
- Texts.Write(W, " "); Texts.WriteString(W, modname); Texts.Write(W, "."); Texts.WriteString(W, name);
- Texts.WriteHex(W, key)
- END
- END ;
- Form := form; Texts.Write(W, "]")
- END ReadType;
-
- PROCEDURE DecSym*; (*decode symbol file*)
- VAR class, typno, k: INTEGER;
- name: ARRAY 32 OF CHAR;
- F: Files.File; R: Files.Rider;
- S: Texts.Scanner;
- BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
- IF S.class = Texts.Name THEN
- Texts.WriteString(W, "OR-decode "); Texts.WriteString(W, S.s);
- Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
- F := Files.Old(S.s);
- IF F # NIL THEN
- Files.Set(R, F, 0); Files.ReadInt(R, k); Files.ReadInt(R, k);
- Files.ReadString(R, name); Texts.WriteString(W, name); Texts.WriteHex(W, k);
- Read(R, class); Texts.WriteInt(W, class, 3); (*sym file version*)
- IF class = ORB.versionkey THEN
- Texts.WriteLn(W); Read(R, class);
- WHILE class # 0 DO
- Texts.WriteInt(W, class, 4); Files.ReadString(R, name); Texts.Write(W, " "); Texts.WriteString(W, name);
- ReadType(R);
- IF class = ORB.Typ THEN
- Texts.Write(W, "("); Read(R, class);
- WHILE class # 0 DO (*pointer base fixup*)
- Texts.WriteString(W, " ->"); Texts.WriteInt(W, class, 4); Read(R, class)
- END ;
- Texts.Write(W, ")")
- ELSIF (class = ORB.Const) OR (class = ORB.Var) THEN
- Files.ReadNum(R, k); Texts.WriteInt(W, k, 5); (*Reals, Strings!*)
- END ;
- Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
- Read(R, class)
- END
- ELSE Texts.WriteString(W, " bad symfile version")
- END
- ELSE Texts.WriteString(W, " not found")
- END ;
- Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
- END
- END DecSym;
-
-(* ---------------------------------------------------*)
-
- PROCEDURE WriteReg(r: LONGINT);
- BEGIN Texts.Write(W, " ");
- IF r < 12 THEN Texts.WriteString(W, " R"); Texts.WriteInt(W, r MOD 10H, 1)
- ELSIF r = 12 THEN Texts.WriteString(W, "MT")
- ELSIF r = 13 THEN Texts.WriteString(W, "SB")
- ELSIF r = 14 THEN Texts.WriteString(W, "SP")
- ELSE Texts.WriteString(W, "LNK")
- END
- END WriteReg;
-
- PROCEDURE opcode(w: LONGINT);
- VAR k, op, u, a, b, c: LONGINT;
- BEGIN
- k := w DIV 40000000H MOD 4;
- a := w DIV 1000000H MOD 10H;
- b := w DIV 100000H MOD 10H;
- op := w DIV 10000H MOD 10H;
- u := w DIV 20000000H MOD 2;
- IF k = 0 THEN
- Texts.WriteString(W, mnemo0[op]);
- IF u = 1 THEN Texts.Write(W, "'") END ;
- WriteReg(a); WriteReg(b); WriteReg(w MOD 10H)
- ELSIF k = 1 THEN
- Texts.WriteString(W, mnemo0[op]);
- IF u = 1 THEN Texts.Write(W, "'") END ;
- WriteReg(a); WriteReg(b); w := w MOD 10000H;
- IF w >= 8000H THEN w := w - 10000H END ;
- Texts.WriteInt(W, w, 7)
- ELSIF k = 2 THEN (*LDR/STR*)
- IF u = 1 THEN Texts.WriteString(W, "STR ") ELSE Texts.WriteString(W, "LDR") END ;
- WriteReg(a); WriteReg(b); w := w MOD 100000H;
- IF w >= 80000H THEN w := w - 100000H END ;
- Texts.WriteInt(W, w, 8)
- ELSIF k = 3 THEN (*Branch instr*)
- Texts.Write(W, "B");
- IF ODD(w DIV 10000000H) THEN Texts.Write(W, "L") END ;
- Texts.WriteString(W, mnemo1[a]);
- IF u = 0 THEN WriteReg(w MOD 10H) ELSE
- w := w MOD 100000H;
- IF w >= 80000H THEN w := w - 100000H END ;
- Texts.WriteInt(W, w, 8)
- END
- END
- END opcode;
-
- PROCEDURE Sync(VAR R: Files.Rider);
- VAR ch: CHAR;
- BEGIN Files.Read(R, ch); Texts.WriteString(W, "Sync "); Texts.Write(W, ch); Texts.WriteLn(W)
- END Sync;
-
- PROCEDURE Write(VAR R: Files.Rider; x: INTEGER);
- BEGIN Files.WriteByte(R, x) (* -128 <= x < 128 *)
- END Write;
-
- PROCEDURE DecObj*; (*decode object file*)
- VAR class, i, n, key, size, fix, adr, data, len: INTEGER;
- ch: CHAR;
- name: ARRAY 32 OF CHAR;
- F: Files.File; R: Files.Rider;
- S: Texts.Scanner;
- BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
- IF S.class = Texts.Name THEN
- Texts.WriteString(W, "decode "); Texts.WriteString(W, S.s); F := Files.Old(S.s);
- IF F # NIL THEN
- Files.Set(R, F, 0); Files.ReadString(R, name); Texts.WriteLn(W); Texts.WriteString(W, name);
- Files.ReadInt(R, key); Texts.WriteHex(W, key); Read(R, class); Texts.WriteInt(W, class, 4); (*version*)
- Files.ReadInt(R, size); Texts.WriteInt(W, size, 6); Texts.WriteLn(W);
- Texts.WriteString(W, "imports:"); Texts.WriteLn(W); Files.ReadString(R, name);
- WHILE name[0] # 0X DO
- Texts.Write(W, 9X); Texts.WriteString(W, name);
- Files.ReadInt(R, key); Texts.WriteHex(W, key); Texts.WriteLn(W);
- Files.ReadString(R, name)
- END ;
- (* Sync(R); *)
- Texts.WriteString(W, "type descriptors"); Texts.WriteLn(W);
- Files.ReadInt(R, n); n := n DIV 4; i := 0;
- WHILE i < n DO Files.ReadInt(R, data); Texts.WriteHex(W, data); INC(i) END ;
- Texts.WriteLn(W);
- Texts.WriteString(W, "data"); Files.ReadInt(R, data); Texts.WriteInt(W, data, 6); Texts.WriteLn(W);
- Texts.WriteString(W, "strings"); Texts.WriteLn(W);
- Files.ReadInt(R, n); i := 0;
- WHILE i < n DO Files.Read(R, ch); Texts.Write(W, ch); INC(i) END ;
- Texts.WriteLn(W);
- Texts.WriteString(W, "code"); Texts.WriteLn(W);
- Files.ReadInt(R, n); i := 0;
- WHILE i < n DO
- Files.ReadInt(R, data); Texts.WriteInt(W, i, 4); Texts.Write(W, 9X); Texts.WriteHex(W, data);
- Texts.Write(W, 9X); opcode(data); Texts.WriteLn(W); INC(i)
- END ;
- (* Sync(R); *)
- Texts.WriteString(W, "commands:"); Texts.WriteLn(W);
- Files.ReadString(R, name);
- WHILE name[0] # 0X DO
- Texts.Write(W, 9X); Texts.WriteString(W, name);
- Files.ReadInt(R, adr); Texts.WriteInt(W, adr, 5); Texts.WriteLn(W);
- Files.ReadString(R, name)
- END ;
- (* Sync(R); *)
- Texts.WriteString(W, "entries"); Texts.WriteLn(W);
- Files.ReadInt(R, n); i := 0;
- WHILE i < n DO
- Files.ReadInt(R, adr); Texts.WriteInt(W, adr, 6); INC(i)
- END ;
- Texts.WriteLn(W);
- (* Sync(R); *)
- Texts.WriteString(W, "pointer refs"); Texts.WriteLn(W); Files.ReadInt(R, adr);
- WHILE adr # -1 DO Texts.WriteInt(W, adr, 6); Files.ReadInt(R, adr) END ;
- Texts.WriteLn(W);
- (* Sync(R); *)
- Files.ReadInt(R, data); Texts.WriteString(W, "fixP = "); Texts.WriteInt(W, data, 8); Texts.WriteLn(W);
- Files.ReadInt(R, data); Texts.WriteString(W, "fixD = "); Texts.WriteInt(W, data, 8); Texts.WriteLn(W);
- Files.ReadInt(R, data); Texts.WriteString(W, "fixT = "); Texts.WriteInt(W, data, 8); Texts.WriteLn(W);
- Files.ReadInt(R, data); Texts.WriteString(W, "entry = "); Texts.WriteInt(W, data, 8); Texts.WriteLn(W);
- Files.Read(R, ch);
- IF ch # "O" THEN Texts.WriteString(W, "format eror"); Texts.WriteLn(W) END
- (* Sync(R); *)
- ELSE Texts.WriteString(W, " not found"); Texts.WriteLn(W)
- END ;
- Texts.Append(Oberon.Log, W.buf)
- END
- END DecObj;
-
-BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "ORTool 18.2.2013");
- Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
- mnemo0[0] := "MOV";
- mnemo0[1] := "LSL";
- mnemo0[2] := "ASR";
- mnemo0[3] := "ROR";
- mnemo0[4] := "AND";
- mnemo0[5] := "ANN";
- mnemo0[6] := "IOR";
- mnemo0[7] := "XOR";
- mnemo0[8] := "ADD";
- mnemo0[9] := "SUB";
- mnemo0[10] := "MUL";
- mnemo0[11] := "DIV";
- mnemo0[12] := "FAD";
- mnemo0[13] := "FSB";
- mnemo0[14] := "FML";
- mnemo0[15] := "FDV";
- mnemo1[0] := "MI ";
- mnemo1[8] := "PL";
- mnemo1[1] := "EQ ";
- mnemo1[9] := "NE ";
- mnemo1[2] := "LS ";
- mnemo1[10] := "HI ";
- mnemo1[5] := "LT ";
- mnemo1[13] := "GE ";
- mnemo1[6] := "LE ";
- mnemo1[14] := "GT ";
- mnemo1[15] := "NO ";
-END ORTool.
diff --git a/src/voc07R/Oberon.Mod b/src/voc07R/Oberon.Mod
deleted file mode 100644
index b2da7dee..00000000
--- a/src/voc07R/Oberon.Mod
+++ /dev/null
@@ -1,111 +0,0 @@
-MODULE Oberon;
-
-(* this module emulates Oberon.Log and Oberon.Par in order to pass agruments to Oberon programs, as it's in Oberon environment;
- it creates Oberon.Par from command line arguments;
- procedure Dump dumps Oberon.Log to standard output.
-
- -- noch *)
-
-(* Files are commented out, because it's not necessary for work, but can be very useful for debug. See WriteTextToFile procedure; -- noch *)
-IMPORT Args, Strings, Texts := CompatTexts, (*Files := CompatFiles,*) Out := Console;
-
-VAR Log*: Texts.Text;
-
- Par*: RECORD
- text*: Texts.Text;
- pos* : LONGINT;
- END;
-
-arguments : ARRAY 2048 OF CHAR;
-
-PROCEDURE GetSelection* (VAR text: Texts.Text; VAR beg, end, time: LONGINT);
- (*VAR M: SelectionMsg;*)
- BEGIN
- (*M.time := -1; Viewers.Broadcast(M); time := M.time;
- IF time >= 0 THEN text := M.text; beg := M.beg; end := M.end END*)
- END GetSelection;
-
-PROCEDURE Collect*( count : LONGINT);
-BEGIN
-
-END Collect;
-
-PROCEDURE ArgsToString(VAR opts : ARRAY OF CHAR);
-VAR i : INTEGER;
- opt : ARRAY 256 OF CHAR;
-BEGIN
-
- i := 1;
- opt := ""; COPY ("", opts);
-
- WHILE i < Args.argc DO
- Args.Get(i, opt);
- Strings.Append(opt, opts);(* Strings.Append (" ", opts);*)
- (* ORP calls Texts.Scan, which returns filename, and nextCh would be set to " " if we append here " ". However after that ORP will check nextCh, and if it finds that nextCh is not "/" it's not gonna parse options. That's why Strings.Append is commented out; -- noch *)
- INC(i)
- END;
-
-END ArgsToString;
-
-PROCEDURE StringToText(VAR arguments : ARRAY OF CHAR; VAR T : Texts.Text);
-VAR
- W : Texts.Writer;
-BEGIN
- Texts.OpenWriter(W);
- Texts.WriteString(W, arguments);
- Texts.Append (T, W.buf);
-END StringToText;
-(*
-PROCEDURE WriteTextToFile(VAR T : Texts.Text; filename : ARRAY OF CHAR);
- VAR f : Files.File; r : Files.Rider;
-BEGIN
- f := Files.New(filename);
- Files.Set(r, f, 0);
- Texts.Store(r, T);
- Files.Register(f);
-END WriteTextToFile;
-*)
-PROCEDURE TextToString(VAR T : Texts.Text; VAR string : ARRAY OF CHAR);
- VAR R : Texts.Reader;
- ch : CHAR;
- i : LONGINT;
-BEGIN
- COPY("", string);
- Texts.OpenReader(R, T, 0);
- i := 0;
- WHILE Texts.Pos(R) < T.len DO
- Texts.Read(R, ch);
- string[i] := ch;
- INC(i);
- END;
- (*string[i] := 0X;*)
-END TextToString;
-
-PROCEDURE DumpLog*;
-VAR s : POINTER TO ARRAY OF CHAR;
-BEGIN
- NEW(s, Log.len + 1);
- COPY("", s^);
- TextToString(Log, s^);
- Out.String(s^); Out.Ln;
-
- NEW(Log);
- Texts.Open(Log, "");
-END DumpLog;
-
-
-BEGIN
- NEW(Log);
- Texts.Open(Log, "");
-
- NEW(Par.text);
- Texts.Open(Par.text, "");
- Par.pos := 0;
-
- COPY("", arguments);
- ArgsToString(arguments);
- StringToText(arguments, Par.text);
- (*WriteTextToFile(Par.text, "params.txt");*)
- (*WriteTextToFile(Log, "log.txt");*)
- (*DumpLog;*)
-END Oberon.
diff --git a/src/voc07R/Oberon10.Scn.Fnt b/src/voc07R/Oberon10.Scn.Fnt
deleted file mode 100644
index 15f99921..00000000
Binary files a/src/voc07R/Oberon10.Scn.Fnt and /dev/null differ
diff --git a/src/voc07R/README.md b/src/voc07R/README.md
deleted file mode 100644
index 6b4cf474..00000000
--- a/src/voc07R/README.md
+++ /dev/null
@@ -1,29 +0,0 @@
-
-RISC crosscompiler
-==================
-
-This is a version of re re revised Oberon compiler for Wirth's RISC machine which can be compiled and run with VOC (Vishap Oberon Compiler) on supported platforms.
-
-Files generated can be transferred to RISC machine or emulator and be run there.
-
-Compile
-=======
-
-If you have vishap oberon compiler installed, just type
->make
-
-Run
-===
-
->./ORP test.Mod /s
-
-like that.
-
-you may need symbol (.smb) files from RISC Oberon system in order to write programs that import some modules.
-
-some answers
-============
-
-- why Oberon10.Scn.Fnt ?
-- it's actually not really necessary. because Texts are patched (test for NIL) to not crash if this file does not exist. however, unless I remove dependency from Fonts.Mod I have decided to keep this file here, and thus my added test for NIL is not necessary, and generated output file is completely correct Oberon Text file. Otherwise it would not contain the font name, for instance.
-
diff --git a/src/voc07R/makefile b/src/voc07R/makefile
deleted file mode 100644
index 5343361c..00000000
--- a/src/voc07R/makefile
+++ /dev/null
@@ -1,22 +0,0 @@
-
-SETPATH = MODULES=".:x86_64"
-
-VOC0 = $(SETPATH) /opt/voc/bin/voc
-
-all:
- #$(VOC0) -s ORS.Mod
- #$(VOC0) -s ORB.Mod
- #$(VOC0) -s ORG.Mod
- $(VOC0) -s CompatFiles.Mod \
- Fonts.Mod CompatTexts.Mod Oberon.Mod \
- ORS.Mod ORB.Mod ORG.Mod ORP.Mod -M
-
-test:
- ./ORP -s test.Mod
-
-clean:
- rm *.sym
- rm *.o
- rm *.h
- rm *.c
-
diff --git a/src/voc07R/test/Oberon.rsc b/src/voc07R/test/Oberon.rsc
deleted file mode 100644
index d0e49fa8..00000000
Binary files a/src/voc07R/test/Oberon.rsc and /dev/null differ
diff --git a/src/voc07R/test/Oberon.smb b/src/voc07R/test/Oberon.smb
deleted file mode 100644
index 148bd414..00000000
Binary files a/src/voc07R/test/Oberon.smb and /dev/null differ
diff --git a/src/voc07R/test/Test.Mod b/src/voc07R/test/Test.Mod
deleted file mode 100644
index 34c85704..00000000
Binary files a/src/voc07R/test/Test.Mod and /dev/null differ
diff --git a/src/voc07R/test/Texts.rsc b/src/voc07R/test/Texts.rsc
deleted file mode 100644
index a1d32e38..00000000
Binary files a/src/voc07R/test/Texts.rsc and /dev/null differ
diff --git a/src/voc07R/test/Texts.smb b/src/voc07R/test/Texts.smb
deleted file mode 100644
index 9c97e0d9..00000000
Binary files a/src/voc07R/test/Texts.smb and /dev/null differ
diff --git a/src/voc07R/test/readme b/src/voc07R/test/readme
deleted file mode 100644
index 9108c517..00000000
--- a/src/voc07R/test/readme
+++ /dev/null
@@ -1,3 +0,0 @@
-put ORP binary here and run
-
-> ./ORP Test.Mod
diff --git a/src/voc07R/x86/CompatFiles.Mod b/src/voc07R/x86/CompatFiles.Mod
deleted file mode 100644
index d7a9c06e..00000000
--- a/src/voc07R/x86/CompatFiles.Mod
+++ /dev/null
@@ -1,677 +0,0 @@
-MODULE CompatFiles; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *)
-(* modified version of Files, which opens only the file provided and does not scan any path in any environment variable, also ReadLine procedure added; -- noch *)
- IMPORT SYSTEM, Unix, Kernel, Args, Console;
-
- (* 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
- nofbufs = 4;
- bufsize = 4096;
- fileTabSize = 64;
- noDesc = -1;
- notDone = -1;
-
- (* file states *)
- open = 0; create = 1; close = 2;
-
-
- TYPE
- FileName = ARRAY 101 OF CHAR;
- File* = POINTER TO Handle;
- Buffer = POINTER TO BufDesc;
-
- Handle = RECORD
- workName, registerName: FileName;
- tempFile: BOOLEAN;
- dev, ino, mtime: LONGINT;
- fd-, len, pos: LONGINT;
- bufs: ARRAY nofbufs OF Buffer;
- swapper, state: INTEGER
- END ;
-
- BufDesc = RECORD
- f: File;
- chg: BOOLEAN;
- org, size: LONGINT;
- data: ARRAY bufsize OF SYSTEM.BYTE
- END ;
-
- Rider* = RECORD
- res*: LONGINT;
- eof*: BOOLEAN;
- buf: Buffer;
- org, offset: LONGINT
- END ;
-
- Time = POINTER TO TimeDesc;
- TimeDesc = RECORD
- sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT;
-(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*)
- END ;
-
- VAR
- fileTab: ARRAY fileTabSize OF LONGINT (*=File*);
- tempno: INTEGER;
-
-(* for localtime *)
- PROCEDURE -includetime()
- '#include "time.h"';
-
- PROCEDURE -localtime(VAR clock: LONGINT): Time
- "(CompatFiles_Time) localtime(clock)";
-
- PROCEDURE -getcwd(VAR cwd: Unix.Name)
- "getcwd(cwd, cwd__len)";
-
- PROCEDURE -IdxTrap "__HALT(-1)";
-
- PROCEDURE^ Finalize(o: SYSTEM.PTR);
-
- PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT);
- BEGIN
- Console.Ln; Console.String("-- "); Console.String(s); Console.String(": ");
- IF f # NIL THEN
- IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END
- END ;
- IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ;
- Console.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
- END MakeFileName;
-
- PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR);
- VAR n, i, j: LONGINT;
- BEGIN
- INC(tempno); n := tempno; i := 0;
- IF finalName[0] # "/" THEN (* relative pathname *)
- WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END;
- IF Kernel.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;
- 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 := SHORT(Unix.Getpid());
- WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
- name[i] := 0X
- END GetTempName;
-
- PROCEDURE Create(f: File);
- VAR stat: Unix.Status; done: BOOLEAN;
- errno: LONGINT; err: ARRAY 32 OF CHAR;
- BEGIN
- IF f.fd = noDesc THEN
- IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE
- ELSIF f.state = close THEN
- f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
- END ;
- errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*)
- f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
- done := f.fd >= 0; errno := Unix.errno();
- IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN
- IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ;
- Kernel.GC(TRUE);
- f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
- done := f.fd >= 0
- END ;
- IF done THEN
- IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0)
- ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
- f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat);
- f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime
- END
- ELSE errno := Unix.errno();
- IF errno = Unix.ENOENT THEN err := "no such directory"
- ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open"
- ELSE err := "file not created"
- END ;
- Err(err, f, errno)
- END
- END
- END Create;
-
- PROCEDURE Flush(buf: Buffer);
- VAR res: LONGINT; f: File; stat: Unix.Status;
- BEGIN
- IF buf.chg THEN f := buf.f; Create(f);
- IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ;
- res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
- IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ;
- f.pos := buf.org + buf.size;
- buf.chg := FALSE;
- res := Unix.Fstat(f.fd, stat);
- f.mtime := stat.mtime
- END
- END Flush;
-
- PROCEDURE Close* (f: File);
- VAR i, res: LONGINT;
- BEGIN
- IF (f.state # create) OR (f.registerName # "") THEN
- Create(f); i := 0;
- WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ;
- res := Unix.Fsync(f.fd);
- IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END
- END
- END Close;
-
- PROCEDURE Length* (f: File): LONGINT;
- BEGIN RETURN f.len
- END Length;
-
- PROCEDURE New* (name: ARRAY OF CHAR): File;
- VAR f: File;
- BEGIN
- NEW(f); f.workName := ""; COPY(name, f.registerName);
- f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
- RETURN f
- END New;
-(*
- PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *)
- VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR;
- BEGIN
- i := 0; ch := Kernel.OBERON[pos];
- WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ;
- IF ch = "~" THEN
- INC(pos); ch := Kernel.OBERON[pos];
- home := ""; Args.GetEnv("HOME", home);
- WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ;
- IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN
- WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END
- END
- END ;
- WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ;
- WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ;
- dir[i] := 0X
- END ScanPath;
-*)
- PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN;
- VAR i: INTEGER; ch: CHAR;
- BEGIN i := 0; ch := name[0];
- WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ;
- RETURN ch = "/"
- END HasDir;
-
- PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File;
- VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT;
- BEGIN i := 0;
- WHILE i < fileTabSize DO
- f := SYSTEM.VAL(File, fileTab[i]);
- IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN
- IF mtime # f.mtime THEN i := 0;
- WHILE i < nofbufs DO
- IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
- INC(i)
- END ;
- f.swapper := -1; f.mtime := mtime;
- res := Unix.Fstat(f.fd, stat); f.len := stat.size
- END ;
- RETURN f
- END ;
- INC(i)
- END ;
- RETURN NIL
- END CacheEntry;
-
- PROCEDURE Old* (name: ARRAY OF CHAR): File;
- VAR f: File; fd, res, errno: LONGINT; pos: INTEGER; done: BOOLEAN;
- dir, path: ARRAY 256 OF CHAR;
- stat: Unix.Status;
- BEGIN
- IF name # "" THEN
- IF HasDir(name) THEN dir := ""; COPY(name, path)
- ELSE
- pos := 0;
- COPY(name, path); (* -- noch *)
- (*ScanPath(pos, dir);*) (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*)
- END ;
- LOOP
- fd := Unix.Open(path, Unix.rdwr, {}); done := fd >= 0; errno := Unix.errno();
- IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN
- IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ;
- Kernel.GC(TRUE);
- fd := Unix.Open(path, Unix.rdwr, {});
- done := fd >= 0; errno := Unix.errno();
- IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END
- END ;
- IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN
- (* errno EAGAIN observed on Solaris 2.4 *)
- fd := Unix.Open(path, Unix.rdonly, {}); done := fd >= 0; errno := Unix.errno()
- END ;
-IF (~done) & (errno # Unix.ENOENT) THEN
- Console.String("warning Files.Old "); Console.String(name);
- Console.String(" errno = "); Console.Int(errno, 0); Console.Ln;
-END ;
- IF done THEN
- res := Unix.Fstat(fd, stat);
- f := CacheEntry(stat.dev, stat.ino, stat.mtime);
- IF f # NIL THEN res := Unix.Close(fd); RETURN f
- ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0)
- ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
- f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
- COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE;
- f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime;
- RETURN f
- END
- ELSIF dir = "" THEN RETURN NIL
- ELSE (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*)
- RETURN NIL
- END
- END
- ELSE RETURN NIL
- END
- END Old;
-
- PROCEDURE Purge* (f: File);
- VAR i: INTEGER; stat: Unix.Status; res: LONGINT;
- BEGIN i := 0;
- WHILE i < nofbufs DO
- IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
- INC(i)
- END ;
- IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ;
- f.pos := 0; f.len := 0; f.swapper := -1;
- res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime
- END Purge;
-
- PROCEDURE GetDate* (f: File; VAR t, d: LONGINT);
- VAR stat: Unix.Status; clock, res: LONGINT; time: Time;
- BEGIN
- Create(f); res := Unix.Fstat(f.fd, stat);
- time := localtime(stat.mtime);
- t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12);
- d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9)
- END GetDate;
-
- PROCEDURE Pos* (VAR r: Rider): LONGINT;
- BEGIN RETURN r.org + r.offset
- END Pos;
-
- PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT);
- VAR org, offset, i, n, res: LONGINT; buf: Buffer;
- BEGIN
- IF f # NIL THEN
- IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END ;
- offset := pos MOD bufsize; org := pos - offset; i := 0;
- WHILE (i < nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ;
- IF i < nofbufs THEN
- IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf
- ELSE buf := f.bufs[i]
- END
- ELSE
- f.swapper := (f.swapper + 1) MOD nofbufs;
- buf := f.bufs[f.swapper];
- Flush(buf)
- END ;
- IF buf.org # org THEN
- IF org = f.len THEN buf.size := 0
- ELSE Create(f);
- IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ;
- n := Unix.ReadBlk(f.fd, buf.data);
- IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ;
- f.pos := org + n;
- buf.size := n
- END ;
- buf.org := org; buf.chg := FALSE
- END
- ELSE buf := NIL; org := 0; offset := 0
- END ;
- r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE; r.res := 0
- END Set;
-
- PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
- VAR offset: LONGINT; buf: Buffer;
- BEGIN
- buf := r.buf; offset := r.offset;
- IF r.org # buf.org THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END ;
- IF (offset < buf.size) THEN
- x := buf.data[offset]; r.offset := offset + 1
- ELSIF r.org + offset < buf.f.len THEN
- Set(r, r.buf.f, r.org + offset);
- x := r.buf.data[0]; r.offset := 1
- ELSE
- x := 0X; r.eof := TRUE
- END
- END Read;
-
- PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
- VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
- BEGIN
- IF n > LEN(x) THEN IdxTrap END ;
- xpos := 0; buf := r.buf; offset := r.offset;
- WHILE n > 0 DO
- IF (r.org # buf.org) OR (offset >= bufsize) THEN
- Set(r, buf.f, r.org + offset);
- buf := r.buf; offset := r.offset
- END ;
- restInBuf := buf.size - offset;
- IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN
- ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ;
- SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.ADR(x) + xpos, min);
- INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min)
- END ;
- r.res := 0; r.eof := FALSE
- END ReadBytes;
-
- PROCEDURE ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE);
- BEGIN
- ReadBytes(r, x, 1);
- END ReadByte;
-
- PROCEDURE Base* (VAR r: Rider): File;
- BEGIN RETURN r.buf.f
- END Base;
-
- PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
- VAR buf: Buffer; offset: LONGINT;
- BEGIN
- buf := r.buf; offset := r.offset;
- IF (r.org # buf.org) OR (offset >= bufsize) THEN
- Set(r, buf.f, r.org + offset);
- buf := r.buf; offset := r.offset
- END ;
- buf.data[offset] := x;
- buf.chg := TRUE;
- IF offset = buf.size THEN
- INC(buf.size); INC(buf.f.len)
- END ;
- r.offset := offset + 1; r.res := 0
- END Write;
-
- PROCEDURE WriteByte* (VAR r : Rider; x : SYSTEM.BYTE); (* added for compatibility with PO 2013, -- noch *)
- BEGIN
- Write(r, x);
- END WriteByte;
-
- PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
- VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
- BEGIN
- IF n > LEN(x) THEN IdxTrap END ;
- xpos := 0; buf := r.buf; offset := r.offset;
- WHILE n > 0 DO
- IF (r.org # buf.org) OR (offset >= bufsize) THEN
- Set(r, buf.f, r.org + offset);
- buf := r.buf; offset := r.offset
- END ;
- restInBuf := bufsize - offset;
- IF n > restInBuf THEN min := restInBuf ELSE min := n END ;
- SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.ADR(buf.data) + offset, min);
- INC(offset, min); r.offset := offset;
- IF offset > buf.size THEN INC(buf.f.len, offset - buf.size); buf.size := offset END ;
- INC(xpos, min); DEC(n, min); buf.chg := TRUE
- END ;
- r.res := 0
- END WriteBytes;
-
-(* another solution would be one that is similar to ReadBytes, WriteBytes.
-No code duplication, more symmetric, only two ifs for
-Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len
-must be made consistent with offset (if offset > buf.size) in a lazy way.
-
-PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
- VAR buf: Buffer; offset: LONGINT;
-BEGIN
- buf := r.buf; offset := r.offset;
- IF (offset >= bufsize) OR (r.org # buf.org) THEN
- Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset;
- END ;
- buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE
-END Write;
-
-
-PROCEDURE WriteBytes ...
-
-PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
- VAR offset: LONGINT; buf: Buffer;
-BEGIN
- buf := r.buf; offset := r.offset;
- IF (offset >= buf.size) OR (r.org # buf.org) THEN
- IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN
- ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
- END
- END ;
- x := buf.data[offset]; r.offset := offset + 1
-END Read;
-
-but this would also affect Set, Length, and Flush.
-Especially Length would become fairly complex.
-*)
-
- PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER);
- BEGIN
- res := SHORT(Unix.Unlink(name));
- res := SHORT(Unix.errno())
- END Delete;
-
- PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER);
- VAR fdold, fdnew, n, errno, r: LONGINT;
- ostat, nstat: Unix.Status;
- buf: ARRAY 4096 OF CHAR;
- BEGIN
- r := Unix.Stat(old, ostat);
- IF r >= 0 THEN
- r := Unix.Stat(new, nstat);
- IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN
- Delete(new, res); (* work around stale nfs handles *)
- END ;
- r := Unix.Rename(old, new);
- IF r < 0 THEN res := SHORT(Unix.errno());
- IF res = Unix.EXDEV THEN (* cross device link, move the file *)
- fdold := Unix.Open(old, Unix.rdonly, {});
- IF fdold < 0 THEN res := 2; RETURN END ;
- fdnew := Unix.Open(new, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8});
- IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ;
- n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize);
- WHILE n > 0 DO
- r := Unix.Write(fdnew, SYSTEM.ADR(buf), n);
- IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew);
- Err("cannot move file", NIL, errno)
- END ;
- n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize)
- END ;
- errno := Unix.errno();
- r := Unix.Close(fdold); r := Unix.Close(fdnew);
- IF n = 0 THEN r := Unix.Unlink(old); res := 0
- ELSE Err("cannot move file", NIL, errno)
- END ;
- ELSE RETURN (* res is Unix.Rename return code *)
- END
- END ;
- res := 0
- ELSE res := 2 (* old file not found *)
- END
- END Rename;
-
- PROCEDURE Register* (f: File);
- VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR;
- BEGIN
- IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ;
- Close(f);
- IF f.registerName # "" THEN
- Rename(f.workName, f.registerName, errno);
- IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ;
- f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
- END
- END Register;
-
- PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER);
- BEGIN
- res := SHORT(Unix.Chdir(path));
- getcwd(Kernel.CWD)
- END ChangeDirectory;
-
- PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE);
- VAR i, j: LONGINT;
- BEGIN
- IF ~Kernel.littleEndian THEN i := LEN(src); j := 0;
- WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END
- ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src))
- END
- END FlipBytes;
-
- PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN);
- BEGIN Read(R, SYSTEM.VAL(CHAR, x))
- END ReadBool;
-
-(* PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER);
- VAR b: ARRAY 2 OF CHAR;
- BEGIN ReadBytes(R, b, 2);
- x := ORD(b[0]) + ORD(b[1])*256
- END ReadInt;
- *)
-
- PROCEDURE ReadInt* (VAR R: Rider; VAR x: LONGINT); (* to compile OR compiler; -- noch *)
- VAR b: ARRAY 4 OF CHAR;
- BEGIN ReadBytes(R, b, 4);
- x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H
- END ReadInt;
-
- PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT);
- VAR b: ARRAY 4 OF CHAR;
- BEGIN ReadBytes(R, b, 4);
- x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H
- END ReadLInt;
-
- PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET);
- VAR b: ARRAY 4 OF CHAR;
- BEGIN ReadBytes(R, b, 4);
- x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H)
- END ReadSet;
-
- PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL);
- VAR b: ARRAY 4 OF CHAR;
- BEGIN ReadBytes(R, b, 4); FlipBytes(b, x)
- END ReadReal;
-
- PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL);
- VAR b: ARRAY 8 OF CHAR;
- BEGIN ReadBytes(R, b, 8); FlipBytes(b, x)
- END ReadLReal;
-
- PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR);
- VAR i: INTEGER; ch: CHAR;
- BEGIN i := 0;
- REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X
- END ReadString;
-
- (* need to read line; -- noch *)
- PROCEDURE ReadLine* (VAR R: Rider; VAR x: ARRAY OF CHAR);
- VAR i: INTEGER; ch: CHAR; b : BOOLEAN;
- BEGIN i := 0;
- b := FALSE;
- REPEAT
- Read(R, ch);
- IF ((ch = 0X) OR (ch = 0AX) OR (ch = 0DX)) THEN
- b := TRUE
- ELSE
- x[i] := ch;
- INC(i);
- END;
- UNTIL b
- END ReadLine;
-
- PROCEDURE ReadNum* (VAR R: Rider; VAR x: LONGINT);
- VAR s: SHORTINT; ch: CHAR; n: LONGINT;
- BEGIN s := 0; n := 0; Read(R, ch);
- WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); Read(R, ch) END;
- INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) );
- x := n
- END ReadNum;
-
- PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN);
- BEGIN Write(R, SYSTEM.VAL(CHAR, x))
- END WriteBool;
-
-(* PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER);
- VAR b: ARRAY 2 OF CHAR;
- BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256);
- WriteBytes(R, b, 2);
- END WriteInt;
- *)
- PROCEDURE WriteInt* (VAR R: Rider; x: LONGINT); (* to compile OR compiler; -- noch *)
- VAR b: ARRAY 4 OF CHAR;
- BEGIN
- b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H);
- WriteBytes(R, b, 4);
- END WriteInt;
-
- PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT);
- VAR b: ARRAY 4 OF CHAR;
- BEGIN
- b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H);
- WriteBytes(R, b, 4);
- END WriteLInt;
-
- PROCEDURE WriteSet* (VAR R: Rider; x: SET);
- VAR b: ARRAY 4 OF CHAR; i: LONGINT;
- BEGIN i := SYSTEM.VAL(LONGINT, x);
- 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;
-
- PROCEDURE WriteReal* (VAR R: Rider; x: REAL);
- VAR b: ARRAY 4 OF CHAR;
- BEGIN FlipBytes(x, b); WriteBytes(R, b, 4)
- END WriteReal;
-
- PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL);
- VAR b: ARRAY 8 OF CHAR;
- BEGIN FlipBytes(x, b); WriteBytes(R, b, 8)
- END WriteLReal;
-
- PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] OF CHAR);
- VAR i: INTEGER;
- BEGIN i := 0;
- WHILE x[i] # 0X DO INC(i) END ;
- WriteBytes(R, x, i+1)
- END WriteString;
-
- PROCEDURE WriteNum* (VAR R: Rider; x: LONGINT);
- BEGIN
- WHILE (x < - 64) OR (x > 63) DO Write(R, CHR(x MOD 128 + 128)); x := x DIV 128 END;
- Write(R, CHR(x MOD 128))
- END WriteNum;
-
- PROCEDURE GetName*(f: File; VAR name: ARRAY OF CHAR);
- BEGIN
- COPY (f.workName, name);
- END GetName;
-
- PROCEDURE Finalize(o: SYSTEM.PTR);
- VAR f: File; res: LONGINT;
- BEGIN
- f := SYSTEM.VAL(File, o);
- IF f.fd >= 0 THEN
- fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles);
- IF f.tempFile THEN res := Unix.Unlink(f.workName) END
- END
- END Finalize;
-
- PROCEDURE Init;
- VAR i: LONGINT;
- BEGIN
- i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ;
- tempno := -1; Kernel.nofiles := 0
- END Init;
-
-BEGIN Init
-END CompatFiles.
diff --git a/src/voc07R/x86_64/CompatFiles.Mod b/src/voc07R/x86_64/CompatFiles.Mod
deleted file mode 100644
index 785a9666..00000000
--- a/src/voc07R/x86_64/CompatFiles.Mod
+++ /dev/null
@@ -1,677 +0,0 @@
-MODULE CompatFiles; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *)
-(* modified version of Files, which opens only the file provided and does not scan any path in any environment variable, also ReadLine procedure added; -- noch *)
- IMPORT SYSTEM, Unix, Kernel, Args, Console;
-
- (* 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
- nofbufs = 4;
- bufsize = 4096;
- fileTabSize = 64;
- noDesc = -1;
- notDone = -1;
-
- (* file states *)
- open = 0; create = 1; close = 2;
-
-
- TYPE
- FileName = ARRAY 101 OF CHAR;
- File* = POINTER TO Handle;
- Buffer = POINTER TO BufDesc;
-
- Handle = RECORD
- workName, registerName: FileName;
- tempFile: BOOLEAN;
- dev, ino, mtime: LONGINT;
- fd-: INTEGER; len, pos: LONGINT;
- bufs: ARRAY nofbufs OF Buffer;
- swapper, state: INTEGER
- END ;
-
- BufDesc = RECORD
- f: File;
- chg: BOOLEAN;
- org, size: LONGINT;
- data: ARRAY bufsize OF SYSTEM.BYTE
- END ;
-
- Rider* = RECORD
- res*: LONGINT;
- eof*: BOOLEAN;
- buf: Buffer;
- org, offset: LONGINT
- END ;
-
- Time = POINTER TO TimeDesc;
- TimeDesc = RECORD
- sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT;
-(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*)
- END ;
-
- VAR
- fileTab: ARRAY fileTabSize OF LONGINT (*=File*);
- tempno: INTEGER;
-
-(* for localtime *)
- PROCEDURE -includetime()
- '#include "time.h"';
-
- PROCEDURE -localtime(VAR clock: LONGINT): Time
- "(CompatFiles_Time) localtime(clock)";
-
- PROCEDURE -getcwd(VAR cwd: Unix.Name)
- "getcwd(cwd, cwd__len)";
-
- PROCEDURE -IdxTrap "__HALT(-1)";
-
- PROCEDURE^ Finalize(o: SYSTEM.PTR);
-
- PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT);
- BEGIN
- Console.Ln; Console.String("-- "); Console.String(s); Console.String(": ");
- IF f # NIL THEN
- IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END
- END ;
- IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ;
- Console.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
- END MakeFileName;
-
- PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR);
- VAR n, i, j: LONGINT;
- BEGIN
- INC(tempno); n := tempno; i := 0;
- IF finalName[0] # "/" THEN (* relative pathname *)
- WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END;
- IF Kernel.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;
- 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 := SHORT(Unix.Getpid());
- WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
- name[i] := 0X
- END GetTempName;
-
- PROCEDURE Create(f: File);
- VAR stat: Unix.Status; done: BOOLEAN;
- errno: LONGINT; err: ARRAY 32 OF CHAR;
- BEGIN
- IF f.fd = noDesc THEN
- IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE
- ELSIF f.state = close THEN
- f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
- END ;
- errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*)
- f.fd := Unix.Open(f.workName, SYSTEM.VAL(INTEGER, Unix.rdwr + Unix.creat + Unix.trunc), SYSTEM.VAL(LONGINT, {2, 4,5, 7,8}));
- done := f.fd >= 0; errno := Unix.errno();
- IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN
- IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ;
- Kernel.GC(TRUE);
- f.fd := Unix.Open(f.workName, SYSTEM.VAL(INTEGER, Unix.rdwr + Unix.creat + Unix.trunc), SYSTEM.VAL(LONGINT, {2, 4,5, 7,8}));
- done := f.fd >= 0
- END ;
- IF done THEN
- IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0)
- ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
- f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat);
- f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime
- END
- ELSE errno := Unix.errno();
- IF errno = Unix.ENOENT THEN err := "no such directory"
- ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open"
- ELSE err := "file not created"
- END ;
- Err(err, f, errno)
- END
- END
- END Create;
-
- PROCEDURE Flush(buf: Buffer);
- VAR res: LONGINT; f: File; stat: Unix.Status;
- BEGIN
- IF buf.chg THEN f := buf.f; Create(f);
- IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ;
- res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
- IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ;
- f.pos := buf.org + buf.size;
- buf.chg := FALSE;
- res := Unix.Fstat(f.fd, stat);
- f.mtime := stat.mtime
- END
- END Flush;
-
- PROCEDURE Close* (f: File);
- VAR i, res: LONGINT;
- BEGIN
- IF (f.state # create) OR (f.registerName # "") THEN
- Create(f); i := 0;
- WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ;
- res := Unix.Fsync(f.fd);
- IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END
- END
- END Close;
-
- PROCEDURE Length* (f: File): LONGINT;
- BEGIN RETURN f.len
- END Length;
-
- PROCEDURE New* (name: ARRAY OF CHAR): File;
- VAR f: File;
- BEGIN
- NEW(f); f.workName := ""; COPY(name, f.registerName);
- f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
- RETURN f
- END New;
-(*
- PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *)
- VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR;
- BEGIN
- i := 0; ch := Kernel.OBERON[pos];
- WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ;
- IF ch = "~" THEN
- INC(pos); ch := Kernel.OBERON[pos];
- home := ""; Args.GetEnv("HOME", home);
- WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ;
- IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN
- WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END
- END
- END ;
- WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ;
- WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ;
- dir[i] := 0X
- END ScanPath;
-*)
- PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN;
- VAR i: INTEGER; ch: CHAR;
- BEGIN i := 0; ch := name[0];
- WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ;
- RETURN ch = "/"
- END HasDir;
-
- PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File;
- VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT;
- BEGIN i := 0;
- WHILE i < fileTabSize DO
- f := SYSTEM.VAL(File, fileTab[i]);
- IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN
- IF mtime # f.mtime THEN i := 0;
- WHILE i < nofbufs DO
- IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
- INC(i)
- END ;
- f.swapper := -1; f.mtime := mtime;
- res := Unix.Fstat(f.fd, stat); f.len := stat.size
- END ;
- RETURN f
- END ;
- INC(i)
- END ;
- RETURN NIL
- END CacheEntry;
-
- PROCEDURE Old* (name: ARRAY OF CHAR): File;
- VAR f: File; fd, res: INTEGER; errno: LONGINT; pos: INTEGER; done: BOOLEAN;
- dir, path: ARRAY 256 OF CHAR;
- stat: Unix.Status;
- BEGIN
- IF name # "" THEN
- IF HasDir(name) THEN dir := ""; COPY(name, path)
- ELSE
- pos := 0;
- COPY(name, path); (* -- noch *)
- (*ScanPath(pos, dir);*) (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*)
- END ;
- LOOP
- fd := Unix.Open(path, SYSTEM.VAL(INTEGER, Unix.rdwr), (*{}*) 0); done := fd >= 0; errno := Unix.errno();
- IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN
- IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ;
- Kernel.GC(TRUE);
- fd := Unix.Open(path, SYSTEM.VAL(INTEGER, Unix.rdwr), (*{}*)0);
- done := fd >= 0; errno := Unix.errno();
- IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END
- END ;
- IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN
- (* errno EAGAIN observed on Solaris 2.4 *)
- fd := Unix.Open(path, SYSTEM.VAL(INTEGER, Unix.rdonly), (*{}*)0); done := fd >= 0; errno := Unix.errno()
- END ;
-IF (~done) & (errno # Unix.ENOENT) THEN
- Console.String("warning Files.Old "); Console.String(name);
- Console.String(" errno = "); Console.Int(errno, 0); Console.Ln;
-END ;
- IF done THEN
- res := Unix.Fstat(fd, stat);
- f := CacheEntry(stat.dev, stat.ino, stat.mtime);
- IF f # NIL THEN res := Unix.Close(fd); RETURN f
- ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0)
- ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
- f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
- COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE;
- f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime;
- RETURN f
- END
- ELSIF dir = "" THEN RETURN NIL
- ELSE (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*)
- RETURN NIL
- END
- END
- ELSE RETURN NIL
- END
- END Old;
-
- PROCEDURE Purge* (f: File);
- VAR i: INTEGER; stat: Unix.Status; res: LONGINT;
- BEGIN i := 0;
- WHILE i < nofbufs DO
- IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
- INC(i)
- END ;
- IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ;
- f.pos := 0; f.len := 0; f.swapper := -1;
- res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime
- END Purge;
-
- PROCEDURE GetDate* (f: File; VAR t, d: LONGINT);
- VAR stat: Unix.Status; clock, res: LONGINT; time: Time;
- BEGIN
- Create(f); res := Unix.Fstat(f.fd, stat);
- time := localtime(stat.mtime);
- t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12);
- d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9)
- END GetDate;
-
- PROCEDURE Pos* (VAR r: Rider): LONGINT;
- BEGIN RETURN r.org + r.offset
- END Pos;
-
- PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT);
- VAR org, offset, i, n, res: LONGINT; buf: Buffer;
- BEGIN
- IF f # NIL THEN
- IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END ;
- offset := pos MOD bufsize; org := pos - offset; i := 0;
- WHILE (i < nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ;
- IF i < nofbufs THEN
- IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf
- ELSE buf := f.bufs[i]
- END
- ELSE
- f.swapper := (f.swapper + 1) MOD nofbufs;
- buf := f.bufs[f.swapper];
- Flush(buf)
- END ;
- IF buf.org # org THEN
- IF org = f.len THEN buf.size := 0
- ELSE Create(f);
- IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ;
- n := Unix.ReadBlk(f.fd, buf.data);
- IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ;
- f.pos := org + n;
- buf.size := n
- END ;
- buf.org := org; buf.chg := FALSE
- END
- ELSE buf := NIL; org := 0; offset := 0
- END ;
- r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE; r.res := 0
- END Set;
-
- PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
- VAR offset: LONGINT; buf: Buffer;
- BEGIN
- buf := r.buf; offset := r.offset;
- IF r.org # buf.org THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END ;
- IF (offset < buf.size) THEN
- x := buf.data[offset]; r.offset := offset + 1
- ELSIF r.org + offset < buf.f.len THEN
- Set(r, r.buf.f, r.org + offset);
- x := r.buf.data[0]; r.offset := 1
- ELSE
- x := 0X; r.eof := TRUE
- END
- END Read;
-
- PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
- VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
- BEGIN
- IF n > LEN(x) THEN IdxTrap END ;
- xpos := 0; buf := r.buf; offset := r.offset;
- WHILE n > 0 DO
- IF (r.org # buf.org) OR (offset >= bufsize) THEN
- Set(r, buf.f, r.org + offset);
- buf := r.buf; offset := r.offset
- END ;
- restInBuf := buf.size - offset;
- IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN
- ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ;
- SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.ADR(x) + xpos, min);
- INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min)
- END ;
- r.res := 0; r.eof := FALSE
- END ReadBytes;
-
- PROCEDURE ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE);
- BEGIN
- ReadBytes(r, x, 1);
- END ReadByte;
-
- PROCEDURE Base* (VAR r: Rider): File;
- BEGIN RETURN r.buf.f
- END Base;
-
- PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
- VAR buf: Buffer; offset: LONGINT;
- BEGIN
- buf := r.buf; offset := r.offset;
- IF (r.org # buf.org) OR (offset >= bufsize) THEN
- Set(r, buf.f, r.org + offset);
- buf := r.buf; offset := r.offset
- END ;
- buf.data[offset] := x;
- buf.chg := TRUE;
- IF offset = buf.size THEN
- INC(buf.size); INC(buf.f.len)
- END ;
- r.offset := offset + 1; r.res := 0
- END Write;
-
- PROCEDURE WriteByte* (VAR r : Rider; x : SYSTEM.BYTE); (* added for compatibility with PO 2013, -- noch *)
- BEGIN
- Write(r, x);
- END WriteByte;
-
- PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
- VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
- BEGIN
- IF n > LEN(x) THEN IdxTrap END ;
- xpos := 0; buf := r.buf; offset := r.offset;
- WHILE n > 0 DO
- IF (r.org # buf.org) OR (offset >= bufsize) THEN
- Set(r, buf.f, r.org + offset);
- buf := r.buf; offset := r.offset
- END ;
- restInBuf := bufsize - offset;
- IF n > restInBuf THEN min := restInBuf ELSE min := n END ;
- SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.ADR(buf.data) + offset, min);
- INC(offset, min); r.offset := offset;
- IF offset > buf.size THEN INC(buf.f.len, offset - buf.size); buf.size := offset END ;
- INC(xpos, min); DEC(n, min); buf.chg := TRUE
- END ;
- r.res := 0
- END WriteBytes;
-
-(* another solution would be one that is similar to ReadBytes, WriteBytes.
-No code duplication, more symmetric, only two ifs for
-Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len
-must be made consistent with offset (if offset > buf.size) in a lazy way.
-
-PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
- VAR buf: Buffer; offset: LONGINT;
-BEGIN
- buf := r.buf; offset := r.offset;
- IF (offset >= bufsize) OR (r.org # buf.org) THEN
- Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset;
- END ;
- buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE
-END Write;
-
-
-PROCEDURE WriteBytes ...
-
-PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
- VAR offset: LONGINT; buf: Buffer;
-BEGIN
- buf := r.buf; offset := r.offset;
- IF (offset >= buf.size) OR (r.org # buf.org) THEN
- IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN
- ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
- END
- END ;
- x := buf.data[offset]; r.offset := offset + 1
-END Read;
-
-but this would also affect Set, Length, and Flush.
-Especially Length would become fairly complex.
-*)
-
- PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER);
- BEGIN
- res := SHORT(Unix.Unlink(name));
- res := SHORT(Unix.errno())
- END Delete;
-
- PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER);
- VAR fdold, fdnew: INTEGER; n, errno, r: LONGINT;
- ostat, nstat: Unix.Status;
- buf: ARRAY 4096 OF CHAR;
- BEGIN
- r := Unix.Stat(old, ostat);
- IF r >= 0 THEN
- r := Unix.Stat(new, nstat);
- IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN
- Delete(new, res); (* work around stale nfs handles *)
- END ;
- r := Unix.Rename(old, new);
- IF r < 0 THEN res := SHORT(Unix.errno());
- IF res = Unix.EXDEV THEN (* cross device link, move the file *)
- fdold := Unix.Open(old, SYSTEM.VAL(INTEGER, Unix.rdonly), (*{}*)0);
- IF fdold < 0 THEN res := 2; RETURN END ;
- fdnew := Unix.Open(new, SYSTEM.VAL(INTEGER, Unix.rdwr + Unix.creat + Unix.trunc), SYSTEM.VAL(LONGINT, {2, 4,5, 7,8}));
- IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ;
- n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize);
- WHILE n > 0 DO
- r := Unix.Write(fdnew, SYSTEM.ADR(buf), n);
- IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew);
- Err("cannot move file", NIL, errno)
- END ;
- n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize)
- END ;
- errno := Unix.errno();
- r := Unix.Close(fdold); r := Unix.Close(fdnew);
- IF n = 0 THEN r := Unix.Unlink(old); res := 0
- ELSE Err("cannot move file", NIL, errno)
- END ;
- ELSE RETURN (* res is Unix.Rename return code *)
- END
- END ;
- res := 0
- ELSE res := 2 (* old file not found *)
- END
- END Rename;
-
- PROCEDURE Register* (f: File);
- VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR;
- BEGIN
- IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ;
- Close(f);
- IF f.registerName # "" THEN
- Rename(f.workName, f.registerName, errno);
- IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ;
- f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
- END
- END Register;
-
- PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER);
- BEGIN
- res := SHORT(Unix.Chdir(path));
- getcwd(Kernel.CWD)
- END ChangeDirectory;
-
- PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE);
- VAR i, j: LONGINT;
- BEGIN
- IF ~Kernel.littleEndian THEN i := LEN(src); j := 0;
- WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END
- ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src))
- END
- END FlipBytes;
-
- PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN);
- BEGIN Read(R, SYSTEM.VAL(CHAR, x))
- END ReadBool;
-
-(* PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER);
- VAR b: ARRAY 2 OF CHAR;
- BEGIN ReadBytes(R, b, 2);
- x := ORD(b[0]) + ORD(b[1])*256
- END ReadInt;
- *)
-
- PROCEDURE ReadInt* (VAR R: Rider; VAR x: LONGINT); (* to compile OR compiler; -- noch *)
- VAR b: ARRAY 4 OF CHAR;
- BEGIN ReadBytes(R, b, 4);
- x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H
- END ReadInt;
-
- PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT);
- VAR b: ARRAY 4 OF CHAR;
- BEGIN ReadBytes(R, b, 4);
- x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H
- END ReadLInt;
-
- PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET);
- VAR b: ARRAY 4 OF CHAR;
- BEGIN ReadBytes(R, b, 4);
- x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H)
- END ReadSet;
-
- PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL);
- VAR b: ARRAY 4 OF CHAR;
- BEGIN ReadBytes(R, b, 4); FlipBytes(b, x)
- END ReadReal;
-
- PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL);
- VAR b: ARRAY 8 OF CHAR;
- BEGIN ReadBytes(R, b, 8); FlipBytes(b, x)
- END ReadLReal;
-
- PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR);
- VAR i: INTEGER; ch: CHAR;
- BEGIN i := 0;
- REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X
- END ReadString;
-
- (* need to read line; -- noch *)
- PROCEDURE ReadLine* (VAR R: Rider; VAR x: ARRAY OF CHAR);
- VAR i: INTEGER; ch: CHAR; b : BOOLEAN;
- BEGIN i := 0;
- b := FALSE;
- REPEAT
- Read(R, ch);
- IF ((ch = 0X) OR (ch = 0AX) OR (ch = 0DX)) THEN
- b := TRUE
- ELSE
- x[i] := ch;
- INC(i);
- END;
- UNTIL b
- END ReadLine;
-
- PROCEDURE ReadNum* (VAR R: Rider; VAR x: LONGINT);
- VAR s: SHORTINT; ch: CHAR; n: LONGINT;
- BEGIN s := 0; n := 0; Read(R, ch);
- WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); Read(R, ch) END;
- INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) );
- x := n
- END ReadNum;
-
- PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN);
- BEGIN Write(R, SYSTEM.VAL(CHAR, x))
- END WriteBool;
-
-(* PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER);
- VAR b: ARRAY 2 OF CHAR;
- BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256);
- WriteBytes(R, b, 2);
- END WriteInt;
- *)
- PROCEDURE WriteInt* (VAR R: Rider; x: LONGINT); (* to compile OR compiler; -- noch *)
- VAR b: ARRAY 4 OF CHAR;
- BEGIN
- b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H);
- WriteBytes(R, b, 4);
- END WriteInt;
-
- PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT);
- VAR b: ARRAY 4 OF CHAR;
- BEGIN
- b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H);
- WriteBytes(R, b, 4);
- END WriteLInt;
-
- PROCEDURE WriteSet* (VAR R: Rider; x: SET);
- VAR b: ARRAY 4 OF CHAR; i: LONGINT;
- BEGIN i := SYSTEM.VAL(LONGINT, x);
- 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;
-
- PROCEDURE WriteReal* (VAR R: Rider; x: REAL);
- VAR b: ARRAY 4 OF CHAR;
- BEGIN FlipBytes(x, b); WriteBytes(R, b, 4)
- END WriteReal;
-
- PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL);
- VAR b: ARRAY 8 OF CHAR;
- BEGIN FlipBytes(x, b); WriteBytes(R, b, 8)
- END WriteLReal;
-
- PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] OF CHAR);
- VAR i: INTEGER;
- BEGIN i := 0;
- WHILE x[i] # 0X DO INC(i) END ;
- WriteBytes(R, x, i+1)
- END WriteString;
-
- PROCEDURE WriteNum* (VAR R: Rider; x: LONGINT);
- BEGIN
- WHILE (x < - 64) OR (x > 63) DO Write(R, CHR(x MOD 128 + 128)); x := x DIV 128 END;
- Write(R, CHR(x MOD 128))
- END WriteNum;
-
- PROCEDURE GetName*(f: File; VAR name: ARRAY OF CHAR);
- BEGIN
- COPY (f.workName, name);
- END GetName;
-
- PROCEDURE Finalize(o: SYSTEM.PTR);
- VAR f: File; res: LONGINT;
- BEGIN
- f := SYSTEM.VAL(File, o);
- IF f.fd >= 0 THEN
- fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles);
- IF f.tempFile THEN res := Unix.Unlink(f.workName) END
- END
- END Finalize;
-
- PROCEDURE Init;
- VAR i: LONGINT;
- BEGIN
- i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ;
- tempno := -1; Kernel.nofiles := 0
- END Init;
-
-BEGIN Init
-END CompatFiles.