vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-06 11:02:24 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Compare commits

base: vishapoberon:master
Branches Tags
vishapoberon:master
vishapoberon:type_bound_proc_fix
vishapoberon:initOptions
vishapoberon:nvcc
vishapoberon:modulo
vishapoberon:ooc_c_sizes
vishapoberon:faster
vishapoberon:tcc_support
vishapoberon:hexextend
vishapoberon:configure_quotes
vishapoberon:ADRINT
vishapoberon:tidy
vishapoberon:ErrorsExperiment
vishapoberon:v2.1.2
vishapoberon:v2.1.1
vishapoberon:v2.1.0
vishapoberon:v2.0.0
vishapoberon:v1.1.0
..
compare: vishapoberon:v2.0.0
Branches Tags
vishapoberon:master
vishapoberon:type_bound_proc_fix
vishapoberon:initOptions
vishapoberon:nvcc
vishapoberon:modulo
vishapoberon:ooc_c_sizes
vishapoberon:faster
vishapoberon:tcc_support
vishapoberon:hexextend
vishapoberon:configure_quotes
vishapoberon:ADRINT
vishapoberon:tidy
vishapoberon:ErrorsExperiment
vishapoberon:v2.1.2
vishapoberon:v2.1.1
vishapoberon:v2.1.0
vishapoberon:v2.0.0
vishapoberon:v1.1.0

No commits in common. "master" and "v2.0.0" have entirely different histories.
master ... v2.0.0

330 changed files with 14067 additions and 15026 deletions
Download patch file Download diff file Expand all files Collapse all files

4
.gitattributes vendored
View file

@ -34,7 +34,3 @@
*.Mod diff=pascal
*.c diff=cpp
*.h diff=cpp
# Set the language to Oberon
*.Mod linguist-language=Oberon
*.mod linguist-language=Oberon

10
.gitignore vendored
View file

@ -2,7 +2,6 @@
/Configuration.Mod
/Configuration.Make
/build/*
/install/*
/*.exe
/*.obj
/*.[cho]
@ -11,7 +10,6 @@
/*.sym
/*.asm
/*.mod
/Errors.Txt
/Errors.txt
/olang
/src/test/**/*.exe
@ -21,11 +19,9 @@
/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
@ -38,9 +34,3 @@
**/.tmp.*
/*.pdb
/*.ilk
/t/*
/triage/BasicTypeSize.md
/triage/Roadmap.md
triage/system/*
tags
voc

139
ReadMe.md
View file

@ -1,12 +1,12 @@
![Build status](https://brownsmeet.com/githubhook/vishaps-status)
[![Build status](http://brownsmeet.com/build-status.svg)](http://brownsmeet.com/log/)
# Ѵishap Oberon
[Ѵishap Oberon](https://vishap.oberon.am/) is a free and open source (GPLv3)
[Ѵishap Oberon](http://oberon.vishap.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, tcc or msc) to compile
Vishap's Oberon Compiler (voc) uses a C backend (gcc, clang 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
&nbsp;&nbsp;&nbsp;&nbsp;[**Installation**](#installation)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**Compiling a 'Hello' application**](#a-hello-application)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**License**](#license)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**A 'Hello' application**](#a-hello-application)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**Licensing**](#licensing)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**Platform support and porting**](#platform-support-and-porting)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**Language support and libraries**](#language-support-and-libraries)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**History**](#history)<br>
@ -27,18 +27,8 @@ default libraries complying with the Oakwood Guidelines for Oberon-2 compilers.
## Installation
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:
While pre-built packages are not provided, it is easy to install the Oberon compiler and libraries
with the following simple steps.
#### 1. Install prerequisites
@ -53,57 +43,28 @@ These are detailed below:
More details, including for MingW and MS C, in [**Installation**](/doc/Installation.md).
#### 2. Clone and build the compiler and libraries
#### 2. Build and install the compiler and libraries
1. `git clone https://github.com/vishaps/voc`
2. `cd voc`
3. `make full`
3. `[sudo] make full`
`make full` will create an installation directory under your local repository at voc/install.
Since 'make full' will install the compiler and libraries, it needs root (unix) or administrator (windows) privileges.
`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).
#### 3. Set your PATH environment variable
Set your path to the installed compiler binary location as reported
by make full, e.g.
#### 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"` |
| 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"` |
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
@ -127,7 +88,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.
```
@ -138,35 +99,12 @@ 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`).
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.
```
Execute as usual on Linux ('./hello') or Windows ('hello').
## License
Also see [**Compiling**](/doc/Compiling.md).
## Licensing
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.
@ -181,9 +119,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 x86_64, 32 bit arm and aarch64.
Vishap Oberon supports 32 and 64 bit little-endian architectures including Intel x86 and x64, arm and ppc.
It compiles under gcc, clang, tcc and Microsoft Visual C.
It compiles under gcc, clang and Microsoft Visual C.
Installation supports GNU/Linux, MAC OSX, BSD and Windows (native and cygwin).
@ -247,7 +185,9 @@ 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.
## Oberon
## Origin of the name "Ѵishap Oberon"
#### Oberon
Oberon is a programming language, an operating system and a graphical
user interface. Originally designed and implemented by by Niklaus Wirth and
@ -266,7 +206,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.)
## Origin of the name "Ѵishap Oberon"
#### Ѵishap
Vishaps are dragons inhabiting the Armenian Highlands.
We decided to name the project “Vishap” because ties between compilers and dragons have ancient traditions.
@ -278,13 +218,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 ](https://people.inf.ethz.ch/wirth/ProjectOberon1992.pdf)
- [Oberon - the Overlooked Jewel](http://pascal.hansotten.com/uploads/oberonpi/Oberon%20article.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)
###### Oberon 2
- [Differences between Oberon and Oberon-2](https://citeseerx.ist.psu.edu/document?repid=rep1&type=pdf&doi=89e5bd3cf006bde4821599cdc57a37de5dc84bcd)
- [Differences between Oberon and Oberon-2](http://members.home.nl/jmr272/Oberon/Oberon2.Differences.pdf)
- [The Programming Language Oberon-2](http://www.ssw.uni-linz.ac.at/Research/Papers/Oberon2.pdf)
- [Programming in Oberon. Steps beyond Pascal and Modula](https://people.inf.ethz.ch/wirth/ProgInOberonWR.pdf)
- [Programming in Oberon. Steps beyond Pascal and Modula](http://www.ethoberon.ethz.ch/WirthPubl/ProgInOberonWR.pdf)
- [The Oakwood Guidelines for Oberon-2 Compiler Developers](http://www.math.bas.bg/bantchev/place/oberon/oakwood-guidelines.pdf)
###### Oberon 07
@ -294,12 +234,7 @@ 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/)
- [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)
- [ETH Zurich's Wirth publications page](http://www.ethoberon.ethz.ch/WirthPubl/)
- [Joseph Templ's ofront on github](https://hithub.com/jtempl/ofront)
- [Software Templ OG](http://www.software-templ.com)
## History
See [**History**](/doc/History.md).
- [Oberon: Steps beyond Pascal and Modula](http://fruttenboel.verhoeven272.nl/Oberon/)

43
bootstrap/SYSTEM.c
View file

@ -151,61 +151,53 @@ 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
void segfaultHandler(int signal) {
__HALT(-10);
}
// Revised signal handler to accommodate additional signals like SIGSEGV
SystemSignalHandler handler[3] = {0};
// Provide signal handling for Unix based systems
void signalHandler(int s) {
if ((s >= 2 && s <= 4) || s == 11) { // Include SIGSEGV (usually signal 11)
if (handler[s-2]) {
handler[s-2](s);
}
}
// Ignore other signals
if (s >= 2 && s <= 4) handler[s-2](s);
// (Ignore other signals)
}
void SystemSetHandler(int s, ADDRESS h) {
if ((s >= 2 && s <= 4) || s == 11) {
if (s >= 2 && s <= 4) {
int needtosetsystemhandler = handler[s-2] == 0;
handler[s-2] = (SystemSignalHandler)h;
if (needtosetsystemhandler) {
signal(s, signalHandler);
}
if (needtosetsystemhandler) {signal(s, signalHandler);}
}
}
void setupAutomaticSegfaultHandler() {
SystemSetHandler(11, (ADDRESS)segfaultHandler); // Register handler for SIGSEGV
}
#else
// Windows system remains as is since Windows does not use SIGSEGV in the same way
// Provides Windows callback handlers for signal-like scenarios
#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 {
} else { // Close, logoff or shutdown
if (SystemQuitHandler) {
SystemQuitHandler(3); // SIGQUIT
SystemQuitHandler(3); // SIGQUIT
return TRUE;
}
}
return FALSE;
}
void EnsureConsoleCtrlHandler() {
if (!ConsoleCtrlHandlerSet) {
SetConsoleCtrlHandler(SystemConsoleCtrlHandler, TRUE);
@ -224,4 +216,3 @@ typedef void (*SystemSignalHandler)(INT32); // = Platform_SignalHandler
}
#endif

25
bootstrap/SYSTEM.h
View file

@ -19,11 +19,7 @@
typedef unsigned long size_t;
#endif
#else
#if defined(__OpenBSD__)
typedef unsigned long size_t;
#else
typedef unsigned int size_t;
#endif
typedef unsigned int size_t;
#endif
#define _SIZE_T_DECLARED // For FreeBSD
@ -116,11 +112,9 @@ extern void Modules_AssertFail(INT32 x);
// Index checking
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))
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))
// Range checking, and checked SHORT and CHR functions
@ -243,7 +237,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);*((typ*)p)
#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p)
@ -264,15 +258,10 @@ extern void Heap_INCREF();
// Main module initialisation, registration and finalisation
extern void Modules_Init(INT32 argc, ADDRESS argv);
extern void Platform_Init(INT32 argc, ADDRESS argv);
extern void Heap_FINALL();
extern void setupAutomaticSegfaultHandler();
#ifndef _WIN32
#define __INIT(argc, argv) static void *m; setupAutomaticSegfaultHandler(); Modules_Init(argc, (ADDRESS)&argv);
#else
#define __INIT(argc, argv) static void *m; Modules_Init(argc, (ADDRESS)&argv);
#endif
#define __INIT(argc, argv) static void *m; Platform_Init(argc, (ADDRESS)&argv);
#define __REGMAIN(name, enum) m = Heap_REGMOD((CHAR*)name,enum)
#define __FINI Heap_FINALL(); return 0

53
bootstrap/unix-44/Compiler.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspamS */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspamS */
#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,12 +41,11 @@ 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_DeleteSym((void*)OPT_SelfName, 256);
OPM_DeleteNewSym();
OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogWStr((CHAR*)" Main program.", 16);
OPM_LogVT100((CHAR*)"0m", 3);
@ -62,7 +61,7 @@ void Compiler_Module (BOOLEAN *done)
}
}
} else {
OPM_DeleteSym((void*)OPT_SelfName, 256);
OPM_DeleteNewSym();
}
}
}
@ -89,7 +88,7 @@ static void Compiler_PropagateElementaryTypeSizes (void)
OPT_sintobj->typ = OPT_sinttyp;
OPT_intobj->typ = OPT_inttyp;
OPT_lintobj->typ = OPT_linttyp;
switch (OPM_SetSize) {
switch (OPM_LongintSize) {
case 4:
OPT_settyp = OPT_set32typ;
break;
@ -105,44 +104,14 @@ 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 linkfiles[2048];
CHAR modulesobj[2048];
modulesobj[0] = 0x00;
if (OPM_OpenPar()) {
for (;;) {
OPM_Init(&done);
OPM_Init(&done, (void*)Compiler_mname, 256);
if (!done) {
return;
}
@ -162,9 +131,11 @@ 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 {
Compiler_FindLocalObjectFiles((void*)linkfiles, 2048);
extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), linkfiles, 2048);
extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), modulesobj, 2048);
}
}
}

6
bootstrap/unix-44/Configuration.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -8,7 +8,7 @@
#include "SYSTEM.h"
export CHAR Configuration_versionLong[76];
export CHAR Configuration_versionLong[75];
@ -19,6 +19,6 @@ export void *Configuration__init(void)
__DEFMOD;
__REGMOD("Configuration", 0);
/* BEGIN */
__MOVE("2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 76);
__MOVE("1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75);
__ENDMOD;
}

4
bootstrap/unix-44/Configuration.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Configuration__h
#define Configuration__h
@ -6,7 +6,7 @@
#include "SYSTEM.h"
import CHAR Configuration_versionLong[76];
import CHAR Configuration_versionLong[75];
import void *Configuration__init(void);

426
bootstrap/unix-44/Files.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -26,7 +26,7 @@ typedef
Files_BufDesc *Files_Buffer;
typedef
CHAR Files_FileName[256];
CHAR Files_FileName[101];
typedef
struct Files_FileDesc {
@ -36,7 +36,7 @@ typedef
INT32 fd, len, pos;
Files_Buffer bufs[4];
INT16 swapper, state;
struct Files_FileDesc *next;
Files_File next;
} Files_FileDesc;
typedef
@ -48,12 +48,11 @@ typedef
} Files_Rider;
export INT16 Files_MaxPathLength, Files_MaxNameLength;
static Files_FileDesc *Files_files;
static Files_File Files_files;
static INT16 Files_tempno;
static CHAR Files_HOME[1024];
static struct {
ADDRESS len[1];
LONGINT len[1];
CHAR data[1];
} *Files_SearchPath;
@ -61,68 +60,58 @@ 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, ADDRESS path__len, INT16 *res);
export void Files_ChangeDirectory (CHAR *path, LONGINT 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, 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);
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);
static void Files_Finalize (SYSTEM_PTR o);
static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len);
static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len);
static void Files_Flush (Files_Buffer buf);
export void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
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 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 INT32 Files_Length (Files_File f);
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);
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len);
export Files_File Files_New (CHAR *name, LONGINT name__len);
export Files_File Files_Old (CHAR *name, LONGINT name__len);
export INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
export void Files_Purge (Files_File f);
export void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
export void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x);
export void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT 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, ADDRESS x__len);
export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
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_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, ADDRESS x__len);
export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
export void Files_Register (Files_File f);
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_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_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos);
export void Files_SetSearchPath (CHAR *path, ADDRESS path__len);
export void Files_SetSearchPath (CHAR *path, LONGINT 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, ADDRESS x__len, INT32 n);
export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT 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, ADDRESS x__len);
export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
#define Files_IdxTrap() __HALT(-1)
#define Files_ToAdr(x) (ADDRESS)x
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)
static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
{
__DUP(s, s__len, CHAR);
Out_Ln();
@ -131,17 +120,17 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
Out_String((CHAR*)": ", 3);
if (f != NIL) {
if (f->registerName[0] != 0x00) {
Out_String(f->registerName, 256);
Out_String(f->registerName, 101);
} else {
Out_String(f->workName, 256);
Out_String(f->workName, 101);
}
if (f->fd != 0) {
Out_String((CHAR*)", f.fd = ", 10);
Out_String((CHAR*)"f.fd = ", 8);
Out_Int(f->fd, 1);
}
}
if (errcode != 0) {
Out_String((CHAR*)", errcode = ", 13);
Out_String((CHAR*)" errcode = ", 12);
Out_Int(errcode, 1);
}
Out_Ln();
@ -149,125 +138,98 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
__DEL(s);
}
static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len)
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len)
{
INT16 i, j, ld, ln;
INT16 i, j;
__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 (j < ln) {
dest[__X(i, dest__len)] = name[__X(j, name__len)];
while (dir[i] != 0x00) {
dest[i] = dir[i];
i += 1;
}
if (dest[i - 1] != '/') {
dest[i] = '/';
i += 1;
}
while (name[j] != 0x00) {
dest[i] = name[j];
i += 1;
j += 1;
}
dest[__X(i, dest__len)] = 0x00;
dest[i] = 0x00;
__DEL(dir);
__DEL(name);
}
static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len)
static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len)
{
INT16 i, n;
INT32 n, i, j;
__DUP(finalName, finalName__len, CHAR);
if (finalName[0] == '/') {
__COPY(finalName, name, name__len);
} else {
Files_MakeFileName(Platform_CWD, 256, finalName, finalName__len, (void*)name, name__len);
}
i = Strings_Length(name, name__len) - 1;
while ((i > 0 && name[__X(i, name__len)] != '/')) {
i -= 1;
}
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 = 0;
if (finalName[0] != '/') {
while (Platform_CWD[i] != 0x00) {
name[i] = Platform_CWD[i];
i += 1;
}
if (Platform_CWD[i - 1] != '/') {
name[i] = '/';
i += 1;
}
}
j = 0;
while (finalName[j] != 0x00) {
name[i] = finalName[j];
i += 1;
j += 1;
}
i -= 1;
while (name[i] != '/') {
i -= 1;
}
name[i + 1] = '.';
name[i + 2] = 't';
name[i + 3] = 'm';
name[i + 4] = 'p';
name[i + 5] = '.';
i += 6;
while (n > 0) {
name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48);
name[i] = (CHAR)((int)__MOD(n, 10) + 48);
n = __DIV(n, 10);
i += 1;
}
name[__X(i, name__len)] = '.';
name[i] = '.';
i += 1;
n = Platform_PID;
while (n > 0) {
name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48);
name[i] = (CHAR)((int)__MOD(n, 10) + 48);
n = __DIV(n, 10);
i += 1;
}
name[__X(i, name__len)] = 0x00;
name[i] = 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, 256, (void*)f->workName, 256);
Files_GetTempName(f->registerName, 101, (void*)f->workName, 101);
f->tempFile = 1;
} else {
__ASSERT(f->state == 2, 0);
Files_Deregister(f->registerName, 256);
__MOVE(f->registerName, f->workName, 256);
} else if (f->state == 2) {
__COPY(f->registerName, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
error = Platform_Unlink((void*)f->workName, 256);
error = Platform_New((void*)f->workName, 256, &f->fd);
error = Platform_Unlink((void*)f->workName, 101);
error = Platform_New((void*)f->workName, 101, &f->fd);
done = error == 0;
if (done) {
f->next = Files_files;
@ -313,6 +275,27 @@ 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;
@ -320,10 +303,11 @@ void Files_Close (Files_File f)
if (f->state != 1 || f->registerName[0] != 0x00) {
Files_Create(f);
i = 0;
while ((i < 4 && f->bufs[__X(i, 4)] != NIL)) {
Files_Flush(f->bufs[__X(i, 4)]);
while ((i < 4 && f->bufs[i] != NIL)) {
Files_Flush(f->bufs[i]);
i += 1;
}
Files_CloseOSFile(f);
}
}
@ -332,13 +316,13 @@ INT32 Files_Length (Files_File f)
return f->len;
}
Files_File Files_New (CHAR *name, ADDRESS name__len)
Files_File Files_New (CHAR *name, LONGINT name__len)
{
Files_File f = NIL;
__DUP(name, name__len, CHAR);
__NEW(f, Files_FileDesc);
f->workName[0] = 0x00;
__COPY(name, f->registerName, 256);
__COPY(name, f->registerName, 101);
f->fd = -1;
f->state = 1;
f->len = 0;
@ -348,7 +332,7 @@ Files_File Files_New (CHAR *name, ADDRESS name__len)
return f;
}
static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len)
static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len)
{
INT16 i;
CHAR ch;
@ -360,38 +344,38 @@ static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len)
*pos += 1;
}
} else {
ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
ch = (Files_SearchPath->data)[*pos];
while (ch == ' ' || ch == ';') {
*pos += 1;
ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
ch = (Files_SearchPath->data)[*pos];
}
if (ch == '~') {
*pos += 1;
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)];
ch = (Files_SearchPath->data)[*pos];
while (Files_HOME[i] != 0x00) {
dir[i] = Files_HOME[i];
i += 1;
}
if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) {
while ((i > 0 && dir[__X(i - 1, dir__len)] != '/')) {
while ((i > 0 && dir[i - 1] != '/')) {
i -= 1;
}
}
}
while ((ch != 0x00 && ch != ';')) {
dir[__X(i, dir__len)] = ch;
dir[i] = ch;
i += 1;
*pos += 1;
ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
ch = (Files_SearchPath->data)[*pos];
}
while ((i > 0 && dir[__X(i - 1, dir__len)] == ' ')) {
while ((i > 0 && dir[i - 1] == ' ')) {
i -= 1;
}
}
dir[__X(i, dir__len)] = 0x00;
dir[i] = 0x00;
}
static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len)
static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
{
INT16 i;
CHAR ch;
@ -399,7 +383,7 @@ static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len)
ch = name[0];
while ((ch != 0x00 && ch != '/')) {
i += 1;
ch = name[__X(i, name__len)];
ch = name[i];
}
return ch == '/';
}
@ -408,15 +392,15 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
{
Files_File f = NIL;
INT16 i, error;
f = (Files_File)Files_files;
f = 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[__X(i, 4)] != NIL) {
f->bufs[__X(i, 4)]->org = -1;
f->bufs[__X(i, 4)] = NIL;
if (f->bufs[i] != NIL) {
f->bufs[i]->org = -1;
f->bufs[i] = NIL;
}
i += 1;
}
@ -426,12 +410,12 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
}
return f;
}
f = (Files_File)f->next;
f = f->next;
}
return NIL;
}
Files_File Files_Old (CHAR *name, ADDRESS name__len)
Files_File Files_Old (CHAR *name, LONGINT name__len)
{
Files_File f = NIL;
INT32 fd;
@ -472,7 +456,6 @@ Files_File Files_Old (CHAR *name, ADDRESS 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 {
@ -483,7 +466,7 @@ Files_File Files_Old (CHAR *name, ADDRESS name__len)
f->pos = 0;
f->swapper = -1;
error = Platform_Size(fd, &f->len);
__COPY(name, f->workName, 256);
__COPY(name, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
f->identity = identity;
@ -515,9 +498,9 @@ void Files_Purge (Files_File f)
INT16 error;
i = 0;
while (i < 4) {
if (f->bufs[__X(i, 4)] != NIL) {
f->bufs[__X(i, 4)]->org = -1;
f->bufs[__X(i, 4)] = NIL;
if (f->bufs[i] != NIL) {
f->bufs[i]->org = -1;
f->bufs[i] = NIL;
}
i += 1;
}
@ -543,7 +526,7 @@ void Files_GetDate (Files_File f, INT32 *t, INT32 *d)
INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ)
{
Files_Assert((*r).offset <= 4096);
__ASSERT((*r).offset <= 4096, 0);
return (*r).org + (*r).offset;
}
@ -561,22 +544,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[__X(i, 4)] != NIL)) && org != f->bufs[__X(i, 4)]->org)) {
while ((((i < 4 && f->bufs[i] != NIL)) && org != f->bufs[i]->org)) {
i += 1;
}
if (i < 4) {
if (f->bufs[__X(i, 4)] == NIL) {
if (f->bufs[i] == NIL) {
__NEW(buf, Files_BufDesc);
buf->chg = 0;
buf->org = -1;
buf->f = f;
f->bufs[__X(i, 4)] = buf;
f->bufs[i] = buf;
} else {
buf = f->bufs[__X(i, 4)];
buf = f->bufs[i];
}
} else {
f->swapper = __MASK(f->swapper + 1, -4);
buf = f->bufs[__X(f->swapper, 4)];
buf = f->bufs[f->swapper];
Files_Flush(buf);
}
if (buf->org != org) {
@ -602,7 +585,7 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
org = 0;
offset = 0;
}
Files_Assert(offset <= 4096);
__ASSERT(offset <= 4096, 0);
(*r).buf = buf;
(*r).org = org;
(*r).offset = offset;
@ -621,9 +604,9 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
buf = (*r).buf;
offset = (*r).offset;
}
Files_Assert(offset <= buf->size);
__ASSERT(offset <= buf->size, 0);
if (offset < buf->size) {
*x = buf->data[__X(offset, 4096)];
*x = buf->data[offset];
(*r).offset = offset + 1;
} else if ((*r).org + offset < buf->f->len) {
Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset);
@ -635,12 +618,7 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
}
}
void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
{
Files_Read(&*r, r__typ, &*x);
}
void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n)
void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
{
INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
@ -666,12 +644,12 @@ void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x
} else {
min = n;
}
__MOVE((ADDRESS)&buf->data[__X(offset, 4096)], (ADDRESS)&x[__X(xpos, x__len)], min);
__MOVE((ADDRESS)buf->data + Files_ToAdr(offset), (ADDRESS)x + Files_ToAdr(xpos), min);
offset += min;
(*r).offset = offset;
xpos += min;
n -= min;
Files_Assert(offset <= 4096);
__ASSERT(offset <= 4096, 0);
}
(*r).res = 0;
(*r).eof = 0;
@ -688,14 +666,14 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
INT32 offset;
buf = (*r).buf;
offset = (*r).offset;
Files_Assert(offset <= 4096);
__ASSERT(offset <= 4096, 0);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
Files_Assert(offset < 4096);
buf->data[__X(offset, 4096)] = x;
__ASSERT(offset < 4096, 0);
buf->data[offset] = x;
buf->chg = 1;
if (offset == buf->size) {
buf->size += 1;
@ -705,7 +683,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, ADDRESS x__len, INT32 n)
void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
{
INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
@ -716,23 +694,23 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS
buf = (*r).buf;
offset = (*r).offset;
while (n > 0) {
Files_Assert(offset <= 4096);
__ASSERT(offset <= 4096, 0);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
Files_Assert(offset <= 4096);
__ASSERT(offset <= 4096, 0);
restInBuf = 4096 - offset;
if (n > restInBuf) {
min = restInBuf;
} else {
min = n;
}
__MOVE((ADDRESS)&x[__X(xpos, x__len)], (ADDRESS)&buf->data[__X(offset, 4096)], min);
__MOVE((ADDRESS)x + Files_ToAdr(xpos), (ADDRESS)buf->data + Files_ToAdr(offset), min);
offset += min;
(*r).offset = offset;
Files_Assert(offset <= 4096);
__ASSERT(offset <= 4096, 0);
if (offset > buf->size) {
buf->f->len += offset - buf->size;
buf->size = offset;
@ -744,15 +722,14 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS
(*r).res = 0;
}
void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res)
void Files_Delete (CHAR *name, LONGINT 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, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res)
void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res)
{
INT32 fdold, fdnew, n;
INT16 error, ignore;
@ -818,30 +795,31 @@ 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_Deregister(f->registerName, 256);
Files_Rename(f->workName, 256, f->registerName, 256, &errcode);
Files_Rename(f->workName, 101, f->registerName, 101, &errcode);
if (errcode != 0) {
Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode);
__COPY(f->registerName, file, 104);
__HALT(99);
}
__MOVE(f->registerName, f->workName, 256);
__COPY(f->registerName, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
}
void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res)
void Files_ChangeDirectory (CHAR *path, LONGINT 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, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len)
static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len)
{
INT32 i, j;
if (!Platform_LittleEndian) {
@ -849,7 +827,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *de
j = 0;
while (i > 0) {
i -= 1;
dest[__X(j, dest__len)] = src[__X(i, src__len)];
dest[j] = src[i];
j += 1;
}
} else {
@ -899,36 +877,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, ADDRESS x__len)
void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
INT16 i;
CHAR ch;
i = 0;
do {
Files_Read(&*R, R__typ, (void*)&ch);
x[__X(i, x__len)] = ch;
x[i] = ch;
i += 1;
} while (!(ch == 0x00));
}
void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
INT16 i;
i = 0;
do {
Files_Read(&*R, R__typ, (void*)&x[__X(i, x__len)]);
Files_Read(&*R, R__typ, (void*)&x[i]);
i += 1;
} while (!(x[__X(i - 1, x__len)] == 0x00 || x[__X(i - 1, x__len)] == 0x0a));
if (x[__X(i - 1, x__len)] == 0x0a) {
} while (!(x[i - 1] == 0x00 || x[i - 1] == 0x0a));
if (x[i - 1] == 0x0a) {
i -= 1;
}
if ((i > 0 && x[__X(i - 1, x__len)] == 0x0d)) {
if ((i > 0 && x[i - 1] == 0x0d)) {
i -= 1;
}
x[__X(i, x__len)] = 0x00;
x[i] = 0x00;
}
void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len)
void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len)
{
INT8 s, b;
INT64 q;
@ -941,7 +919,7 @@ void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__
Files_Read(&*R, R__typ, (void*)&b);
}
q += (INT64)__ASH((__MASK(b, -64) - __ASHL(__ASHR(b, 6), 6)), s);
Files_Assert(x__len <= 8);
__ASSERT(x__len <= 8, 0);
__MOVE((ADDRESS)&q, (ADDRESS)x, x__len);
}
@ -953,18 +931,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] = __CHR(x);
b[1] = __CHR(__ASHR(x, 8));
b[0] = (CHAR)x;
b[1] = (CHAR)__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] = __CHR(x);
b[1] = __CHR(__ASHR(x, 8));
b[2] = __CHR(__ASHR(x, 16));
b[3] = __CHR(__ASHR(x, 24));
b[0] = (CHAR)x;
b[1] = (CHAR)__ASHR(x, 8);
b[2] = (CHAR)__ASHR(x, 16);
b[3] = (CHAR)__ASHR(x, 24);
Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
@ -972,13 +950,11 @@ void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x)
{
CHAR b[4];
INT32 i;
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));
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);
Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
@ -996,11 +972,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, ADDRESS x__len)
void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
INT16 i;
i = 0;
while (x[__X(i, x__len)] != 0x00) {
while (x[i] != 0x00) {
i += 1;
}
Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1);
@ -1009,38 +985,17 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len
void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x)
{
while (x < -64 || x > 63) {
Files_Write(&*R, R__typ, __CHR(__MASK(x, -128) + 128));
Files_Write(&*R, R__typ, (CHAR)(__MASK(x, -128) + 128));
x = __ASHR(x, 7);
}
Files_Write(&*R, R__typ, __CHR(__MASK(x, -128)));
Files_Write(&*R, R__typ, (CHAR)__MASK(x, -128));
}
void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len)
void Files_GetName (Files_File f, CHAR *name, LONGINT 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;
@ -1049,12 +1004,12 @@ static void Files_Finalize (SYSTEM_PTR o)
if (f->fd >= 0) {
Files_CloseOSFile(f);
if (f->tempFile) {
res = Platform_Unlink((void*)f->workName, 256);
res = Platform_Unlink((void*)f->workName, 101);
}
}
}
void Files_SetSearchPath (CHAR *path, ADDRESS path__len)
void Files_SetSearchPath (CHAR *path, LONGINT path__len)
{
__DUP(path, path__len, CHAR);
if (Strings_Length(path, path__len) != 0) {
@ -1068,10 +1023,11 @@ void Files_SetSearchPath (CHAR *path, ADDRESS path__len)
static void EnumPtrs(void (*P)(void*))
{
P(Files_files);
P(Files_SearchPath);
}
__TDESC(Files_FileDesc, 1, 4) = {__TDFLDS("FileDesc", 564), {540, 544, 548, 552, -20}};
__TDESC(Files_FileDesc, 1, 5) = {__TDFLDS("FileDesc", 252), {228, 232, 236, 240, 248, -24}};
__TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4112), {0, -8}};
__TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 20), {8, -8}};
@ -1091,7 +1047,5 @@ 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;
}

35
bootstrap/unix-44/Files.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#ifndef Files__h
#define Files__h
@ -10,8 +10,9 @@ typedef
typedef
struct Files_FileDesc {
INT32 _prvt0;
char _prvt1[560];
char _prvt0[216];
INT32 fd;
char _prvt1[32];
} Files_FileDesc;
typedef
@ -22,48 +23,46 @@ 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, ADDRESS path__len, INT16 *res);
import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
import void Files_Close (Files_File f);
import void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res);
import void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res);
import void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
import void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len);
import void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
import INT32 Files_Length (Files_File f);
import Files_File Files_New (CHAR *name, ADDRESS name__len);
import Files_File Files_Old (CHAR *name, ADDRESS name__len);
import Files_File Files_New (CHAR *name, LONGINT name__len);
import Files_File Files_Old (CHAR *name, LONGINT 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_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_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT 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, ADDRESS x__len);
import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
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_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, ADDRESS x__len);
import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void Files_Register (Files_File f);
import void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res);
import void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT 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, ADDRESS path__len);
import void Files_SetSearchPath (CHAR *path, LONGINT 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, ADDRESS x__len, INT32 n);
import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT 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, ADDRESS x__len);
import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void *Files__init(void);

334
bootstrap/unix-44/Heap.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tsSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -68,10 +68,8 @@ static INT32 Heap_freeList[10];
static INT32 Heap_bigBlocks;
export INT32 Heap_allocated;
static BOOLEAN Heap_firstTry;
static INT16 Heap_ldUnit;
export INT32 Heap_heap;
static INT32 Heap_heapMin, Heap_heapMax;
export INT32 Heap_heapsize, Heap_heapMinExpand;
static INT32 Heap_heap, Heap_heapend;
export INT32 Heap_heapsize;
static Heap_FinNode Heap_fin;
static INT16 Heap_lockdepth;
static BOOLEAN Heap_interrupted;
@ -86,16 +84,15 @@ 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, ADDRESS a__len);
static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len);
export void Heap_INCREF (Heap_Module m);
export void Heap_InitHeap (void);
export void Heap_Lock (void);
static void Heap_Mark (INT32 q);
static void Heap_MarkCandidates (INT32 n, INT32 *cand, ADDRESS cand__len);
static void Heap_MarkCandidates (INT32 n, INT32 *cand, LONGINT cand__len);
static void Heap_MarkP (SYSTEM_PTR p);
static void Heap_MarkStack (INT32 n, INT32 *cand, ADDRESS cand__len);
static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len);
export SYSTEM_PTR Heap_NEWBLK (INT32 size);
export SYSTEM_PTR Heap_NEWREC (INT32 tag);
static INT32 Heap_NewChunk (INT32 blksz);
@ -104,18 +101,16 @@ 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, ADDRESS a__len);
static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len);
export void Heap_Unlock (void);
extern void *Heap__init();
extern ADDRESS Modules_MainStackFrame;
extern ADDRESS Platform_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_uLE(x, y) ((size_t)x <= (size_t)y)
#define Heap_uLT(x, y) ((size_t)x < (size_t)y)
#define Heap_PlatformMainStackFrame() Platform_MainStackFrame
void Heap_Lock (void)
{
@ -148,35 +143,6 @@ 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;
@ -204,24 +170,16 @@ void Heap_INCREF (Heap_Module m)
static INT32 Heap_NewChunk (INT32 blksz)
{
INT32 chnk, blk, end;
INT32 chnk;
chnk = Heap_OSAllocate(blksz + 12);
if (chnk != 0) {
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;
__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;
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;
}
@ -229,28 +187,29 @@ static INT32 Heap_NewChunk (INT32 blksz)
static void Heap_ExtendHeap (INT32 blksz)
{
INT32 size, chnk, j, next;
if (Heap_uLT(Heap_heapMinExpand, blksz)) {
if (blksz > 160000) {
size = blksz;
} else {
size = Heap_heapMinExpand;
size = 160000;
}
chnk = Heap_NewChunk(size);
if (chnk != 0) {
if (Heap_uLT(chnk, Heap_heap)) {
if (chnk < Heap_heap) {
__PUT(chnk, Heap_heap, INT32);
Heap_heap = chnk;
} else {
j = Heap_heap;
__GET(j, next, INT32);
while ((next != 0 && Heap_uLT(next, chnk))) {
while ((next != 0 && chnk > next)) {
j = next;
__GET(j, next, INT32);
}
__PUT(chnk, next, INT32);
__PUT(j, chnk, INT32);
}
} else if (!Heap_firstTry) {
Heap_heapMinExpand = 16;
if (next == 0) {
__GET(chnk + 4, Heap_heapend, INT32);
}
}
}
@ -260,7 +219,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
SYSTEM_PTR new;
Heap_Lock();
__GET(tag, blksz, INT32);
i0 = __LSH(blksz, -Heap_ldUnit, 32);
i0 = __ASHR(blksz, 4);
i = i0;
if (i < 9) {
adr = Heap_freeList[i];
@ -292,17 +251,16 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
if (Heap_firstTry) {
Heap_GC(1);
blksz += 16;
t = __LSH(Heap_allocated + blksz, -(2 + Heap_ldUnit), 32) * 80;
if (Heap_uLT(Heap_heapsize, t)) {
Heap_ExtendHeap(t - Heap_heapsize);
if (__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2) < Heap_heapsize) {
Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize);
}
Heap_firstTry = 0;
new = Heap_NEWREC(tag);
Heap_firstTry = 1;
if (new == NIL) {
Heap_ExtendHeap(blksz);
Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize);
new = Heap_NEWREC(tag);
}
Heap_firstTry = 1;
Heap_Unlock();
return new;
} else {
@ -311,7 +269,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
}
}
__GET(adr + 4, t, INT32);
if (Heap_uLE(blksz, t)) {
if (t >= blksz) {
break;
}
prev = adr;
@ -322,7 +280,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
__PUT(end + 4, blksz, INT32);
__PUT(end + 8, -4, INT32);
__PUT(end, end + 4, INT32);
if (Heap_uLT(144, restsize)) {
if (restsize > 144) {
__PUT(adr + 4, restsize, INT32);
} else {
__GET(adr + 12, next, INT32);
@ -331,7 +289,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);
@ -342,7 +300,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
}
i = adr + 16;
end = adr + blksz;
while (Heap_uLT(i, end)) {
while (i < end) {
__PUT(i, 0, INT32);
__PUT(i + 4, 0, INT32);
__PUT(i + 8, 0, INT32);
@ -439,17 +397,17 @@ static void Heap_Scan (void)
while (chnk != 0) {
adr = chnk + 12;
__GET(chnk + 4, end, INT32);
while (Heap_uLT(adr, end)) {
while (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 = __LSH(freesize, -Heap_ldUnit, 32);
i = __ASHR(freesize, 4);
freesize = 0;
if (Heap_uLT(i, 9)) {
if (i < 9) {
__PUT(start + 12, Heap_freeList[i], INT32);
Heap_freeList[i] = start;
} else {
@ -468,14 +426,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 = __LSH(freesize, -Heap_ldUnit, 32);
i = __ASHR(freesize, 4);
freesize = 0;
if (Heap_uLT(i, 9)) {
if (i < 9) {
__PUT(start + 12, Heap_freeList[i], INT32);
Heap_freeList[i] = start;
} else {
@ -487,19 +445,18 @@ static void Heap_Scan (void)
}
}
static void Heap_Sift (INT32 l, INT32 r, INT32 *a, ADDRESS a__len)
static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len)
{
INT32 i, j;
INT32 x;
INT32 i, j, x;
j = l;
x = a[j];
for (;;) {
i = j;
j = __ASHL(j, 1) + 1;
if ((j < r && Heap_uLT(a[j], a[j + 1]))) {
if ((j < r && a[j] < a[j + 1])) {
j += 1;
}
if (j > r || Heap_uLE(a[j], x)) {
if (j > r || a[j] <= x) {
break;
}
a[i] = a[j];
@ -507,10 +464,9 @@ static void Heap_Sift (INT32 l, INT32 r, INT32 *a, ADDRESS a__len)
a[i] = x;
}
static void Heap_HeapSort (INT32 n, INT32 *a, ADDRESS a__len)
static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len)
{
INT32 l, r;
INT32 x;
INT32 l, r, x;
l = __ASHR(n, 1);
r = n - 1;
while (l > 0) {
@ -526,42 +482,37 @@ static void Heap_HeapSort (INT32 n, INT32 *a, ADDRESS a__len)
}
}
static void Heap_MarkCandidates (INT32 n, INT32 *cand, ADDRESS cand__len)
static void Heap_MarkCandidates (INT32 n, INT32 *cand, LONGINT cand__len)
{
INT32 chnk, end, adr, tag, next, i, ptr, size;
chnk = Heap_heap;
INT32 chnk, adr, tag, next, lim, lim1, i, ptr, size;
chnk = Heap_heap;
i = 0;
while (chnk != 0) {
__GET(chnk + 4, end, INT32);
lim = cand[n - 1];
while ((chnk != 0 && chnk < lim)) {
adr = chnk + 12;
while (Heap_uLT(adr, end)) {
__GET(chnk + 4, lim1, INT32);
if (lim < lim1) {
lim1 = lim;
}
while (adr < lim1) {
__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;
adr += size;
while (Heap_uLT(cand[i], ptr)) {
while (cand[i] < ptr) {
i += 1;
if (i == n) {
return;
}
}
if (Heap_uLT(cand[i], adr)) {
if (i == n) {
return;
}
next = adr + size;
if (cand[i] < next) {
Heap_Mark(ptr);
}
}
if (Heap_uLE(end, cand[i])) {
adr = end;
adr = next;
}
}
__GET(chnk, chnk, INT32);
@ -620,11 +571,10 @@ void Heap_FINALL (void)
}
}
static void Heap_MarkStack (INT32 n, INT32 *cand, ADDRESS cand__len)
static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len)
{
SYSTEM_PTR frame;
INT32 nofcand;
INT32 inc, sp, p, stack0;
INT32 inc, nofcand, sp, p, stack0;
struct Heap__1 align;
if (n > 0) {
Heap_MarkStack(n - 1, cand, cand__len);
@ -635,14 +585,14 @@ static void Heap_MarkStack (INT32 n, INT32 *cand, ADDRESS cand__len)
if (n == 0) {
nofcand = 0;
sp = (ADDRESS)&frame;
stack0 = Heap_ModulesMainStackFrame();
stack0 = Heap_PlatformMainStackFrame();
inc = (ADDRESS)&align.p - (ADDRESS)&align;
if (Heap_uLT(stack0, sp)) {
if (sp > stack0) {
inc = -inc;
}
while (sp != stack0) {
__GET(sp, p, INT32);
if ((Heap_uLE(Heap_heapMin, p) && Heap_uLT(p, Heap_heapMax))) {
if ((p > Heap_heap && p < Heap_heapend)) {
if (nofcand == cand__len) {
Heap_HeapSort(nofcand, (void*)cand, cand__len);
Heap_MarkCandidates(nofcand, (void*)cand, cand__len);
@ -665,77 +615,79 @@ 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];
Heap_Lock();
m = (Heap_Module)(ADDRESS)Heap_modules;
while (m != NIL) {
if (m->enumPtrs != NIL) {
(*m->enumPtrs)(Heap_MarkP);
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;
}
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 (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;
}
}
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();
}
Heap_CheckFin();
Heap_Scan();
Heap_Finalize();
Heap_Unlock();
}
void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
@ -751,21 +703,17 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
void Heap_InitHeap (void)
{
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);
__GET(Heap_heap + 4, Heap_heapend, INT32);
__PUT(Heap_heap, 0, INT32);
Heap_allocated = 0;
Heap_firstTry = 1;
Heap_freeList[9] = 1;
Heap_lockdepth = 0;
Heap_FileCount = 0;
Heap_modules = NIL;
Heap_heapsize = 0;
Heap_bigBlocks = 0;
Heap_fin = NIL;
Heap_interrupted = 0;
Heap_HeapModuleInit();

33
bootstrap/unix-44/Heap.h
View file

@ -1,26 +1,16 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tsSF */
#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));
@ -31,31 +21,22 @@ typedef
struct Heap_ModuleDesc *Heap_Module;
typedef
CHAR Heap_ModuleName[20];
struct Heap_ModuleDesc {
INT32 _prvt0;
char _prvt1[44];
} Heap_ModuleDesc;
typedef
struct Heap_ModuleDesc {
Heap_Module next;
Heap_ModuleName name;
INT32 refcnt;
Heap_Cmd cmds;
INT32 types;
Heap_EnumProc enumPtrs;
char _prvt0[8];
} Heap_ModuleDesc;
CHAR Heap_ModuleName[20];
import SYSTEM_PTR Heap_modules;
import INT32 Heap_allocated;
import INT32 Heap_heap;
import INT32 Heap_heapsize, Heap_heapMinExpand;
import INT32 Heap_allocated, Heap_heapsize;
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);

380
bootstrap/unix-44/Modules.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -9,303 +9,81 @@
#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 Heap_ModuleName Modules_imported, Modules_importing;
export INT32 Modules_MainStackFrame;
export INT16 Modules_ArgCount;
export INT32 Modules_ArgVector;
export CHAR Modules_BinaryDir[1024];
export Modules_ModuleName Modules_imported, Modules_importing;
export ADDRESS *Modules_ModuleDesc__typ;
export ADDRESS *Modules_CmdDesc__typ;
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);
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__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);
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_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
export void Modules_Halt (INT32 code);
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);
export Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
export Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
static void Modules_errch (CHAR c);
static void Modules_errint (INT32 l);
static void Modules_errstring (CHAR *s, ADDRESS s__len);
static void Modules_errstring (CHAR *s, LONGINT s__len);
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
#define Modules_modules() (Modules_Module)Heap_modules
#define Modules_setmodules(m) Heap_modules = m
void Modules_Init (INT32 argc, INT32 argvadr)
{
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;
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;
}
__DEL(s);
return i;
}
static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len)
{
INT16 i, j;
__DUP(s, s__len, CHAR);
__DUP(b, b__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;
}
d[__X(j, d__len)] = 0x00;
__DEL(s);
}
static void Modules_AppendPart (CHAR c, 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);
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)) {
while (a[__X(i, a__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;
while (b[__X(j, b__len)] != 0x00) {
a[__X(i, a__len)] = b[__X(j, b__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);
a[__X(i, a__len)] = 0x00;
__DEL(b);
}
static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__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;
Modules_Module m = NIL;
CHAR bodyname[64];
Heap_Command body;
Modules_Command body;
__DUP(name, name__len, CHAR);
m = Modules_modules();
while ((m != NIL && __STRCMP(m->name, name) != 0)) {
@ -318,16 +96,16 @@ Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len)
Modules_res = 1;
__COPY(name, Modules_importing, 20);
__MOVE(" module \"", Modules_resMsg, 10);
Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
Modules_Append((void*)Modules_resMsg, 256, name, name__len);
Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
}
__DEL(name);
return m;
}
Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len)
Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len)
{
Heap_Cmd c = NIL;
Modules_Cmd c = NIL;
__DUP(name, name__len, CHAR);
c = mod->cmds;
while ((c != NIL && __STRCMP(c->name, name) != 0)) {
@ -342,36 +120,43 @@ Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len
Modules_res = 2;
__MOVE(" command \"", Modules_resMsg, 11);
__COPY(name, Modules_importing, 20);
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);
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);
__DEL(name);
return NIL;
}
__RETCHK;
}
void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all)
void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all)
{
Heap_Module m = NIL, p = NIL;
INT32 refcount;
Modules_Module m = NIL, p = NIL;
__DUP(name, name__len, CHAR);
m = Modules_modules();
if (all) {
Modules_res = 1;
__MOVE("unloading \"all\" not yet supported", Modules_resMsg, 34);
} else {
refcount = Heap_FreeModule(name, name__len);
if (refcount == 0) {
while ((m != NIL && __STRCMP(m->name, name) != 0)) {
p = m;
m = m->next;
}
if ((m != NIL && m->refcnt == 0)) {
if (m == Modules_modules()) {
Modules_setmodules(m->next);
} else {
p->next = m->next;
}
Modules_res = 0;
} else {
if (refcount < 0) {
Modules_res = 1;
if (m == NIL) {
__MOVE("module not found", Modules_resMsg, 17);
} else {
__MOVE("clients of this module exist", Modules_resMsg, 29);
}
Modules_res = 1;
}
}
__DEL(name);
@ -383,7 +168,7 @@ static void Modules_errch (CHAR c)
e = Platform_Write(1, (ADDRESS)&c, 1);
}
static void Modules_errstring (CHAR *s, ADDRESS s__len)
static void Modules_errstring (CHAR *s, LONGINT s__len)
{
INT32 i;
__DUP(s, s__len, CHAR);
@ -404,7 +189,7 @@ static void Modules_errint (INT32 l)
if (l >= 10) {
Modules_errint(__DIV(l, 10));
}
Modules_errch(__CHR((int)__MOD(l, 10) + 48));
Modules_errch((CHAR)((int)__MOD(l, 10) + 48));
}
static void Modules_DisplayHaltCode (INT32 code)
@ -465,7 +250,6 @@ 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);
@ -478,7 +262,6 @@ 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);
@ -486,13 +269,11 @@ void Modules_AssertFail (INT32 code)
Modules_errstring((CHAR*)".", 2);
}
Modules_errstring(Platform_NL, 3);
if (code > 0) {
Platform_Exit(code);
} else {
Platform_Exit(-1);
}
Platform_Exit(code);
}
__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)
{
@ -500,7 +281,8 @@ 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;
}

51
bootstrap/unix-44/Modules.h
View file

@ -1,30 +1,53 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Modules__h
#define Modules__h
#include "SYSTEM.h"
#include "Heap.h"
typedef
struct Modules_CmdDesc *Modules_Cmd;
typedef
void (*Modules_Command)(void);
typedef
struct Modules_CmdDesc {
Modules_Cmd next;
CHAR name[24];
Modules_Command cmd;
} Modules_CmdDesc;
typedef
struct Modules_ModuleDesc *Modules_Module;
typedef
CHAR Modules_ModuleName[20];
typedef
struct Modules_ModuleDesc {
Modules_Module next;
Modules_ModuleName name;
INT32 refcnt;
Modules_Cmd cmds;
INT32 types;
void (*enumPtrs)(void(*)(INT32));
char _prvt0[8];
} Modules_ModuleDesc;
import INT16 Modules_res;
import CHAR Modules_resMsg[256];
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 Modules_ModuleName Modules_imported, Modules_importing;
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, 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_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
import void Modules_Halt (INT32 code);
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 Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
import Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
import void *Modules__init(void);

43
bootstrap/unix-44/OPB.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#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();
__MOVE(str, *x->conval->ext, 256);
__COPY(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 = __CHR(n->conval->intval);
ch = (CHAR)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 == (-9223372036854775807LL-1)) {
if (z->conval->intval == (-9223372036854775807-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 == (-9223372036854775807LL-1)) {
if (z->conval->intval == (-9223372036854775807-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(__CHR(z->conval->intval));
z->conval->intval = (INT16)__CAP((CHAR)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(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))) {
if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807-1))) && yv != (-9223372036854775807-1))) && -xv <= __DIV(9223372036854775807, -yv))) {
xval->intval = xv * yv;
OPB_SetIntType(x);
} else {
@ -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 <= 9223372036854775807LL - yval->intval);
if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807LL-1) - yval->intval)) {
temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807 - yval->intval);
if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807-1) - yval->intval)) {
xval->intval += yval->intval;
OPB_SetIntType(x);
} else {
@ -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 >= (-9223372036854775807LL-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807LL + yval->intval)) {
if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807 + yval->intval)) {
xval->intval -= yval->intval;
OPB_SetIntType(x);
} else {
@ -1136,7 +1136,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
OPB_err(203);
r = (LONGREAL)1;
}
(*x)->conval->intval = __SHORT(__ENTIER(r), 2147483648LL);
(*x)->conval->intval = (INT32)__ENTIER(r);
OPB_SetIntType(*x);
}
}
@ -1624,20 +1624,23 @@ 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) {
@ -2088,7 +2091,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(9223372036854775807LL, (INT64)__ASH(1, x->conval->intval))) {
if (__ABS(p->conval->intval) <= __DIV(9223372036854775807, (INT64)__ASH(1, x->conval->intval))) {
p->conval->intval = p->conval->intval * (INT64)__ASH(1, x->conval->intval);
} else {
OPB_err(208);
@ -2533,6 +2536,7 @@ 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);
}
@ -2558,8 +2562,13 @@ 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 = 0;
(*x)->subcl = subcl;
}
void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ)
@ -2586,7 +2595,7 @@ export void *OPB__init(void)
__MODULE_IMPORT(OPT);
__REGMOD("OPB", 0);
/* BEGIN */
OPB_maxExp = OPB_log(4611686018427387904LL);
OPB_maxExp = OPB_log(4611686018427387904);
OPB_maxExp = OPB_exp;
__ENDMOD;
}

2
bootstrap/unix-44/OPB.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPB__h
#define OPB__h

127
bootstrap/unix-44/OPC.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#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, ADDRESS name__len);
static void OPC_Include (CHAR *name, LONGINT 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, ADDRESS s__len);
static INT16 OPC_Length (CHAR *s, LONGINT s__len);
export BOOLEAN OPC_NeedsRetval (OPT_Object proc);
export INT32 OPC_NofPtrs (OPT_Struct typ);
static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len);
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len);
static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len);
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len);
static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define);
static void OPC_ProcPredefs (OPT_Object obj, 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, ADDRESS s__len, INT32 x);
static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l);
static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x);
static void OPC_StringLiteral (CHAR *s, LONGINT 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, ADDRESS s__len, INT32 x)
static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
{
CHAR ch;
INT16 i;
@ -156,7 +156,7 @@ static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x)
__DEL(s);
}
static INT16 OPC_Length (CHAR *s, ADDRESS s__len)
static INT16 OPC_Length (CHAR *s, LONGINT s__len)
{
INT16 i;
i = 0;
@ -166,7 +166,7 @@ static INT16 OPC_Length (CHAR *s, ADDRESS s__len)
return i;
}
static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len)
static INT16 OPC_PerfectHash (CHAR *s, LONGINT 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*)"ADDRESS len[#]", 15, nofdims);
OPC_Str1((CHAR*)"LONGINT 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*)", ADDRESS ", 11);
OPM_WriteString((CHAR*)", LONGINT ", 11);
} else {
OPM_WriteString((CHAR*)", ", 3);
}
@ -618,33 +618,31 @@ 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))) {
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);
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);
OPM_Write(')');
OPM_WriteLn();
} 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(')');
OPM_WriteLn();
}
OPC_DefineTProcMacros(obj->right, &*empty);
}
@ -654,7 +652,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) || (((OPM_currFile == 0 && str->strobj != NIL)) && str->strobj->vis == 1)) {
if (OPM_currFile == 1 || str->ref < 255) {
obj = str->strobj;
if (obj == NIL || OPC_Undefined(obj)) {
if (obj != NIL) {
@ -683,10 +681,6 @@ 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) {
@ -721,19 +715,12 @@ 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, ADDRESS y__len)
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len)
{
INT16 i;
__DUP(y, y__len, CHAR);
@ -981,8 +968,8 @@ static void OPC_IdentList (OPT_Object obj, INT16 vis)
if (obj->typ->comp == 3) {
OPC_EndStat();
OPC_BegStat();
base = OPT_adrtyp;
OPM_WriteString((CHAR*)"ADDRESS ", 9);
base = OPT_linttyp;
OPM_WriteString((CHAR*)"LONGINT ", 9);
OPC_LenList(obj, 0, 1);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPC_EndStat();
@ -1021,7 +1008,7 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
__COPY(name, obj->name, 256);
}
if (obj->typ->comp == 3) {
OPM_WriteString((CHAR*)", ADDRESS ", 11);
OPM_WriteString((CHAR*)", LONGINT ", 11);
OPC_LenList(obj, 1, showParamNames);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPM_WriteString((CHAR*)", ADDRESS *", 12);
@ -1075,7 +1062,7 @@ static void OPC_ProcPredefs (OPT_Object obj, INT8 vis)
}
}
static void OPC_Include (CHAR *name, ADDRESS name__len)
static void OPC_Include (CHAR *name, LONGINT name__len)
{
__DUP(name, name__len, CHAR);
OPM_WriteString((CHAR*)"#include ", 10);
@ -1151,7 +1138,7 @@ static void OPC_GenHeaderMsg (void)
OPM_WriteString((CHAR*)"/* ", 4);
OPM_WriteString((CHAR*)"voc", 4);
OPM_Write(' ');
OPM_WriteString(Configuration_versionLong, 76);
OPM_WriteString(Configuration_versionLong, 75);
OPM_Write(' ');
i = 0;
while (i <= 31) {
@ -1672,9 +1659,9 @@ void OPC_CompleteIdent (OPT_Object obj)
OPC_Ident(obj);
OPM_WriteString((CHAR*)"__", 3);
} else {
OPM_WriteString((CHAR*)"(*(", 4);
OPM_WriteString((CHAR*)"((", 3);
OPC_Ident(obj->typ->strobj);
OPM_WriteString((CHAR*)"*)&", 4);
OPM_Write(')');
OPC_Ident(obj);
OPM_Write(')');
}
@ -1752,12 +1739,12 @@ static void OPC_CharacterLiteral (INT64 c)
if ((c == 92 || c == 39) || c == 63) {
OPM_Write('\\');
}
OPM_Write(__CHR(c));
OPM_Write((CHAR)c);
OPM_Write('\'');
}
}
static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l)
{
INT32 i;
INT16 c;
@ -1768,16 +1755,16 @@ static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
c = (INT16)s[__X(i, s__len)];
if (c < 32 || c > 126) {
OPM_Write('\\');
OPM_Write(__CHR(48 + __ASHR(c, 6)));
OPM_Write((CHAR)(48 + __ASHR(c, 6)));
c = __MASK(c, -64);
OPM_Write(__CHR(48 + __ASHR(c, 3)));
OPM_Write((CHAR)(48 + __ASHR(c, 3)));
c = __MASK(c, -8);
OPM_Write(__CHR(48 + c));
OPM_Write((CHAR)(48 + c));
} else {
if ((c == 92 || c == 34) || c == 63) {
OPM_Write('\\');
}
OPM_Write(__CHR(c));
OPM_Write((CHAR)c);
}
i += 1;
}
@ -1843,12 +1830,6 @@ 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);
@ -1856,6 +1837,10 @@ 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);
}
}
@ -1927,9 +1912,9 @@ static struct InitKeywords__46 {
struct InitKeywords__46 *lnk;
} *InitKeywords__46_s;
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)
static void Enter__47 (CHAR *s, LONGINT s__len)
{
INT16 h;
__DUP(s, s__len, CHAR);

2
bootstrap/unix-44/OPC.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPC__h
#define OPC__h

330
bootstrap/unix-44/OPM.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -8,7 +8,6 @@
#include "SYSTEM.h"
#include "Configuration.h"
#include "Files.h"
#include "Modules.h"
#include "Out.h"
#include "Platform.h"
#include "Strings.h"
@ -19,8 +18,6 @@ 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];
@ -29,7 +26,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, OPM_SetSize;
export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize;
export INT64 OPM_MaxIndex;
export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
export BOOLEAN OPM_noerr;
@ -44,48 +41,41 @@ 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_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
export void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
export void OPM_DeleteNewSym (void);
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, ADDRESS bytes__len);
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len);
export void OPM_Get (CHAR *ch);
export void OPM_GetComment (CHAR *text, ADDRESS text__len);
export void OPM_Init (BOOLEAN *done);
export void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
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, ADDRESS vt100code__len);
export void OPM_LogVT100 (CHAR *vt100code, LONGINT 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, ADDRESS s__len);
export void OPM_LogWStr (CHAR *s, LONGINT s__len);
export INT32 OPM_Longint (INT64 n);
static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len);
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len);
export void OPM_Mark (INT16 n, INT32 pos);
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 void OPM_NewSym (CHAR *modName, LONGINT modName__len);
export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
export BOOLEAN OPM_OpenPar (void);
export void OPM_RegisterNewSym (void);
static void OPM_ScanOptions (CHAR *s, ADDRESS s__len);
static void OPM_ScanOptions (CHAR *s, LONGINT 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);
@ -97,13 +87,14 @@ 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, ADDRESS s__len);
export void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
export void OPM_WriteString (CHAR *s, LONGINT s__len);
export void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
export BOOLEAN OPM_eofSF (void);
export void OPM_err (INT16 n);
@ -114,7 +105,7 @@ void OPM_LogW (CHAR ch)
Out_Char(ch);
}
void OPM_LogWStr (CHAR *s, ADDRESS s__len)
void OPM_LogWStr (CHAR *s, LONGINT s__len)
{
__DUP(s, s__len, CHAR);
Out_String(s, s__len);
@ -131,7 +122,7 @@ void OPM_LogWLn (void)
Out_Ln();
}
void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len)
void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
{
__DUP(vt100code, vt100code__len, CHAR);
if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) {
@ -140,57 +131,6 @@ void OPM_LogVT100 (CHAR *vt100code, ADDRESS 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;
@ -214,7 +154,7 @@ INT16 OPM_Integer (INT64 n)
return __VAL(INT16, n);
}
static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
@ -287,6 +227,29 @@ static void OPM_ScanOptions (CHAR *s, ADDRESS 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('-');
@ -303,19 +266,16 @@ static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
BOOLEAN OPM_OpenPar (void)
{
CHAR s[256];
if (Modules_ArgCount == 1) {
if (Platform_ArgCount == 1) {
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20);
OPM_LogWStr(Configuration_versionLong, 76);
OPM_LogWStr(Configuration_versionLong, 75);
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();
@ -372,7 +332,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 and SET, 64 bit LONGINT.", 95);
OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
OPM_LogWLn();
@ -402,38 +362,64 @@ BOOLEAN OPM_OpenPar (void)
OPM_Options = 0xa9;
OPM_S = 1;
s[0] = 0x00;
Modules_GetArg(OPM_S, (void*)s, 256);
Platform_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
Modules_GetArg(OPM_S, (void*)s, 256);
Platform_GetArg(OPM_S, (void*)s, 256);
}
OPM_GlobalAddressSize = OPM_AddressSize;
OPM_GlobalAlignment = OPM_Alignment;
__MOVE(OPM_Model, OPM_GlobalModel, 10);
__COPY(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;
__MOVE(OPM_GlobalModel, OPM_Model, 10);
__COPY(OPM_GlobalModel, OPM_Model, 10);
OPM_Alignment = OPM_GlobalAlignment;
OPM_AddressSize = OPM_GlobalAddressSize;
s[0] = 0x00;
Modules_GetArg(OPM_S, (void*)s, 256);
Platform_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
Modules_GetArg(OPM_S, (void*)s, 256);
Platform_GetArg(OPM_S, (void*)s, 256);
}
if (__IN(15, OPM_Options, 32)) {
OPM_Options |= __SETOF(10,32);
@ -444,32 +430,29 @@ void OPM_InitOptions (void)
OPM_ShortintSize = 1;
OPM_IntegerSize = 2;
OPM_LongintSize = 4;
OPM_SetSize = 4;
break;
case 'C':
OPM_ShortintSize = 2;
OPM_IntegerSize = 4;
OPM_LongintSize = 8;
OPM_SetSize = 4;
break;
case 'V':
OPM_ShortintSize = 1;
OPM_IntegerSize = 4;
OPM_LongintSize = 8;
OPM_SetSize = 8;
break;
default:
OPM_ShortintSize = 1;
OPM_IntegerSize = 2;
OPM_LongintSize = 4;
OPM_SetSize = 4;
break;
}
__MOVE(OPM_InstallDir, OPM_ResourceDir, 1024);
if (OPM_ResourceDir[0] != 0x00) {
Strings_Append((CHAR*)"/", 2, (void*)OPM_ResourceDir, 1024);
Strings_Append(OPM_Model, 10, (void*)OPM_ResourceDir, 1024);
if (__IN(18, OPM_Options, 32)) {
OPM_VerboseListSizes();
}
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);
@ -482,22 +465,23 @@ void OPM_InitOptions (void)
Files_SetSearchPath(searchpath, 1024);
}
void OPM_Init (BOOLEAN *done)
void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
{
Texts_Text T = NIL;
INT32 beg, end, time;
CHAR s[256];
*done = 0;
OPM_curpos = 0;
if (OPM_S >= Modules_ArgCount) {
if (OPM_S >= Platform_ArgCount) {
return;
}
s[0] = 0x00;
Modules_GetArg(OPM_S, (void*)s, 256);
Platform_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);
@ -519,14 +503,18 @@ void OPM_Init (BOOLEAN *done)
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, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len)
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len)
{
INT16 i, j;
CHAR ch;
@ -644,7 +632,7 @@ static void OPM_ShowLine (INT64 pos)
if (pos >= (INT64)OPM_ErrorLineLimitPos) {
pos = OPM_ErrorLineLimitPos - 1;
}
i = __SHORTF(OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos), 32768);
i = (INT16)OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos);
while (i > 0) {
OPM_LogW(' ');
i -= 1;
@ -652,6 +640,7 @@ 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)
@ -711,7 +700,7 @@ void OPM_err (INT16 n)
OPM_Mark(n, OPM_errpos);
}
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len)
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len)
{
INT16 i;
INT32 l;
@ -783,13 +772,10 @@ void OPM_CloseOldSym (void)
Files_Close(Files_Base(&OPM_oldSF, Files_Rider__typ));
}
void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done)
void OPM_OldSym (CHAR *modName, LONGINT 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;
@ -797,10 +783,8 @@ void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done)
Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, 0);
Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&tag);
Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ver);
if (tag != 0xf7 || ver != 0x84) {
if (!__IN(4, OPM_Options, 32)) {
OPM_err(-306);
}
if (tag != 0xf7 || ver != 0x82) {
OPM_err(-306);
OPM_CloseOldSym();
*done = 0;
}
@ -844,23 +828,11 @@ void OPM_RegisterNewSym (void)
}
}
void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len)
void OPM_DeleteNewSym (void)
{
OPM_FileName fn;
INT16 res;
OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".sym", 5);
Files_Delete(fn, 32, &res);
}
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)
void OPM_NewSym (CHAR *modName, LONGINT modName__len)
{
OPM_FileName fileName;
OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
@ -868,7 +840,7 @@ void OPM_NewSym (CHAR *modName, ADDRESS modName__len)
if (OPM_newSFile != NIL) {
Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, 0);
Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7);
Files_Write(&OPM_newSF, Files_Rider__typ, 0x84);
Files_Write(&OPM_newSF, Files_Rider__typ, 0x82);
} else {
OPM_err(153);
}
@ -879,7 +851,7 @@ void OPM_Write (CHAR ch)
Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, ch);
}
void OPM_WriteString (CHAR *s, ADDRESS s__len)
void OPM_WriteString (CHAR *s, LONGINT s__len)
{
INT16 i;
i = 0;
@ -889,7 +861,7 @@ void OPM_WriteString (CHAR *s, ADDRESS s__len)
Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}
void OPM_WriteStringVar (CHAR *s, ADDRESS s__len)
void OPM_WriteStringVar (CHAR *s, LONGINT s__len)
{
INT16 i;
i = 0;
@ -903,17 +875,17 @@ void OPM_WriteHex (INT64 i)
{
CHAR s[3];
INT32 digit;
digit = __ASHR(__SHORT(i, 2147483648LL), 4);
digit = __ASHR((INT32)i, 4);
if (digit < 10) {
s[0] = __CHR(48 + digit);
s[0] = (CHAR)(48 + digit);
} else {
s[0] = __CHR(87 + digit);
s[0] = (CHAR)(87 + digit);
}
digit = __MASK(__SHORT(i, 2147483648LL), -16);
digit = __MASK((INT32)i, -16);
if (digit < 10) {
s[1] = __CHR(48 + digit);
s[1] = (CHAR)(48 + digit);
} else {
s[1] = __CHR(87 + digit);
s[1] = (CHAR)(87 + digit);
}
s[2] = 0x00;
OPM_WriteString(s, 3);
@ -921,7 +893,7 @@ void OPM_WriteHex (INT64 i)
void OPM_WriteInt (INT64 i)
{
CHAR s[26];
CHAR s[24];
INT64 i1, k;
if ((i == OPM_SignedMinimum(2) || i == OPM_SignedMinimum(4)) || i == OPM_SignedMinimum(8)) {
OPM_Write('(');
@ -929,27 +901,21 @@ void OPM_WriteInt (INT64 i)
OPM_WriteString((CHAR*)"-1)", 4);
} else {
i1 = __ABS(i);
if (i1 <= 2147483647) {
k = 0;
} else {
__MOVE("LL", s, 3);
k = 2;
}
s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
s[0] = (CHAR)(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k += 1;
k = 1;
while (i1 > 0) {
s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
s[__X(k, 24)] = (CHAR)(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k += 1;
}
if (i < 0) {
s[__X(k, 26)] = '-';
s[__X(k, 24)] = '-';
k += 1;
}
while (k > 0) {
k -= 1;
OPM_Write(s[__X(k, 26)]);
OPM_Write(s[__X(k, 24)]);
}
}
}
@ -962,13 +928,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 == (__SHORT(__ENTIER(r), 2147483648LL)))) {
if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == ((INT32)__ENTIER(r)))) {
if (suffx == 'f') {
OPM_WriteString((CHAR*)"(REAL)", 7);
} else {
OPM_WriteString((CHAR*)"(LONGREAL)", 11);
}
OPM_WriteInt(__SHORT(__ENTIER(r), 2147483648LL));
OPM_WriteInt((INT32)__ENTIER(r));
} else {
Texts_OpenWriter(&W, Texts_Writer__typ);
if (suffx == 'f') {
@ -1020,9 +986,9 @@ static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F)
}
}
void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len)
void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
{
OPM_FileName FName;
CHAR FName[32];
__COPY(moduleName, OPM_modName, 32);
OPM_HFile = Files_New((CHAR*)"", 1);
if (OPM_HFile != NIL) {
@ -1048,7 +1014,7 @@ void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len)
void OPM_CloseFiles (void)
{
OPM_FileName FName;
CHAR FName[32];
INT16 res;
if (OPM_noerr) {
OPM_LogWStr((CHAR*)" ", 3);
@ -1084,59 +1050,6 @@ 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);
@ -1158,7 +1071,6 @@ export void *OPM__init(void)
__DEFMOD;
__MODULE_IMPORT(Configuration);
__MODULE_IMPORT(Files);
__MODULE_IMPORT(Modules);
__MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
@ -1167,6 +1079,7 @@ 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);
@ -1176,8 +1089,5 @@ 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;
}

27
bootstrap/unix-44/OPM.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#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, OPM_SetSize;
import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize;
import INT64 OPM_MaxIndex;
import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
import BOOLEAN OPM_noerr;
@ -17,39 +17,34 @@ 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_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
import void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
import void OPM_DeleteNewSym (void);
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_GetComment (CHAR *text, ADDRESS text__len);
import void OPM_Init (BOOLEAN *done);
import void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
import void OPM_InitOptions (void);
import INT16 OPM_Integer (INT64 n);
import void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len);
import void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len);
import void OPM_LogVT100 (CHAR *vt100code, LONGINT 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, ADDRESS s__len);
import void OPM_LogWStr (CHAR *s, LONGINT s__len);
import INT32 OPM_Longint (INT64 n);
import void OPM_Mark (INT16 n, INT32 pos);
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 void OPM_NewSym (CHAR *modName, LONGINT modName__len);
import void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
import void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
import BOOLEAN OPM_OpenPar (void);
import void OPM_RegisterNewSym (void);
import 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);
@ -66,8 +61,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, ADDRESS s__len);
import void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
import void OPM_WriteString (CHAR *s, LONGINT s__len);
import void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
import BOOLEAN OPM_eofSF (void);
import void OPM_err (INT16 n);
import void *OPM__init(void);

43
bootstrap/unix-44/OPP.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#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) {
__MOVE(OPS_name, name, 256);
__COPY(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 = __SHORT(__SHORT((*x)->obj->adr, 32768), 128);
m = (INT8)((INT16)(*x)->obj->adr);
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;
}
__MOVE(OPS_name, name, 256);
__COPY(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] = __CHR(n);
(*ext)[0] = (CHAR)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)] = __CHR(c);
(*ext)[__X(n, 256)] = (CHAR)c;
}
if (OPP_sym == 19) {
OPS_Get(&OPP_sym);
} else if (OPP_sym == 35) {
OPP_err(19);
} else {
(*ext)[0] = __CHR(n);
(*ext)[0] = (CHAR)n;
break;
}
}
@ -1030,7 +1030,7 @@ static void TProcDecl__23 (void)
}
OPP_Receiver(&objMode, objName, &objTyp, &recTyp);
if (OPP_sym == 38) {
__MOVE(OPS_name, *ProcedureDeclaration__16_s->name, 256);
__COPY(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);
__MOVE(OPS_name, name, 256);
__COPY(OPS_name, name, 256);
OPP_CheckMark(&vis);
if ((vis != 0 && mode == 6)) {
mode = 7;
@ -1665,9 +1665,6 @@ 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) {
@ -1793,10 +1790,30 @@ 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_LogCompiling(OPS_name, 256);
OPM_LogWStr((CHAR*)"compiling ", 11);
OPM_LogWStr(OPS_name, 256);
OPM_LogW('.');
OPT_Init(OPS_name, opt);
OPS_Get(&OPP_sym);
OPP_CheckSym(39);

2
bootstrap/unix-44/OPP.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPP__h
#define OPP__h

100
bootstrap/unix-44/OPS.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -56,11 +56,11 @@ static void OPS_Str (INT8 *sym)
OPS_err(241);
break;
}
OPS_str[__X(i, 256)] = OPS_ch;
OPS_str[i] = OPS_ch;
i += 1;
}
OPM_Get(&OPS_ch);
OPS_str[__X(i, 256)] = 0x00;
OPS_str[i] = 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[__X(i, 256)] = OPS_ch;
OPS_name[i] = OPS_ch;
i += 1;
OPM_Get(&OPS_ch);
} while (!(((OPS_ch < '0' || ('9' < OPS_ch && __CAP(OPS_ch) < 'A')) || 'Z' < __CAP(OPS_ch)) || i == 256));
@ -84,7 +84,7 @@ static void OPS_Identifier (INT8 *sym)
OPS_err(240);
i -= 1;
}
OPS_name[__X(i, 256)] = 0x00;
OPS_name[i] = 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[__X(n, 24)] = OPS_ch;
dig[n] = 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[__X(i, 24)], 1);
OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 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[__X(i, 24)], 1);
OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1);
i += 1;
}
} else {
@ -196,9 +196,9 @@ static void OPS_Number (void)
} else {
OPS_numtyp = 2;
while (i < n) {
d = Ord__7(dig[__X(i, 24)], 0);
d = Ord__7(dig[i], 0);
i += 1;
if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) {
if (OPS_intval <= __DIV(9223372036854775807 - (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[__X(n, 24)], 0) + f) / (LONGREAL)(LONGREAL)10;
f = (Ord__7(dig[n], 0) + f) / (LONGREAL)(LONGREAL)10;
}
if (OPS_ch == 'E' || OPS_ch == 'D') {
expCh = OPS_ch;
@ -279,74 +279,32 @@ 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);
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) {
for (;;) {
for (;;) {
while (OPS_ch == '(') {
OPM_Get(&OPS_ch);
} else {
prevCh = 0x00;
}
} else {
if ((((isExported && nestLevel == 1)) && prevCh != 0x00)) {
if (i < 255) {
commentText[__X(i, 256)] = prevCh;
i += 1;
if (OPS_ch == '*') {
Comment__2();
}
}
prevCh = OPS_ch;
}
if (nestLevel > 0) {
if (OPS_ch == '*') {
OPM_Get(&OPS_ch);
break;
}
if (OPS_ch == 0x00) {
break;
}
OPM_Get(&OPS_ch);
}
}
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 == ')') {
OPM_Get(&OPS_ch);
break;
}
}
if (isExported) {
if (i >= 256) {
OPM_LogWStr((CHAR*)"Warning: commentText overflow", 30);
OPM_LogWLn();
i = 255;
if (OPS_ch == 0x00) {
OPS_err(5);
break;
}
commentText[__X(i, 256)] = 0x00;
OPM_StoreComment(commentText, 256);
}
}

2
bootstrap/unix-44/OPS.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#ifndef OPS__h
#define OPS__h

195
bootstrap/unix-44/OPT.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -49,15 +49,6 @@ 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;
@ -83,7 +74,6 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@ -111,7 +101,6 @@ 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;
@ -119,7 +108,6 @@ 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);
@ -132,7 +120,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, ADDRESS name__len);
static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT 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);
@ -143,9 +131,8 @@ 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, ADDRESS name__len);
static void OPT_InName (CHAR *name, LONGINT 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);
@ -167,14 +154,12 @@ 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, ADDRESS name__len);
static void OPT_OutName (CHAR *name, LONGINT name__len);
static void OPT_OutObj (OPT_Object obj);
static void OPT_OutSign (OPT_Struct result, OPT_Object par);
static void OPT_OutStr (OPT_Struct typ);
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj);
static void OPT_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);
@ -354,7 +339,7 @@ void OPT_TypSize (OPT_Struct typ)
}
typ->size = offset;
typ->align = base;
typ->sysflag = __MASK(typ->sysflag, -256) + __SHORT(__ASHL(offset - off0, 8), 32768);
typ->sysflag = __MASK(typ->sysflag, -256) + (INT16)__ASHL(offset - off0, 8);
} else if (c == 2) {
OPT_TypSize(typ->BaseTyp);
typ->size = typ->n * typ->BaseTyp->size;
@ -390,10 +375,6 @@ 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;
}
@ -453,16 +434,14 @@ void OPT_Init (OPS_Name name, UINT32 opt)
OPT_topScope = OPT_universe;
OPT_OpenScope(0, NIL);
OPT_SYSimported = 0;
__MOVE(name, OPT_SelfName, 256);
__MOVE(name, OPT_topScope->name, 256);
__COPY(name, OPT_SelfName, 256);
__COPY(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)
@ -560,8 +539,6 @@ 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;
@ -593,23 +570,13 @@ 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, ADDRESS name__len)
static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len)
{
INT16 i;
CHAR ch;
@ -990,7 +957,7 @@ void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old)
}
}
static void OPT_InName (CHAR *name, ADDRESS name__len)
static void OPT_InName (CHAR *name, LONGINT name__len)
{
INT16 i;
CHAR ch;
@ -1044,26 +1011,6 @@ 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;
@ -1121,13 +1068,6 @@ 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) {
@ -1246,7 +1186,7 @@ static void OPT_InStruct (OPT_Struct *typ)
}
*typ = OPT_NewStr(0, 1);
} else {
__MOVE(name, obj->name, 256);
__COPY(name, obj->name, 256);
OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
if (old != NIL) {
OPT_FPrintObj(old);
@ -1276,7 +1216,7 @@ static void OPT_InStruct (OPT_Struct *typ)
obj->vis = 0;
tag = OPM_SymRInt();
if (tag == 35) {
(*typ)->sysflag = __SHORTF(OPM_SymRInt(), 32768);
(*typ)->sysflag = (INT16)OPM_SymRInt();
tag = OPM_SymRInt();
}
switch (tag) {
@ -1406,37 +1346,7 @@ 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;
@ -1452,7 +1362,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 && tag <= 33)) {
} else if (tag >= 31) {
obj->conval = OPT_NewConst();
obj->conval->intval = -1;
OPT_InSign(mno, &obj->typ, &obj->link);
@ -1467,8 +1377,8 @@ static OPT_Object OPT_InObj (INT8 mno)
obj->mode = 9;
ext = OPT_NewExt();
obj->conval->ext = ext;
s = __SHORTF(OPM_SymRInt(), 32768);
(*ext)[0] = __CHR(s);
s = (INT16)OPM_SymRInt();
(*ext)[0] = (CHAR)s;
i = 1;
while (i <= s) {
OPM_SymRCh(&(*ext)[__X(i, 256)]);
@ -1479,37 +1389,20 @@ 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 if (tag == 21 || tag == 22) {
} else {
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);
@ -1565,15 +1458,9 @@ 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;
if ((OPT_impCtxt.self && __IN(17, OPM_Options, 32))) {
OPM_DeleteSym((void*)name, 256);
*done = 0;
} else {
OPM_OldSym((void*)name, 256, &*done);
}
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);
@ -1596,7 +1483,7 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
}
}
static void OPT_OutName (CHAR *name, ADDRESS name__len)
static void OPT_OutName (CHAR *name, LONGINT name__len)
{
INT16 i;
CHAR ch;
@ -1620,17 +1507,6 @@ 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;
@ -1824,7 +1700,7 @@ static void OPT_OutConstant (OPT_Object obj)
OPM_SymWInt(f);
switch (f) {
case 2: case 3:
OPM_SymWCh(__CHR(obj->conval->intval));
OPM_SymWCh((CHAR)obj->conval->intval);
break;
case 4:
OPM_SymWInt(obj->conval->intval);
@ -1852,40 +1728,13 @@ 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) {
@ -1984,7 +1833,6 @@ 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;
@ -2006,7 +1854,7 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
OPT_newsf = 0;
OPT_symNew = 0;
if (!OPM_noerr || OPT_findpc) {
OPM_DeleteSym((void*)OPT_SelfName, 256);
OPM_DeleteNewSym();
}
}
}
@ -2121,11 +1969,10 @@ 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, 7) = {__TDFLDS("ObjDesc", 308), {0, 4, 8, 12, 284, 288, 304, -32}};
__TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 304), {0, 4, 8, 12, 284, 288, -28}};
__TDESC(OPT_StrDesc, 1, 3) = {__TDFLDS("StrDesc", 56), {44, 48, 52, -16}};
__TDESC(OPT_NodeDesc, 1, 6) = {__TDFLDS("NodeDesc", 28), {0, 4, 8, 16, 20, 24, -28}};
__TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 3140), {16, 20, 24, 28, 32, 36, 40, 44, 48, 52, 56, 60, 64, 68, 72, 76,
@ -2161,7 +2008,6 @@ __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)
{
@ -2178,7 +2024,6 @@ 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);

14
bootstrap/unix-44/OPT.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPT__h
#define OPT__h
@ -21,15 +21,6 @@ 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;
@ -61,7 +52,6 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@ -85,13 +75,11 @@ 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);

41
bootstrap/unix-44/OPV.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#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)] = __CHR((int)__MOD(j, 10) + 48);
n[__X(k, 10)] = (CHAR)((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;
__MOVE(obj->name, scope->name, 256);
__COPY(obj->name, scope->name, 256);
OPV_Stamp(scope->name);
if (mode == 9) {
obj->adr = 1;
@ -317,27 +317,15 @@ 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)) {
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);
}
OPV_design(n->left, 10);
OPM_WriteString((CHAR*)"->len[", 7);
OPM_WriteInt(dim);
OPM_Write(']');
} else {
OPC_Len(n->obj, n->typ, dim);
}
@ -382,7 +370,6 @@ static void OPV_SizeCast (OPT_Node n, INT32 to)
OPM_WriteInt(__ASHL(to, 3));
OPM_WriteString((CHAR*)")", 2);
}
OPV_Entier(n, 9);
}
}
@ -394,6 +381,7 @@ 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);
@ -403,6 +391,7 @@ 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);
@ -1194,7 +1183,7 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x)
base = base->BaseTyp;
}
if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) {
OPC_Andent(base);
OPC_Ident(base->strobj);
OPM_WriteString((CHAR*)"__typ", 6);
} else if (base->form == 11) {
OPM_WriteString((CHAR*)"POINTER__typ", 13);
@ -1297,17 +1286,7 @@ 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(')');

2
bootstrap/unix-44/OPV.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPV__h
#define OPV__h

61
bootstrap/unix-44/Out.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -6,7 +6,6 @@
#define SET UINT32
#include "SYSTEM.h"
#include "Heap.h"
#include "Platform.h"
@ -17,18 +16,17 @@ 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, ADDRESS s__len);
static INT32 Out_Length (CHAR *s, LONGINT 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, ADDRESS str__len);
export void Out_String (CHAR *str, LONGINT str__len);
export LONGREAL Out_Ten (INT16 e);
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);
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);
#define Out_Entier64(x) (INT64)(x)
@ -57,7 +55,7 @@ void Out_Char (CHAR ch)
}
}
static INT32 Out_Length (CHAR *s, ADDRESS s__len)
static INT32 Out_Length (CHAR *s, LONGINT s__len)
{
INT32 l;
l = 0;
@ -67,7 +65,7 @@ static INT32 Out_Length (CHAR *s, ADDRESS s__len)
return l;
}
void Out_String (CHAR *str, ADDRESS str__len)
void Out_String (CHAR *str, LONGINT str__len)
{
INT32 l;
INT16 error;
@ -80,7 +78,7 @@ void Out_String (CHAR *str, ADDRESS str__len)
error = Platform_Write(1, (ADDRESS)str, l);
} else {
__MOVE((ADDRESS)str, (ADDRESS)&Out_buf[__X(Out_in, 128)], l);
Out_in += __SHORT(l, 32768);
Out_in += (INT16)l;
}
__DEL(str);
}
@ -91,18 +89,18 @@ void Out_Int (INT64 x, INT64 n)
INT16 i;
BOOLEAN negative;
negative = x < 0;
if (x == (-9223372036854775807LL-1)) {
if (x == (-9223372036854775807-1)) {
__MOVE("8085774586302733229", s, 20);
i = 19;
} else {
if (x < 0) {
x = -x;
}
s[0] = __CHR(48 + __MOD(x, 10));
s[0] = (CHAR)(48 + __MOD(x, 10));
x = __DIV(x, 10);
i = 1;
while (x != 0) {
s[__X(i, 22)] = __CHR(48 + __MOD(x, 10));
s[__X(i, 22)] = (CHAR)(48 + __MOD(x, 10));
x = __DIV(x, 10);
i += 1;
}
@ -121,43 +119,19 @@ 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, ADDRESS s__len, INT16 *i)
static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i)
{
*i -= 1;
s[__X(*i, s__len)] = __CHR(__MOD(n, 10) + 48);
s[__X(*i, s__len)] = (CHAR)(__MOD(n, 10) + 48);
}
static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i)
static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i)
{
INT16 j;
INT32 l;
@ -166,7 +140,7 @@ static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16
if (l > *i) {
l = *i;
}
*i -= __SHORT(l, 32768);
*i -= (INT16)l;
j = 0;
while (j < l) {
s[__X(*i + j, s__len)] = t[__X(j, t__len)];
@ -201,7 +175,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)), -4503599627370496LL);
f = __MASK((__VAL(INT64, x)), -4503599627370496);
nn = (__VAL(INT64, x) < 0 && !((e == 2047 && f != 0)));
if (nn) {
n -= 1;
@ -248,7 +222,7 @@ static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_)
if (nn) {
x = -x;
}
e = __SHORT(__ASHR((e - 1023) * 77, 8), 32768);
e = (INT16)__ASHR((e - 1023) * 77, 8);
if (e >= 0) {
x = x / (LONGREAL)Out_Ten(e);
} else {
@ -332,7 +306,6 @@ 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);

5
bootstrap/unix-44/Out.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Out__h
#define Out__h
@ -11,13 +11,12 @@ 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, ADDRESS str__len);
import void Out_String (CHAR *str, LONGINT str__len);
import LONGREAL Out_Ten (INT16 e);
import void *Out__init(void);

156
bootstrap/unix-44/Platform.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -7,18 +7,37 @@
#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];
@ -26,33 +45,35 @@ export CHAR Platform_NL[3];
export ADDRESS *Platform_FileIdentity__typ;
export BOOLEAN Platform_Absent (INT16 e);
export INT16 Platform_Chdir (CHAR *n, ADDRESS n__len);
export INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
export INT16 Platform_Chdir (CHAR *n, LONGINT 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, ADDRESS var__len, CHAR *val, ADDRESS val__len);
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_GetTimeOfDay (INT32 *sec, INT32 *usec);
export INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *identity__typ);
export INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
export INT16 Platform_IdentifyByName (CHAR *n, LONGINT 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_MaxNameLength (void);
export INT16 Platform_MaxPathLength (void);
export INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h);
export INT16 Platform_New (CHAR *n, LONGINT 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, ADDRESS n__len, INT32 *h);
export INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h);
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_Read (INT32 h, INT32 p, INT32 l, INT32 *n);
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 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 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);
@ -62,16 +83,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, ADDRESS cmd__len);
export INT16 Platform_System (CHAR *cmd, LONGINT 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, ADDRESS n__len);
export INT16 Platform_Unlink (CHAR *n, LONGINT 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, ADDRESS var__len, CHAR *val, ADDRESS val__len);
export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
#include <errno.h>
#include <errno.h>
@ -81,7 +102,6 @@ export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS
#include <sys/types.h>
#include <time.h>
#include <unistd.h>
#include <limits.h>
#include <stdio.h>
#include <stdlib.h>
#define Platform_EACCES() EACCES
@ -97,8 +117,8 @@ export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS
#define Platform_EROFS() EROFS
#define Platform_ETIMEDOUT() ETIMEDOUT
#define Platform_EXDEV() EXDEV
#define Platform_NAMEMAX() NAME_MAX
#define Platform_PATHMAX() PATH_MAX
extern void Heap_InitHeap();
#define Platform_HeapInitHeap() Heap_InitHeap()
#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)
@ -109,7 +129,7 @@ export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS
#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) getenv((char*)var)
#define Platform_getenv(var, var__len) (Platform_EnvPtr)getenv((char*)var)
#define Platform_getpid() (INTEGER)getpid()
#define Platform_gettimeval() struct timeval tv; gettimeofday(&tv,0)
#define Platform_isatty(fd) isatty(fd)
@ -183,16 +203,6 @@ 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);
@ -203,14 +213,21 @@ void Platform_OSFree (INT32 address)
Platform_free(address);
}
typedef
CHAR (*EnvPtr__83)[1024];
BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
void Platform_Init (INT32 argc, INT32 argvadr)
{
EnvPtr__83 p = NIL;
Platform_ArgVecPtr av = NIL;
Platform_MainStackFrame = argvadr;
Platform_ArgCount = __VAL(INT16, argc);
av = (Platform_ArgVecPtr)(ADDRESS)argvadr;
Platform_ArgVector = (*av)[0];
Platform_HeapInitHeap();
}
BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
{
Platform_EnvPtr p = NIL;
__DUP(var, var__len, CHAR);
p = (EnvPtr__83)(ADDRESS)Platform_getenv(var, var__len);
p = Platform_getenv(var, var__len);
if (p != NIL) {
__COPY(*p, val, val__len);
}
@ -218,7 +235,7 @@ BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__le
return p != NIL;
}
void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
{
__DUP(var, var__len, CHAR);
if (!Platform_getEnv(var, var__len, (void*)val, val__len)) {
@ -227,6 +244,56 @@ void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS 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);
@ -278,7 +345,7 @@ void Platform_Delay (INT32 ms)
Platform_nanosleep(s, ns);
}
INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len)
INT16 Platform_System (CHAR *cmd, LONGINT cmd__len)
{
__DUP(cmd, cmd__len, CHAR);
__DEL(cmd);
@ -290,7 +357,7 @@ INT16 Platform_Error (void)
return Platform_err();
}
INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h)
INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h)
{
INT16 fd;
fd = Platform_openro(n, n__len);
@ -303,7 +370,7 @@ INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h)
__RETCHK;
}
INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h)
INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h)
{
INT16 fd;
fd = Platform_openrw(n, n__len);
@ -316,7 +383,7 @@ INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h)
__RETCHK;
}
INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h)
INT16 Platform_New (CHAR *n, LONGINT n__len, INT32 *h)
{
INT16 fd;
fd = Platform_opennew(n, n__len);
@ -356,7 +423,7 @@ INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *iden
return 0;
}
INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{
__DUP(n, n__len, CHAR);
Platform_structstats();
@ -414,7 +481,7 @@ INT16 Platform_Read (INT32 h, INT32 p, INT32 l, INT32 *n)
__RETCHK;
}
INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n)
INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n)
{
*n = Platform_readfile(h, (ADDRESS)b, b__len);
if (*n < 0) {
@ -468,7 +535,7 @@ INT16 Platform_Truncate (INT32 h, INT32 l)
__RETCHK;
}
INT16 Platform_Unlink (CHAR *n, ADDRESS n__len)
INT16 Platform_Unlink (CHAR *n, LONGINT n__len)
{
if (Platform_unlink(n, n__len) < 0) {
return Platform_err();
@ -478,7 +545,7 @@ INT16 Platform_Unlink (CHAR *n, ADDRESS n__len)
__RETCHK;
}
INT16 Platform_Chdir (CHAR *n, ADDRESS n__len)
INT16 Platform_Chdir (CHAR *n, LONGINT n__len)
{
INT16 r;
if ((Platform_chdir(n, n__len) >= 0 && Platform_getcwd((void*)Platform_CWD, 256) != NIL)) {
@ -489,7 +556,7 @@ INT16 Platform_Chdir (CHAR *n, ADDRESS n__len)
__RETCHK;
}
INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len)
INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len)
{
if (Platform_rename(o, o__len, n, n__len) < 0) {
return Platform_err();
@ -520,6 +587,7 @@ 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();

33
bootstrap/unix-44/Platform.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Platform__h
#define Platform__h
@ -16,41 +16,46 @@ 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_Chdir (CHAR *n, ADDRESS n__len);
import INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
import INT16 Platform_Chdir (CHAR *n, LONGINT 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, ADDRESS var__len, CHAR *val, ADDRESS val__len);
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_GetTimeOfDay (INT32 *sec, INT32 *usec);
import INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *identity__typ);
import INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
import INT16 Platform_IdentifyByName (CHAR *n, LONGINT 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_MaxNameLength (void);
import INT16 Platform_MaxPathLength (void);
import INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h);
import INT16 Platform_New (CHAR *n, LONGINT 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, ADDRESS n__len, INT32 *h);
import INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h);
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_Read (INT32 h, INT32 p, INT32 l, INT32 *n);
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 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 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);
@ -60,14 +65,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, ADDRESS cmd__len);
import INT16 Platform_System (CHAR *cmd, LONGINT 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, ADDRESS n__len);
import INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
import INT16 Platform_Write (INT32 h, INT32 p, INT32 l);
import BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
import BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
import void *Platform__init(void);

40
bootstrap/unix-44/Reals.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -10,11 +10,11 @@
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);
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);
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, __CHR(__ASHL(__ASHR((INT16)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR);
__PUT((ADDRESS)x + 3, (CHAR)(__ASHL(__ASHR((INT16)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR);
__GET((ADDRESS)x + 2, c, CHAR);
__PUT((ADDRESS)x + 2, __CHR(__MASK((INT16)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR);
__PUT((ADDRESS)x + 2, (CHAR)(__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, ADDRESS d__len)
void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len)
{
INT32 i, j, k;
if (x < (LONGREAL)0) {
@ -87,27 +87,27 @@ void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len)
}
k = 0;
if (n > 9) {
i = __SHORT(__ENTIER(x / (LONGREAL)(LONGREAL)1000000000), 2147483648LL);
j = __SHORT(__ENTIER(x - i * (LONGREAL)1000000000), 2147483648LL);
i = (INT32)__ENTIER(x / (LONGREAL)(LONGREAL)1000000000);
j = (INT32)__ENTIER(x - i * (LONGREAL)1000000000);
if (j < 0) {
j = 0;
}
while (k < 9) {
d[__X(k, d__len)] = __CHR((int)__MOD(j, 10) + 48);
d[__X(k, d__len)] = (CHAR)((int)__MOD(j, 10) + 48);
j = __DIV(j, 10);
k += 1;
}
} else {
i = __SHORT(__ENTIER(x), 2147483648LL);
i = (INT32)__ENTIER(x);
}
while (k < n) {
d[__X(k, d__len)] = __CHR((int)__MOD(i, 10) + 48);
d[__X(k, d__len)] = (CHAR)((int)__MOD(i, 10) + 48);
i = __DIV(i, 10);
k += 1;
}
}
void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len)
void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len)
{
Reals_ConvertL(x, n, (void*)d, d__len);
}
@ -115,14 +115,14 @@ void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len)
static CHAR Reals_ToHex (INT16 i)
{
if (i < 10) {
return __CHR(i + 48);
return (CHAR)(i + 48);
} else {
return __CHR(i + 55);
return (CHAR)(i + 55);
}
__RETCHK;
}
static void Reals_BytesToHex (SYSTEM_BYTE *b, ADDRESS b__len, SYSTEM_BYTE *d, ADDRESS d__len)
static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len)
{
INT16 i;
INT32 l;
@ -137,12 +137,12 @@ static void Reals_BytesToHex (SYSTEM_BYTE *b, ADDRESS b__len, SYSTEM_BYTE *d, AD
}
}
void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len)
void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len)
{
Reals_BytesToHex((void*)&y, 4, (void*)d, d__len * 1);
}
void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len)
void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len)
{
Reals_BytesToHex((void*)&x, 8, (void*)d, d__len * 1);
}

10
bootstrap/unix-44/Reals.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Reals__h
#define Reals__h
@ -8,10 +8,10 @@
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 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 INT16 Reals_Expo (REAL x);
import INT16 Reals_ExpoL (LONGREAL x);
import void Reals_SetExpo (REAL *x, INT16 ex);

174
bootstrap/unix-44/Strings.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -6,25 +6,22 @@
#define SET UINT32
#include "SYSTEM.h"
#include "Reals.h"
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);
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);
INT16 Strings_Length (CHAR *s, ADDRESS s__len)
INT16 Strings_Length (CHAR *s, LONGINT s__len)
{
INT32 i;
__DUP(s, s__len, CHAR);
@ -34,7 +31,7 @@ INT16 Strings_Length (CHAR *s, ADDRESS s__len)
}
if (i <= 32767) {
__DEL(s);
return __SHORT(i, 32768);
return (INT16)i;
} else {
__DEL(s);
return 32767;
@ -42,7 +39,7 @@ INT16 Strings_Length (CHAR *s, ADDRESS s__len)
__RETCHK;
}
void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len)
void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len)
{
INT16 n1, n2, i;
__DUP(extra, extra__len, CHAR);
@ -59,7 +56,7 @@ void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__
__DEL(extra);
}
void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
{
INT16 n1, n2, i;
__DUP(source, source__len, CHAR);
@ -90,7 +87,7 @@ void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, A
__DEL(source);
}
void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n)
void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n)
{
INT16 len, i;
len = Strings_Length(s, s__len);
@ -113,7 +110,7 @@ void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n)
}
}
void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
{
__DUP(source, source__len, CHAR);
Strings_Delete((void*)dest, dest__len, pos, pos + Strings_Length(source, source__len));
@ -121,12 +118,12 @@ void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest,
__DEL(source);
}
void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len)
void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len)
{
INT16 len, destLen, i;
__DUP(source, source__len, CHAR);
len = Strings_Length(source, source__len);
destLen = __SHORT(dest__len, 32768) - 1;
destLen = (INT16)dest__len - 1;
if (pos < 0) {
pos = 0;
}
@ -146,7 +143,7 @@ void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHA
__DEL(source);
}
INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos)
INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos)
{
INT16 n1, n2, i, j;
__DUP(pattern, pattern__len, CHAR);
@ -178,7 +175,7 @@ INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len,
return -1;
}
void Strings_Cap (CHAR *s, ADDRESS s__len)
void Strings_Cap (CHAR *s, LONGINT s__len)
{
INT16 i;
i = 0;
@ -194,9 +191,9 @@ static struct Match__7 {
struct Match__7 *lnk;
} *Match__7_s;
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)
static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT 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)]) {
@ -223,7 +220,7 @@ static BOOLEAN M__8 (CHAR *name, ADDRESS name__len, CHAR *mask, ADDRESS mask__le
return 0;
}
BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len)
BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len)
{
struct Match__7 _s;
BOOLEAN __retval;
@ -239,135 +236,10 @@ BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS
return __retval;
}
void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r)
{
INT16 p, e;
REAL y, g;
BOOLEAN neg, negE;
__DUP(s, s__len, CHAR);
p = 0;
while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') {
p += 1;
}
if (s[__X(p, s__len)] == '-') {
neg = 1;
p += 1;
} else {
neg = 0;
}
while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') {
p += 1;
}
y = (REAL)0;
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
y = y * (REAL)10 + ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
if (s[__X(p, s__len)] == '.') {
p += 1;
g = (REAL)1;
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
g = g / (REAL)(REAL)10;
y = y + g * ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
}
if (s[__X(p, s__len)] == 'D' || s[__X(p, s__len)] == 'E') {
p += 1;
e = 0;
if (s[__X(p, s__len)] == '-') {
negE = 1;
p += 1;
} else {
negE = 0;
}
while (s[__X(p, s__len)] == '0') {
p += 1;
}
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
e = e * 10 + ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
if (negE) {
y = y / (REAL)Reals_Ten(e);
} else {
y = y * Reals_Ten(e);
}
}
if (neg) {
y = -y;
}
*r = y;
__DEL(s);
}
void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r)
{
INT16 p, e;
LONGREAL y, g;
BOOLEAN neg, negE;
__DUP(s, s__len, CHAR);
p = 0;
while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') {
p += 1;
}
if (s[__X(p, s__len)] == '-') {
neg = 1;
p += 1;
} else {
neg = 0;
}
while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') {
p += 1;
}
y = (LONGREAL)0;
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
y = y * (LONGREAL)10 + ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
if (s[__X(p, s__len)] == '.') {
p += 1;
g = (LONGREAL)1;
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
g = g / (LONGREAL)(LONGREAL)10;
y = y + g * ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
}
if (s[__X(p, s__len)] == 'D' || s[__X(p, s__len)] == 'E') {
p += 1;
e = 0;
if (s[__X(p, s__len)] == '-') {
negE = 1;
p += 1;
} else {
negE = 0;
}
while (s[__X(p, s__len)] == '0') {
p += 1;
}
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
e = e * 10 + ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
if (negE) {
y = y / (LONGREAL)Reals_Ten(e);
} else {
y = y * Reals_Ten(e);
}
}
if (neg) {
y = -y;
}
*r = y;
__DEL(s);
}
export void *Strings__init(void)
{
__DEFMOD;
__MODULE_IMPORT(Reals);
__REGMOD("Strings", 0);
/* BEGIN */
__ENDMOD;

22
bootstrap/unix-44/Strings.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Strings__h
#define Strings__h
@ -8,17 +8,15 @@
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_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__init(void);

84
bootstrap/unix-44/Texts.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#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, ADDRESS name__len);
export void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
export void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
export void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
export void Texts_Delete (Texts_Text T, 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, ADDRESS name__len);
static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT 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, ADDRESS name__len);
export void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
export void Texts_OpenBuf (Texts_Buffer B);
export void Texts_OpenReader (Texts_Reader *R, 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, ADDRESS s__len);
export void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
static Texts_FontsFont Texts_FontsThis (CHAR *name, ADDRESS name__len)
static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT 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;
__MOVE((*(Texts_Alien*)&E)->mod, e->mod, 32);
__MOVE((*(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;
__COPY(((Texts_Alien)E)->mod, e->mod, 32);
__COPY(((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 = __CHR((INT16)ch - 7);
ch = (CHAR)((INT16)ch - 7);
} else if (('a' <= ch && ch <= 'f')) {
hex = 1;
ch = __CHR((INT16)ch - 39);
ch = (CHAR)((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, ADDRESS s__len)
void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT 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 == (-9223372036854775807LL-1)) {
if (x == (-9223372036854775807-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)] = __CHR(__MOD(x0, 10) + 48);
a[__X(i, 24)] = (CHAR)(__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)] = __CHR(y + 48);
a[__X(i, 20)] = (CHAR)(y + 48);
} else {
a[__X(i, 20)] = __CHR(y + 55);
a[__X(i, 20)] = (CHAR)(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, __CHR(__DIV(e, 10) + 48));
Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48));
Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48));
Texts_Write(&*W, W__typ, (CHAR)((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 = __SHORT(__ASHR((e - 1023) * 77, 8), 32768);
e = (INT16)__ASHR((e - 1023) * 77, 8);
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, __CHR(__DIV(e, 100) + 48));
Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 100) + 48));
e = (int)__MOD(e, 100);
Texts_Write(&*W, W__typ, __CHR(__DIV(e, 10) + 48));
Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48));
Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48));
Texts_Write(&*W, W__typ, (CHAR)((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, __CHR(__DIV(x, 10) + 48));
Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, __CHR((int)__MOD(x, 10) + 48));
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));
}
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)
{
Heap_Module M = NIL;
Heap_Command Cmd;
Modules_Module M = NIL;
Modules_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, ADDRESS name__len)
void Texts_Open (Texts_Text T, CHAR *name, LONGINT 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, ADDRESS name__len)
void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len)
{
Files_File f = NIL;
Files_Rider r;

8
bootstrap/unix-44/Texts.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#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, ADDRESS name__len);
import void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
import void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
import void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
import void Texts_Delete (Texts_Text T, 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, ADDRESS name__len);
import void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
import void Texts_OpenBuf (Texts_Buffer B);
import void Texts_OpenReader (Texts_Reader *R, 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, ADDRESS s__len);
import void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
import void *Texts__init(void);

43
bootstrap/unix-44/VT100.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -27,24 +27,23 @@ 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, 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);
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);
export void VT100_HVP (INT16 n, INT16 m);
export void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len);
export void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len);
export void VT100_RCP (void);
export void VT100_Reset (void);
static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end);
static void VT100_Reverse0 (CHAR *str, LONGINT 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, ADDRESS attr__len);
export void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end)
static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end)
{
CHAR h;
while (start < end) {
@ -56,7 +55,7 @@ static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end)
}
}
void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len)
void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
{
CHAR b[21];
INT16 s, e;
@ -75,7 +74,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len)
}
e = s;
do {
b[__X(e, 21)] = __CHR((int)__MOD(int_, 10) + 48);
b[__X(e, 21)] = (CHAR)((int)__MOD(int_, 10) + 48);
int_ = __DIV(int_, 10);
e += 1;
} while (!(int_ == 0));
@ -85,7 +84,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len)
__COPY(b, str, str__len);
}
static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len)
static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len)
{
CHAR cmd[9];
__DUP(letter, letter__len, CHAR);
@ -95,7 +94,7 @@ static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len)
__DEL(letter);
}
static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len)
static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len)
{
CHAR nstr[2];
CHAR cmd[7];
@ -108,7 +107,7 @@ static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len)
__DEL(letter);
}
static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len)
static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len)
{
CHAR nstr[2];
CHAR cmd[7];
@ -121,7 +120,7 @@ static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len)
__DEL(letter);
}
static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len)
static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len)
{
CHAR nstr[5], mstr[5];
CHAR cmd[12];
@ -137,15 +136,6 @@ static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len)
__DEL(letter);
}
void VT100_Reset (void)
{
CHAR cmd[6];
__COPY("\033", cmd, 6);
Strings_Append((CHAR*)"c", 2, (void*)cmd, 6);
Out_String(cmd, 6);
Out_Ln();
}
void VT100_CUU (INT16 n)
{
VT100_EscSeq(n, (CHAR*)"A", 2);
@ -246,7 +236,7 @@ void VT100_DECTCEMh (void)
VT100_EscSeq0((CHAR*)"\?25h", 5);
}
void VT100_SetAttr (CHAR *attr, ADDRESS attr__len)
void VT100_SetAttr (CHAR *attr, LONGINT attr__len)
{
CHAR tmpstr[16];
__DUP(attr, attr__len, CHAR);
@ -266,7 +256,6 @@ 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);

7
bootstrap/unix-44/VT100.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef VT100__h
#define VT100__h
@ -23,15 +23,14 @@ 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, ADDRESS str__len);
import void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT 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, ADDRESS attr__len);
import void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
import void *VT100__init(void);

89
bootstrap/unix-44/extTools.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -7,40 +7,33 @@
#include "SYSTEM.h"
#include "Configuration.h"
#include "Heap.h"
#include "Modules.h"
#include "OPM.h"
#include "Out.h"
#include "Platform.h"
#include "Strings.h"
typedef
CHAR extTools_CommandString[4096];
static CHAR extTools_CFLAGS[1023];
static extTools_CommandString extTools_CFLAGS;
export void extTools_Assemble (CHAR *moduleName, 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);
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)
static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT 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((CHAR*)" ", 3);
Out_String(title, title__len);
Out_String(cmd, cmd__len);
Out_Ln();
}
__COPY(cmd, fullcmd, 4096);
Heap_GC(0);
r = Platform_System(fullcmd, 4096);
r = Platform_System(cmd, cmd__len);
status = __MASK(r, -128);
exitcode = __ASHR(r, 8);
if (exitcode > 127) {
@ -70,55 +63,50 @@ static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRES
__DEL(cmd);
}
static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len, CHAR *additionalopts, ADDRESS additionalopts__len)
static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT s__len)
{
__DUP(additionalopts, additionalopts__len, CHAR);
__COPY("gcc -fPIC -g -Wno-stringop-overflow", s, s__len);
__COPY("gcc -g", 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);
Strings_Append(additionalopts, additionalopts__len, (void*)s, s__len);
Platform_GetEnv((CHAR*)"CFLAGS", 7, (void*)extTools_CFLAGS, 1023);
Strings_Append(extTools_CFLAGS, 1023, (void*)s, s__len);
Strings_Append((CHAR*)" ", 2, (void*)s, s__len);
Platform_GetEnv((CHAR*)"CFLAGS", 7, (void*)extTools_CFLAGS, 4096);
Strings_Append(extTools_CFLAGS, 4096, (void*)s, s__len);
Strings_Append((CHAR*)" ", 2, (void*)s, s__len);
__DEL(additionalopts);
}
void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len)
void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len)
{
extTools_CommandString cmd;
CHAR cmd[1023];
__DUP(moduleName, moduleName__len, CHAR);
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);
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);
__DEL(moduleName);
}
void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len)
void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len)
{
extTools_CommandString cmd;
CHAR cmd[1023];
__DUP(additionalopts, additionalopts__len, CHAR);
extTools_InitialiseCompilerCommand((void*)cmd, 4096, additionalopts, additionalopts__len);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096);
Strings_Append((CHAR*)".c ", 4, (void*)cmd, 4096);
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);
if (statically) {
Strings_Append((CHAR*)" -static", 9, (void*)cmd, 4096);
Strings_Append((CHAR*)"-static", 8, (void*)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);
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);
__DEL(additionalopts);
}
@ -127,7 +115,6 @@ export void *extTools__init(void)
{
__DEFMOD;
__MODULE_IMPORT(Configuration);
__MODULE_IMPORT(Heap);
__MODULE_IMPORT(Modules);
__MODULE_IMPORT(OPM);
__MODULE_IMPORT(Out);

6
bootstrap/unix-44/extTools.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef extTools__h
#define extTools__h
@ -8,8 +8,8 @@
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_Assemble (CHAR *moduleName, LONGINT moduleName__len);
import void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len);
import void *extTools__init(void);

53
bootstrap/unix-48/Compiler.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspamS */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspamS */
#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,12 +41,11 @@ 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_DeleteSym((void*)OPT_SelfName, 256);
OPM_DeleteNewSym();
OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogWStr((CHAR*)" Main program.", 16);
OPM_LogVT100((CHAR*)"0m", 3);
@ -62,7 +61,7 @@ void Compiler_Module (BOOLEAN *done)
}
}
} else {
OPM_DeleteSym((void*)OPT_SelfName, 256);
OPM_DeleteNewSym();
}
}
}
@ -89,7 +88,7 @@ static void Compiler_PropagateElementaryTypeSizes (void)
OPT_sintobj->typ = OPT_sinttyp;
OPT_intobj->typ = OPT_inttyp;
OPT_lintobj->typ = OPT_linttyp;
switch (OPM_SetSize) {
switch (OPM_LongintSize) {
case 4:
OPT_settyp = OPT_set32typ;
break;
@ -105,44 +104,14 @@ 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 linkfiles[2048];
CHAR modulesobj[2048];
modulesobj[0] = 0x00;
if (OPM_OpenPar()) {
for (;;) {
OPM_Init(&done);
OPM_Init(&done, (void*)Compiler_mname, 256);
if (!done) {
return;
}
@ -162,9 +131,11 @@ 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 {
Compiler_FindLocalObjectFiles((void*)linkfiles, 2048);
extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), linkfiles, 2048);
extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), modulesobj, 2048);
}
}
}

6
bootstrap/unix-48/Configuration.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -8,7 +8,7 @@
#include "SYSTEM.h"
export CHAR Configuration_versionLong[76];
export CHAR Configuration_versionLong[75];
@ -19,6 +19,6 @@ export void *Configuration__init(void)
__DEFMOD;
__REGMOD("Configuration", 0);
/* BEGIN */
__MOVE("2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 76);
__MOVE("1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75);
__ENDMOD;
}

4
bootstrap/unix-48/Configuration.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Configuration__h
#define Configuration__h
@ -6,7 +6,7 @@
#include "SYSTEM.h"
import CHAR Configuration_versionLong[76];
import CHAR Configuration_versionLong[75];
import void *Configuration__init(void);

426
bootstrap/unix-48/Files.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -26,7 +26,7 @@ typedef
Files_BufDesc *Files_Buffer;
typedef
CHAR Files_FileName[256];
CHAR Files_FileName[101];
typedef
struct Files_FileDesc {
@ -36,7 +36,7 @@ typedef
INT32 fd, len, pos;
Files_Buffer bufs[4];
INT16 swapper, state;
struct Files_FileDesc *next;
Files_File next;
} Files_FileDesc;
typedef
@ -48,12 +48,11 @@ typedef
} Files_Rider;
export INT16 Files_MaxPathLength, Files_MaxNameLength;
static Files_FileDesc *Files_files;
static Files_File Files_files;
static INT16 Files_tempno;
static CHAR Files_HOME[1024];
static struct {
ADDRESS len[1];
LONGINT len[1];
CHAR data[1];
} *Files_SearchPath;
@ -61,68 +60,58 @@ 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, ADDRESS path__len, INT16 *res);
export void Files_ChangeDirectory (CHAR *path, LONGINT 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, 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);
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);
static void Files_Finalize (SYSTEM_PTR o);
static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len);
static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len);
static void Files_Flush (Files_Buffer buf);
export void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
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 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 INT32 Files_Length (Files_File f);
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);
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len);
export Files_File Files_New (CHAR *name, LONGINT name__len);
export Files_File Files_Old (CHAR *name, LONGINT name__len);
export INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
export void Files_Purge (Files_File f);
export void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
export void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x);
export void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT 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, ADDRESS x__len);
export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
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_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, ADDRESS x__len);
export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
export void Files_Register (Files_File f);
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_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_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos);
export void Files_SetSearchPath (CHAR *path, ADDRESS path__len);
export void Files_SetSearchPath (CHAR *path, LONGINT 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, ADDRESS x__len, INT32 n);
export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT 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, ADDRESS x__len);
export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
#define Files_IdxTrap() __HALT(-1)
#define Files_ToAdr(x) (ADDRESS)x
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)
static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
{
__DUP(s, s__len, CHAR);
Out_Ln();
@ -131,17 +120,17 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
Out_String((CHAR*)": ", 3);
if (f != NIL) {
if (f->registerName[0] != 0x00) {
Out_String(f->registerName, 256);
Out_String(f->registerName, 101);
} else {
Out_String(f->workName, 256);
Out_String(f->workName, 101);
}
if (f->fd != 0) {
Out_String((CHAR*)", f.fd = ", 10);
Out_String((CHAR*)"f.fd = ", 8);
Out_Int(f->fd, 1);
}
}
if (errcode != 0) {
Out_String((CHAR*)", errcode = ", 13);
Out_String((CHAR*)" errcode = ", 12);
Out_Int(errcode, 1);
}
Out_Ln();
@ -149,125 +138,98 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
__DEL(s);
}
static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len)
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len)
{
INT16 i, j, ld, ln;
INT16 i, j;
__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 (j < ln) {
dest[__X(i, dest__len)] = name[__X(j, name__len)];
while (dir[i] != 0x00) {
dest[i] = dir[i];
i += 1;
}
if (dest[i - 1] != '/') {
dest[i] = '/';
i += 1;
}
while (name[j] != 0x00) {
dest[i] = name[j];
i += 1;
j += 1;
}
dest[__X(i, dest__len)] = 0x00;
dest[i] = 0x00;
__DEL(dir);
__DEL(name);
}
static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len)
static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len)
{
INT16 i, n;
INT32 n, i, j;
__DUP(finalName, finalName__len, CHAR);
if (finalName[0] == '/') {
__COPY(finalName, name, name__len);
} else {
Files_MakeFileName(Platform_CWD, 256, finalName, finalName__len, (void*)name, name__len);
}
i = Strings_Length(name, name__len) - 1;
while ((i > 0 && name[__X(i, name__len)] != '/')) {
i -= 1;
}
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 = 0;
if (finalName[0] != '/') {
while (Platform_CWD[i] != 0x00) {
name[i] = Platform_CWD[i];
i += 1;
}
if (Platform_CWD[i - 1] != '/') {
name[i] = '/';
i += 1;
}
}
j = 0;
while (finalName[j] != 0x00) {
name[i] = finalName[j];
i += 1;
j += 1;
}
i -= 1;
while (name[i] != '/') {
i -= 1;
}
name[i + 1] = '.';
name[i + 2] = 't';
name[i + 3] = 'm';
name[i + 4] = 'p';
name[i + 5] = '.';
i += 6;
while (n > 0) {
name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48);
name[i] = (CHAR)((int)__MOD(n, 10) + 48);
n = __DIV(n, 10);
i += 1;
}
name[__X(i, name__len)] = '.';
name[i] = '.';
i += 1;
n = Platform_PID;
while (n > 0) {
name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48);
name[i] = (CHAR)((int)__MOD(n, 10) + 48);
n = __DIV(n, 10);
i += 1;
}
name[__X(i, name__len)] = 0x00;
name[i] = 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, 256, (void*)f->workName, 256);
Files_GetTempName(f->registerName, 101, (void*)f->workName, 101);
f->tempFile = 1;
} else {
__ASSERT(f->state == 2, 0);
Files_Deregister(f->registerName, 256);
__MOVE(f->registerName, f->workName, 256);
} else if (f->state == 2) {
__COPY(f->registerName, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
error = Platform_Unlink((void*)f->workName, 256);
error = Platform_New((void*)f->workName, 256, &f->fd);
error = Platform_Unlink((void*)f->workName, 101);
error = Platform_New((void*)f->workName, 101, &f->fd);
done = error == 0;
if (done) {
f->next = Files_files;
@ -313,6 +275,27 @@ 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;
@ -320,10 +303,11 @@ void Files_Close (Files_File f)
if (f->state != 1 || f->registerName[0] != 0x00) {
Files_Create(f);
i = 0;
while ((i < 4 && f->bufs[__X(i, 4)] != NIL)) {
Files_Flush(f->bufs[__X(i, 4)]);
while ((i < 4 && f->bufs[i] != NIL)) {
Files_Flush(f->bufs[i]);
i += 1;
}
Files_CloseOSFile(f);
}
}
@ -332,13 +316,13 @@ INT32 Files_Length (Files_File f)
return f->len;
}
Files_File Files_New (CHAR *name, ADDRESS name__len)
Files_File Files_New (CHAR *name, LONGINT name__len)
{
Files_File f = NIL;
__DUP(name, name__len, CHAR);
__NEW(f, Files_FileDesc);
f->workName[0] = 0x00;
__COPY(name, f->registerName, 256);
__COPY(name, f->registerName, 101);
f->fd = -1;
f->state = 1;
f->len = 0;
@ -348,7 +332,7 @@ Files_File Files_New (CHAR *name, ADDRESS name__len)
return f;
}
static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len)
static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len)
{
INT16 i;
CHAR ch;
@ -360,38 +344,38 @@ static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len)
*pos += 1;
}
} else {
ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
ch = (Files_SearchPath->data)[*pos];
while (ch == ' ' || ch == ';') {
*pos += 1;
ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
ch = (Files_SearchPath->data)[*pos];
}
if (ch == '~') {
*pos += 1;
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)];
ch = (Files_SearchPath->data)[*pos];
while (Files_HOME[i] != 0x00) {
dir[i] = Files_HOME[i];
i += 1;
}
if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) {
while ((i > 0 && dir[__X(i - 1, dir__len)] != '/')) {
while ((i > 0 && dir[i - 1] != '/')) {
i -= 1;
}
}
}
while ((ch != 0x00 && ch != ';')) {
dir[__X(i, dir__len)] = ch;
dir[i] = ch;
i += 1;
*pos += 1;
ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
ch = (Files_SearchPath->data)[*pos];
}
while ((i > 0 && dir[__X(i - 1, dir__len)] == ' ')) {
while ((i > 0 && dir[i - 1] == ' ')) {
i -= 1;
}
}
dir[__X(i, dir__len)] = 0x00;
dir[i] = 0x00;
}
static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len)
static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
{
INT16 i;
CHAR ch;
@ -399,7 +383,7 @@ static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len)
ch = name[0];
while ((ch != 0x00 && ch != '/')) {
i += 1;
ch = name[__X(i, name__len)];
ch = name[i];
}
return ch == '/';
}
@ -408,15 +392,15 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
{
Files_File f = NIL;
INT16 i, error;
f = (Files_File)Files_files;
f = 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[__X(i, 4)] != NIL) {
f->bufs[__X(i, 4)]->org = -1;
f->bufs[__X(i, 4)] = NIL;
if (f->bufs[i] != NIL) {
f->bufs[i]->org = -1;
f->bufs[i] = NIL;
}
i += 1;
}
@ -426,12 +410,12 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
}
return f;
}
f = (Files_File)f->next;
f = f->next;
}
return NIL;
}
Files_File Files_Old (CHAR *name, ADDRESS name__len)
Files_File Files_Old (CHAR *name, LONGINT name__len)
{
Files_File f = NIL;
INT32 fd;
@ -472,7 +456,6 @@ Files_File Files_Old (CHAR *name, ADDRESS 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 {
@ -483,7 +466,7 @@ Files_File Files_Old (CHAR *name, ADDRESS name__len)
f->pos = 0;
f->swapper = -1;
error = Platform_Size(fd, &f->len);
__COPY(name, f->workName, 256);
__COPY(name, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
f->identity = identity;
@ -515,9 +498,9 @@ void Files_Purge (Files_File f)
INT16 error;
i = 0;
while (i < 4) {
if (f->bufs[__X(i, 4)] != NIL) {
f->bufs[__X(i, 4)]->org = -1;
f->bufs[__X(i, 4)] = NIL;
if (f->bufs[i] != NIL) {
f->bufs[i]->org = -1;
f->bufs[i] = NIL;
}
i += 1;
}
@ -543,7 +526,7 @@ void Files_GetDate (Files_File f, INT32 *t, INT32 *d)
INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ)
{
Files_Assert((*r).offset <= 4096);
__ASSERT((*r).offset <= 4096, 0);
return (*r).org + (*r).offset;
}
@ -561,22 +544,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[__X(i, 4)] != NIL)) && org != f->bufs[__X(i, 4)]->org)) {
while ((((i < 4 && f->bufs[i] != NIL)) && org != f->bufs[i]->org)) {
i += 1;
}
if (i < 4) {
if (f->bufs[__X(i, 4)] == NIL) {
if (f->bufs[i] == NIL) {
__NEW(buf, Files_BufDesc);
buf->chg = 0;
buf->org = -1;
buf->f = f;
f->bufs[__X(i, 4)] = buf;
f->bufs[i] = buf;
} else {
buf = f->bufs[__X(i, 4)];
buf = f->bufs[i];
}
} else {
f->swapper = __MASK(f->swapper + 1, -4);
buf = f->bufs[__X(f->swapper, 4)];
buf = f->bufs[f->swapper];
Files_Flush(buf);
}
if (buf->org != org) {
@ -602,7 +585,7 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
org = 0;
offset = 0;
}
Files_Assert(offset <= 4096);
__ASSERT(offset <= 4096, 0);
(*r).buf = buf;
(*r).org = org;
(*r).offset = offset;
@ -621,9 +604,9 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
buf = (*r).buf;
offset = (*r).offset;
}
Files_Assert(offset <= buf->size);
__ASSERT(offset <= buf->size, 0);
if (offset < buf->size) {
*x = buf->data[__X(offset, 4096)];
*x = buf->data[offset];
(*r).offset = offset + 1;
} else if ((*r).org + offset < buf->f->len) {
Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset);
@ -635,12 +618,7 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
}
}
void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
{
Files_Read(&*r, r__typ, &*x);
}
void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n)
void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
{
INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
@ -666,12 +644,12 @@ void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x
} else {
min = n;
}
__MOVE((ADDRESS)&buf->data[__X(offset, 4096)], (ADDRESS)&x[__X(xpos, x__len)], min);
__MOVE((ADDRESS)buf->data + Files_ToAdr(offset), (ADDRESS)x + Files_ToAdr(xpos), min);
offset += min;
(*r).offset = offset;
xpos += min;
n -= min;
Files_Assert(offset <= 4096);
__ASSERT(offset <= 4096, 0);
}
(*r).res = 0;
(*r).eof = 0;
@ -688,14 +666,14 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
INT32 offset;
buf = (*r).buf;
offset = (*r).offset;
Files_Assert(offset <= 4096);
__ASSERT(offset <= 4096, 0);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
Files_Assert(offset < 4096);
buf->data[__X(offset, 4096)] = x;
__ASSERT(offset < 4096, 0);
buf->data[offset] = x;
buf->chg = 1;
if (offset == buf->size) {
buf->size += 1;
@ -705,7 +683,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, ADDRESS x__len, INT32 n)
void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
{
INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
@ -716,23 +694,23 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS
buf = (*r).buf;
offset = (*r).offset;
while (n > 0) {
Files_Assert(offset <= 4096);
__ASSERT(offset <= 4096, 0);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
Files_Assert(offset <= 4096);
__ASSERT(offset <= 4096, 0);
restInBuf = 4096 - offset;
if (n > restInBuf) {
min = restInBuf;
} else {
min = n;
}
__MOVE((ADDRESS)&x[__X(xpos, x__len)], (ADDRESS)&buf->data[__X(offset, 4096)], min);
__MOVE((ADDRESS)x + Files_ToAdr(xpos), (ADDRESS)buf->data + Files_ToAdr(offset), min);
offset += min;
(*r).offset = offset;
Files_Assert(offset <= 4096);
__ASSERT(offset <= 4096, 0);
if (offset > buf->size) {
buf->f->len += offset - buf->size;
buf->size = offset;
@ -744,15 +722,14 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS
(*r).res = 0;
}
void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res)
void Files_Delete (CHAR *name, LONGINT 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, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res)
void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res)
{
INT32 fdold, fdnew, n;
INT16 error, ignore;
@ -818,30 +795,31 @@ 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_Deregister(f->registerName, 256);
Files_Rename(f->workName, 256, f->registerName, 256, &errcode);
Files_Rename(f->workName, 101, f->registerName, 101, &errcode);
if (errcode != 0) {
Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode);
__COPY(f->registerName, file, 104);
__HALT(99);
}
__MOVE(f->registerName, f->workName, 256);
__COPY(f->registerName, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
}
void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res)
void Files_ChangeDirectory (CHAR *path, LONGINT 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, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len)
static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len)
{
INT32 i, j;
if (!Platform_LittleEndian) {
@ -849,7 +827,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *de
j = 0;
while (i > 0) {
i -= 1;
dest[__X(j, dest__len)] = src[__X(i, src__len)];
dest[j] = src[i];
j += 1;
}
} else {
@ -899,36 +877,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, ADDRESS x__len)
void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
INT16 i;
CHAR ch;
i = 0;
do {
Files_Read(&*R, R__typ, (void*)&ch);
x[__X(i, x__len)] = ch;
x[i] = ch;
i += 1;
} while (!(ch == 0x00));
}
void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
INT16 i;
i = 0;
do {
Files_Read(&*R, R__typ, (void*)&x[__X(i, x__len)]);
Files_Read(&*R, R__typ, (void*)&x[i]);
i += 1;
} while (!(x[__X(i - 1, x__len)] == 0x00 || x[__X(i - 1, x__len)] == 0x0a));
if (x[__X(i - 1, x__len)] == 0x0a) {
} while (!(x[i - 1] == 0x00 || x[i - 1] == 0x0a));
if (x[i - 1] == 0x0a) {
i -= 1;
}
if ((i > 0 && x[__X(i - 1, x__len)] == 0x0d)) {
if ((i > 0 && x[i - 1] == 0x0d)) {
i -= 1;
}
x[__X(i, x__len)] = 0x00;
x[i] = 0x00;
}
void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len)
void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len)
{
INT8 s, b;
INT64 q;
@ -941,7 +919,7 @@ void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__
Files_Read(&*R, R__typ, (void*)&b);
}
q += (INT64)__ASH((__MASK(b, -64) - __ASHL(__ASHR(b, 6), 6)), s);
Files_Assert(x__len <= 8);
__ASSERT(x__len <= 8, 0);
__MOVE((ADDRESS)&q, (ADDRESS)x, x__len);
}
@ -953,18 +931,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] = __CHR(x);
b[1] = __CHR(__ASHR(x, 8));
b[0] = (CHAR)x;
b[1] = (CHAR)__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] = __CHR(x);
b[1] = __CHR(__ASHR(x, 8));
b[2] = __CHR(__ASHR(x, 16));
b[3] = __CHR(__ASHR(x, 24));
b[0] = (CHAR)x;
b[1] = (CHAR)__ASHR(x, 8);
b[2] = (CHAR)__ASHR(x, 16);
b[3] = (CHAR)__ASHR(x, 24);
Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
@ -972,13 +950,11 @@ void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x)
{
CHAR b[4];
INT32 i;
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));
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);
Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
@ -996,11 +972,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, ADDRESS x__len)
void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
INT16 i;
i = 0;
while (x[__X(i, x__len)] != 0x00) {
while (x[i] != 0x00) {
i += 1;
}
Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1);
@ -1009,38 +985,17 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len
void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x)
{
while (x < -64 || x > 63) {
Files_Write(&*R, R__typ, __CHR(__MASK(x, -128) + 128));
Files_Write(&*R, R__typ, (CHAR)(__MASK(x, -128) + 128));
x = __ASHR(x, 7);
}
Files_Write(&*R, R__typ, __CHR(__MASK(x, -128)));
Files_Write(&*R, R__typ, (CHAR)__MASK(x, -128));
}
void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len)
void Files_GetName (Files_File f, CHAR *name, LONGINT 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;
@ -1049,12 +1004,12 @@ static void Files_Finalize (SYSTEM_PTR o)
if (f->fd >= 0) {
Files_CloseOSFile(f);
if (f->tempFile) {
res = Platform_Unlink((void*)f->workName, 256);
res = Platform_Unlink((void*)f->workName, 101);
}
}
}
void Files_SetSearchPath (CHAR *path, ADDRESS path__len)
void Files_SetSearchPath (CHAR *path, LONGINT path__len)
{
__DUP(path, path__len, CHAR);
if (Strings_Length(path, path__len) != 0) {
@ -1068,10 +1023,11 @@ void Files_SetSearchPath (CHAR *path, ADDRESS path__len)
static void EnumPtrs(void (*P)(void*))
{
P(Files_files);
P(Files_SearchPath);
}
__TDESC(Files_FileDesc, 1, 4) = {__TDFLDS("FileDesc", 564), {540, 544, 548, 552, -20}};
__TDESC(Files_FileDesc, 1, 5) = {__TDFLDS("FileDesc", 252), {228, 232, 236, 240, 248, -24}};
__TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4112), {0, -8}};
__TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 20), {8, -8}};
@ -1091,7 +1047,5 @@ 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;
}

35
bootstrap/unix-48/Files.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#ifndef Files__h
#define Files__h
@ -10,8 +10,9 @@ typedef
typedef
struct Files_FileDesc {
INT32 _prvt0;
char _prvt1[560];
char _prvt0[216];
INT32 fd;
char _prvt1[32];
} Files_FileDesc;
typedef
@ -22,48 +23,46 @@ 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, ADDRESS path__len, INT16 *res);
import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
import void Files_Close (Files_File f);
import void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res);
import void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res);
import void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
import void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len);
import void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
import INT32 Files_Length (Files_File f);
import Files_File Files_New (CHAR *name, ADDRESS name__len);
import Files_File Files_Old (CHAR *name, ADDRESS name__len);
import Files_File Files_New (CHAR *name, LONGINT name__len);
import Files_File Files_Old (CHAR *name, LONGINT 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_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_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT 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, ADDRESS x__len);
import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
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_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, ADDRESS x__len);
import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void Files_Register (Files_File f);
import void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res);
import void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT 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, ADDRESS path__len);
import void Files_SetSearchPath (CHAR *path, LONGINT 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, ADDRESS x__len, INT32 n);
import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT 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, ADDRESS x__len);
import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void *Files__init(void);

334
bootstrap/unix-48/Heap.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tsSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -68,10 +68,8 @@ static INT32 Heap_freeList[10];
static INT32 Heap_bigBlocks;
export INT32 Heap_allocated;
static BOOLEAN Heap_firstTry;
static INT16 Heap_ldUnit;
export INT32 Heap_heap;
static INT32 Heap_heapMin, Heap_heapMax;
export INT32 Heap_heapsize, Heap_heapMinExpand;
static INT32 Heap_heap, Heap_heapend;
export INT32 Heap_heapsize;
static Heap_FinNode Heap_fin;
static INT16 Heap_lockdepth;
static BOOLEAN Heap_interrupted;
@ -86,16 +84,15 @@ 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, ADDRESS a__len);
static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len);
export void Heap_INCREF (Heap_Module m);
export void Heap_InitHeap (void);
export void Heap_Lock (void);
static void Heap_Mark (INT32 q);
static void Heap_MarkCandidates (INT32 n, INT32 *cand, ADDRESS cand__len);
static void Heap_MarkCandidates (INT32 n, INT32 *cand, LONGINT cand__len);
static void Heap_MarkP (SYSTEM_PTR p);
static void Heap_MarkStack (INT32 n, INT32 *cand, ADDRESS cand__len);
static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len);
export SYSTEM_PTR Heap_NEWBLK (INT32 size);
export SYSTEM_PTR Heap_NEWREC (INT32 tag);
static INT32 Heap_NewChunk (INT32 blksz);
@ -104,18 +101,16 @@ 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, ADDRESS a__len);
static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len);
export void Heap_Unlock (void);
extern void *Heap__init();
extern ADDRESS Modules_MainStackFrame;
extern ADDRESS Platform_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_uLE(x, y) ((size_t)x <= (size_t)y)
#define Heap_uLT(x, y) ((size_t)x < (size_t)y)
#define Heap_PlatformMainStackFrame() Platform_MainStackFrame
void Heap_Lock (void)
{
@ -148,35 +143,6 @@ 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;
@ -204,24 +170,16 @@ void Heap_INCREF (Heap_Module m)
static INT32 Heap_NewChunk (INT32 blksz)
{
INT32 chnk, blk, end;
INT32 chnk;
chnk = Heap_OSAllocate(blksz + 12);
if (chnk != 0) {
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;
__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;
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;
}
@ -229,28 +187,29 @@ static INT32 Heap_NewChunk (INT32 blksz)
static void Heap_ExtendHeap (INT32 blksz)
{
INT32 size, chnk, j, next;
if (Heap_uLT(Heap_heapMinExpand, blksz)) {
if (blksz > 160000) {
size = blksz;
} else {
size = Heap_heapMinExpand;
size = 160000;
}
chnk = Heap_NewChunk(size);
if (chnk != 0) {
if (Heap_uLT(chnk, Heap_heap)) {
if (chnk < Heap_heap) {
__PUT(chnk, Heap_heap, INT32);
Heap_heap = chnk;
} else {
j = Heap_heap;
__GET(j, next, INT32);
while ((next != 0 && Heap_uLT(next, chnk))) {
while ((next != 0 && chnk > next)) {
j = next;
__GET(j, next, INT32);
}
__PUT(chnk, next, INT32);
__PUT(j, chnk, INT32);
}
} else if (!Heap_firstTry) {
Heap_heapMinExpand = 16;
if (next == 0) {
__GET(chnk + 4, Heap_heapend, INT32);
}
}
}
@ -260,7 +219,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
SYSTEM_PTR new;
Heap_Lock();
__GET(tag, blksz, INT32);
i0 = __LSH(blksz, -Heap_ldUnit, 32);
i0 = __ASHR(blksz, 4);
i = i0;
if (i < 9) {
adr = Heap_freeList[i];
@ -292,17 +251,16 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
if (Heap_firstTry) {
Heap_GC(1);
blksz += 16;
t = __LSH(Heap_allocated + blksz, -(2 + Heap_ldUnit), 32) * 80;
if (Heap_uLT(Heap_heapsize, t)) {
Heap_ExtendHeap(t - Heap_heapsize);
if (__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2) < Heap_heapsize) {
Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize);
}
Heap_firstTry = 0;
new = Heap_NEWREC(tag);
Heap_firstTry = 1;
if (new == NIL) {
Heap_ExtendHeap(blksz);
Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 48), 6) - Heap_heapsize);
new = Heap_NEWREC(tag);
}
Heap_firstTry = 1;
Heap_Unlock();
return new;
} else {
@ -311,7 +269,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
}
}
__GET(adr + 4, t, INT32);
if (Heap_uLE(blksz, t)) {
if (t >= blksz) {
break;
}
prev = adr;
@ -322,7 +280,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
__PUT(end + 4, blksz, INT32);
__PUT(end + 8, -4, INT32);
__PUT(end, end + 4, INT32);
if (Heap_uLT(144, restsize)) {
if (restsize > 144) {
__PUT(adr + 4, restsize, INT32);
} else {
__GET(adr + 12, next, INT32);
@ -331,7 +289,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);
@ -342,7 +300,7 @@ SYSTEM_PTR Heap_NEWREC (INT32 tag)
}
i = adr + 16;
end = adr + blksz;
while (Heap_uLT(i, end)) {
while (i < end) {
__PUT(i, 0, INT32);
__PUT(i + 4, 0, INT32);
__PUT(i + 8, 0, INT32);
@ -439,17 +397,17 @@ static void Heap_Scan (void)
while (chnk != 0) {
adr = chnk + 12;
__GET(chnk + 4, end, INT32);
while (Heap_uLT(adr, end)) {
while (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 = __LSH(freesize, -Heap_ldUnit, 32);
i = __ASHR(freesize, 4);
freesize = 0;
if (Heap_uLT(i, 9)) {
if (i < 9) {
__PUT(start + 12, Heap_freeList[i], INT32);
Heap_freeList[i] = start;
} else {
@ -468,14 +426,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 = __LSH(freesize, -Heap_ldUnit, 32);
i = __ASHR(freesize, 4);
freesize = 0;
if (Heap_uLT(i, 9)) {
if (i < 9) {
__PUT(start + 12, Heap_freeList[i], INT32);
Heap_freeList[i] = start;
} else {
@ -487,19 +445,18 @@ static void Heap_Scan (void)
}
}
static void Heap_Sift (INT32 l, INT32 r, INT32 *a, ADDRESS a__len)
static void Heap_Sift (INT32 l, INT32 r, INT32 *a, LONGINT a__len)
{
INT32 i, j;
INT32 x;
INT32 i, j, x;
j = l;
x = a[j];
for (;;) {
i = j;
j = __ASHL(j, 1) + 1;
if ((j < r && Heap_uLT(a[j], a[j + 1]))) {
if ((j < r && a[j] < a[j + 1])) {
j += 1;
}
if (j > r || Heap_uLE(a[j], x)) {
if (j > r || a[j] <= x) {
break;
}
a[i] = a[j];
@ -507,10 +464,9 @@ static void Heap_Sift (INT32 l, INT32 r, INT32 *a, ADDRESS a__len)
a[i] = x;
}
static void Heap_HeapSort (INT32 n, INT32 *a, ADDRESS a__len)
static void Heap_HeapSort (INT32 n, INT32 *a, LONGINT a__len)
{
INT32 l, r;
INT32 x;
INT32 l, r, x;
l = __ASHR(n, 1);
r = n - 1;
while (l > 0) {
@ -526,42 +482,37 @@ static void Heap_HeapSort (INT32 n, INT32 *a, ADDRESS a__len)
}
}
static void Heap_MarkCandidates (INT32 n, INT32 *cand, ADDRESS cand__len)
static void Heap_MarkCandidates (INT32 n, INT32 *cand, LONGINT cand__len)
{
INT32 chnk, end, adr, tag, next, i, ptr, size;
chnk = Heap_heap;
INT32 chnk, adr, tag, next, lim, lim1, i, ptr, size;
chnk = Heap_heap;
i = 0;
while (chnk != 0) {
__GET(chnk + 4, end, INT32);
lim = cand[n - 1];
while ((chnk != 0 && chnk < lim)) {
adr = chnk + 12;
while (Heap_uLT(adr, end)) {
__GET(chnk + 4, lim1, INT32);
if (lim < lim1) {
lim1 = lim;
}
while (adr < lim1) {
__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;
adr += size;
while (Heap_uLT(cand[i], ptr)) {
while (cand[i] < ptr) {
i += 1;
if (i == n) {
return;
}
}
if (Heap_uLT(cand[i], adr)) {
if (i == n) {
return;
}
next = adr + size;
if (cand[i] < next) {
Heap_Mark(ptr);
}
}
if (Heap_uLE(end, cand[i])) {
adr = end;
adr = next;
}
}
__GET(chnk, chnk, INT32);
@ -620,11 +571,10 @@ void Heap_FINALL (void)
}
}
static void Heap_MarkStack (INT32 n, INT32 *cand, ADDRESS cand__len)
static void Heap_MarkStack (INT32 n, INT32 *cand, LONGINT cand__len)
{
SYSTEM_PTR frame;
INT32 nofcand;
INT32 inc, sp, p, stack0;
INT32 inc, nofcand, sp, p, stack0;
struct Heap__1 align;
if (n > 0) {
Heap_MarkStack(n - 1, cand, cand__len);
@ -635,14 +585,14 @@ static void Heap_MarkStack (INT32 n, INT32 *cand, ADDRESS cand__len)
if (n == 0) {
nofcand = 0;
sp = (ADDRESS)&frame;
stack0 = Heap_ModulesMainStackFrame();
stack0 = Heap_PlatformMainStackFrame();
inc = (ADDRESS)&align.p - (ADDRESS)&align;
if (Heap_uLT(stack0, sp)) {
if (sp > stack0) {
inc = -inc;
}
while (sp != stack0) {
__GET(sp, p, INT32);
if ((Heap_uLE(Heap_heapMin, p) && Heap_uLT(p, Heap_heapMax))) {
if ((p > Heap_heap && p < Heap_heapend)) {
if (nofcand == cand__len) {
Heap_HeapSort(nofcand, (void*)cand, cand__len);
Heap_MarkCandidates(nofcand, (void*)cand, cand__len);
@ -665,77 +615,79 @@ 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];
Heap_Lock();
m = (Heap_Module)(ADDRESS)Heap_modules;
while (m != NIL) {
if (m->enumPtrs != NIL) {
(*m->enumPtrs)(Heap_MarkP);
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;
}
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 (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;
}
}
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();
}
Heap_CheckFin();
Heap_Scan();
Heap_Finalize();
Heap_Unlock();
}
void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
@ -751,21 +703,17 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
void Heap_InitHeap (void)
{
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);
__GET(Heap_heap + 4, Heap_heapend, INT32);
__PUT(Heap_heap, 0, INT32);
Heap_allocated = 0;
Heap_firstTry = 1;
Heap_freeList[9] = 1;
Heap_lockdepth = 0;
Heap_FileCount = 0;
Heap_modules = NIL;
Heap_heapsize = 0;
Heap_bigBlocks = 0;
Heap_fin = NIL;
Heap_interrupted = 0;
Heap_HeapModuleInit();

33
bootstrap/unix-48/Heap.h
View file

@ -1,26 +1,16 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tsSF */
#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));
@ -31,31 +21,22 @@ typedef
struct Heap_ModuleDesc *Heap_Module;
typedef
CHAR Heap_ModuleName[20];
struct Heap_ModuleDesc {
INT32 _prvt0;
char _prvt1[44];
} Heap_ModuleDesc;
typedef
struct Heap_ModuleDesc {
Heap_Module next;
Heap_ModuleName name;
INT32 refcnt;
Heap_Cmd cmds;
INT32 types;
Heap_EnumProc enumPtrs;
char _prvt0[8];
} Heap_ModuleDesc;
CHAR Heap_ModuleName[20];
import SYSTEM_PTR Heap_modules;
import INT32 Heap_allocated;
import INT32 Heap_heap;
import INT32 Heap_heapsize, Heap_heapMinExpand;
import INT32 Heap_allocated, Heap_heapsize;
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);

380
bootstrap/unix-48/Modules.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -9,303 +9,81 @@
#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 Heap_ModuleName Modules_imported, Modules_importing;
export INT32 Modules_MainStackFrame;
export INT16 Modules_ArgCount;
export INT32 Modules_ArgVector;
export CHAR Modules_BinaryDir[1024];
export Modules_ModuleName Modules_imported, Modules_importing;
export ADDRESS *Modules_ModuleDesc__typ;
export ADDRESS *Modules_CmdDesc__typ;
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);
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__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);
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_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
export void Modules_Halt (INT32 code);
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);
export Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
export Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
static void Modules_errch (CHAR c);
static void Modules_errint (INT32 l);
static void Modules_errstring (CHAR *s, ADDRESS s__len);
static void Modules_errstring (CHAR *s, LONGINT s__len);
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
#define Modules_modules() (Modules_Module)Heap_modules
#define Modules_setmodules(m) Heap_modules = m
void Modules_Init (INT32 argc, INT32 argvadr)
{
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;
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;
}
__DEL(s);
return i;
}
static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len)
{
INT16 i, j;
__DUP(s, s__len, CHAR);
__DUP(b, b__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;
}
d[__X(j, d__len)] = 0x00;
__DEL(s);
}
static void Modules_AppendPart (CHAR c, 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);
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)) {
while (a[__X(i, a__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;
while (b[__X(j, b__len)] != 0x00) {
a[__X(i, a__len)] = b[__X(j, b__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);
a[__X(i, a__len)] = 0x00;
__DEL(b);
}
static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__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;
Modules_Module m = NIL;
CHAR bodyname[64];
Heap_Command body;
Modules_Command body;
__DUP(name, name__len, CHAR);
m = Modules_modules();
while ((m != NIL && __STRCMP(m->name, name) != 0)) {
@ -318,16 +96,16 @@ Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len)
Modules_res = 1;
__COPY(name, Modules_importing, 20);
__MOVE(" module \"", Modules_resMsg, 10);
Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
Modules_Append((void*)Modules_resMsg, 256, name, name__len);
Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
}
__DEL(name);
return m;
}
Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len)
Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len)
{
Heap_Cmd c = NIL;
Modules_Cmd c = NIL;
__DUP(name, name__len, CHAR);
c = mod->cmds;
while ((c != NIL && __STRCMP(c->name, name) != 0)) {
@ -342,36 +120,43 @@ Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len
Modules_res = 2;
__MOVE(" command \"", Modules_resMsg, 11);
__COPY(name, Modules_importing, 20);
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);
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);
__DEL(name);
return NIL;
}
__RETCHK;
}
void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all)
void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all)
{
Heap_Module m = NIL, p = NIL;
INT32 refcount;
Modules_Module m = NIL, p = NIL;
__DUP(name, name__len, CHAR);
m = Modules_modules();
if (all) {
Modules_res = 1;
__MOVE("unloading \"all\" not yet supported", Modules_resMsg, 34);
} else {
refcount = Heap_FreeModule(name, name__len);
if (refcount == 0) {
while ((m != NIL && __STRCMP(m->name, name) != 0)) {
p = m;
m = m->next;
}
if ((m != NIL && m->refcnt == 0)) {
if (m == Modules_modules()) {
Modules_setmodules(m->next);
} else {
p->next = m->next;
}
Modules_res = 0;
} else {
if (refcount < 0) {
Modules_res = 1;
if (m == NIL) {
__MOVE("module not found", Modules_resMsg, 17);
} else {
__MOVE("clients of this module exist", Modules_resMsg, 29);
}
Modules_res = 1;
}
}
__DEL(name);
@ -383,7 +168,7 @@ static void Modules_errch (CHAR c)
e = Platform_Write(1, (ADDRESS)&c, 1);
}
static void Modules_errstring (CHAR *s, ADDRESS s__len)
static void Modules_errstring (CHAR *s, LONGINT s__len)
{
INT32 i;
__DUP(s, s__len, CHAR);
@ -404,7 +189,7 @@ static void Modules_errint (INT32 l)
if (l >= 10) {
Modules_errint(__DIV(l, 10));
}
Modules_errch(__CHR((int)__MOD(l, 10) + 48));
Modules_errch((CHAR)((int)__MOD(l, 10) + 48));
}
static void Modules_DisplayHaltCode (INT32 code)
@ -465,7 +250,6 @@ 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);
@ -478,7 +262,6 @@ 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);
@ -486,13 +269,11 @@ void Modules_AssertFail (INT32 code)
Modules_errstring((CHAR*)".", 2);
}
Modules_errstring(Platform_NL, 3);
if (code > 0) {
Platform_Exit(code);
} else {
Platform_Exit(-1);
}
Platform_Exit(code);
}
__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)
{
@ -500,7 +281,8 @@ 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;
}

51
bootstrap/unix-48/Modules.h
View file

@ -1,30 +1,53 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Modules__h
#define Modules__h
#include "SYSTEM.h"
#include "Heap.h"
typedef
struct Modules_CmdDesc *Modules_Cmd;
typedef
void (*Modules_Command)(void);
typedef
struct Modules_CmdDesc {
Modules_Cmd next;
CHAR name[24];
Modules_Command cmd;
} Modules_CmdDesc;
typedef
struct Modules_ModuleDesc *Modules_Module;
typedef
CHAR Modules_ModuleName[20];
typedef
struct Modules_ModuleDesc {
Modules_Module next;
Modules_ModuleName name;
INT32 refcnt;
Modules_Cmd cmds;
INT32 types;
void (*enumPtrs)(void(*)(INT32));
char _prvt0[8];
} Modules_ModuleDesc;
import INT16 Modules_res;
import CHAR Modules_resMsg[256];
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 Modules_ModuleName Modules_imported, Modules_importing;
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, 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_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
import void Modules_Halt (INT32 code);
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 Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
import Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
import void *Modules__init(void);

43
bootstrap/unix-48/OPB.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#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();
__MOVE(str, *x->conval->ext, 256);
__COPY(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 = __CHR(n->conval->intval);
ch = (CHAR)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 == (-9223372036854775807LL-1)) {
if (z->conval->intval == (-9223372036854775807-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 == (-9223372036854775807LL-1)) {
if (z->conval->intval == (-9223372036854775807-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(__CHR(z->conval->intval));
z->conval->intval = (INT16)__CAP((CHAR)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(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))) {
if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807-1))) && yv != (-9223372036854775807-1))) && -xv <= __DIV(9223372036854775807, -yv))) {
xval->intval = xv * yv;
OPB_SetIntType(x);
} else {
@ -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 <= 9223372036854775807LL - yval->intval);
if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807LL-1) - yval->intval)) {
temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807 - yval->intval);
if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807-1) - yval->intval)) {
xval->intval += yval->intval;
OPB_SetIntType(x);
} else {
@ -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 >= (-9223372036854775807LL-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807LL + yval->intval)) {
if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807 + yval->intval)) {
xval->intval -= yval->intval;
OPB_SetIntType(x);
} else {
@ -1136,7 +1136,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
OPB_err(203);
r = (LONGREAL)1;
}
(*x)->conval->intval = __SHORT(__ENTIER(r), 2147483648LL);
(*x)->conval->intval = (INT32)__ENTIER(r);
OPB_SetIntType(*x);
}
}
@ -1624,20 +1624,23 @@ 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) {
@ -2088,7 +2091,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(9223372036854775807LL, (INT64)__ASH(1, x->conval->intval))) {
if (__ABS(p->conval->intval) <= __DIV(9223372036854775807, (INT64)__ASH(1, x->conval->intval))) {
p->conval->intval = p->conval->intval * (INT64)__ASH(1, x->conval->intval);
} else {
OPB_err(208);
@ -2533,6 +2536,7 @@ 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);
}
@ -2558,8 +2562,13 @@ 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 = 0;
(*x)->subcl = subcl;
}
void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ)
@ -2586,7 +2595,7 @@ export void *OPB__init(void)
__MODULE_IMPORT(OPT);
__REGMOD("OPB", 0);
/* BEGIN */
OPB_maxExp = OPB_log(4611686018427387904LL);
OPB_maxExp = OPB_log(4611686018427387904);
OPB_maxExp = OPB_exp;
__ENDMOD;
}

2
bootstrap/unix-48/OPB.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPB__h
#define OPB__h

127
bootstrap/unix-48/OPC.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#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, ADDRESS name__len);
static void OPC_Include (CHAR *name, LONGINT 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, ADDRESS s__len);
static INT16 OPC_Length (CHAR *s, LONGINT s__len);
export BOOLEAN OPC_NeedsRetval (OPT_Object proc);
export INT32 OPC_NofPtrs (OPT_Struct typ);
static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len);
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len);
static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len);
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len);
static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define);
static void OPC_ProcPredefs (OPT_Object obj, 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, ADDRESS s__len, INT32 x);
static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l);
static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x);
static void OPC_StringLiteral (CHAR *s, LONGINT 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, ADDRESS s__len, INT32 x)
static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
{
CHAR ch;
INT16 i;
@ -156,7 +156,7 @@ static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x)
__DEL(s);
}
static INT16 OPC_Length (CHAR *s, ADDRESS s__len)
static INT16 OPC_Length (CHAR *s, LONGINT s__len)
{
INT16 i;
i = 0;
@ -166,7 +166,7 @@ static INT16 OPC_Length (CHAR *s, ADDRESS s__len)
return i;
}
static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len)
static INT16 OPC_PerfectHash (CHAR *s, LONGINT 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*)"ADDRESS len[#]", 15, nofdims);
OPC_Str1((CHAR*)"LONGINT 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*)", ADDRESS ", 11);
OPM_WriteString((CHAR*)", LONGINT ", 11);
} else {
OPM_WriteString((CHAR*)", ", 3);
}
@ -618,33 +618,31 @@ 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))) {
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);
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);
OPM_Write(')');
OPM_WriteLn();
} 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(')');
OPM_WriteLn();
}
OPC_DefineTProcMacros(obj->right, &*empty);
}
@ -654,7 +652,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) || (((OPM_currFile == 0 && str->strobj != NIL)) && str->strobj->vis == 1)) {
if (OPM_currFile == 1 || str->ref < 255) {
obj = str->strobj;
if (obj == NIL || OPC_Undefined(obj)) {
if (obj != NIL) {
@ -683,10 +681,6 @@ 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) {
@ -721,19 +715,12 @@ 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, ADDRESS y__len)
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len)
{
INT16 i;
__DUP(y, y__len, CHAR);
@ -981,8 +968,8 @@ static void OPC_IdentList (OPT_Object obj, INT16 vis)
if (obj->typ->comp == 3) {
OPC_EndStat();
OPC_BegStat();
base = OPT_adrtyp;
OPM_WriteString((CHAR*)"ADDRESS ", 9);
base = OPT_linttyp;
OPM_WriteString((CHAR*)"LONGINT ", 9);
OPC_LenList(obj, 0, 1);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPC_EndStat();
@ -1021,7 +1008,7 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
__COPY(name, obj->name, 256);
}
if (obj->typ->comp == 3) {
OPM_WriteString((CHAR*)", ADDRESS ", 11);
OPM_WriteString((CHAR*)", LONGINT ", 11);
OPC_LenList(obj, 1, showParamNames);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPM_WriteString((CHAR*)", ADDRESS *", 12);
@ -1075,7 +1062,7 @@ static void OPC_ProcPredefs (OPT_Object obj, INT8 vis)
}
}
static void OPC_Include (CHAR *name, ADDRESS name__len)
static void OPC_Include (CHAR *name, LONGINT name__len)
{
__DUP(name, name__len, CHAR);
OPM_WriteString((CHAR*)"#include ", 10);
@ -1151,7 +1138,7 @@ static void OPC_GenHeaderMsg (void)
OPM_WriteString((CHAR*)"/* ", 4);
OPM_WriteString((CHAR*)"voc", 4);
OPM_Write(' ');
OPM_WriteString(Configuration_versionLong, 76);
OPM_WriteString(Configuration_versionLong, 75);
OPM_Write(' ');
i = 0;
while (i <= 31) {
@ -1672,9 +1659,9 @@ void OPC_CompleteIdent (OPT_Object obj)
OPC_Ident(obj);
OPM_WriteString((CHAR*)"__", 3);
} else {
OPM_WriteString((CHAR*)"(*(", 4);
OPM_WriteString((CHAR*)"((", 3);
OPC_Ident(obj->typ->strobj);
OPM_WriteString((CHAR*)"*)&", 4);
OPM_Write(')');
OPC_Ident(obj);
OPM_Write(')');
}
@ -1752,12 +1739,12 @@ static void OPC_CharacterLiteral (INT64 c)
if ((c == 92 || c == 39) || c == 63) {
OPM_Write('\\');
}
OPM_Write(__CHR(c));
OPM_Write((CHAR)c);
OPM_Write('\'');
}
}
static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l)
{
INT32 i;
INT16 c;
@ -1768,16 +1755,16 @@ static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
c = (INT16)s[__X(i, s__len)];
if (c < 32 || c > 126) {
OPM_Write('\\');
OPM_Write(__CHR(48 + __ASHR(c, 6)));
OPM_Write((CHAR)(48 + __ASHR(c, 6)));
c = __MASK(c, -64);
OPM_Write(__CHR(48 + __ASHR(c, 3)));
OPM_Write((CHAR)(48 + __ASHR(c, 3)));
c = __MASK(c, -8);
OPM_Write(__CHR(48 + c));
OPM_Write((CHAR)(48 + c));
} else {
if ((c == 92 || c == 34) || c == 63) {
OPM_Write('\\');
}
OPM_Write(__CHR(c));
OPM_Write((CHAR)c);
}
i += 1;
}
@ -1843,12 +1830,6 @@ 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);
@ -1856,6 +1837,10 @@ 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);
}
}
@ -1927,9 +1912,9 @@ static struct InitKeywords__46 {
struct InitKeywords__46 *lnk;
} *InitKeywords__46_s;
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)
static void Enter__47 (CHAR *s, LONGINT s__len)
{
INT16 h;
__DUP(s, s__len, CHAR);

2
bootstrap/unix-48/OPC.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPC__h
#define OPC__h

330
bootstrap/unix-48/OPM.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -8,7 +8,6 @@
#include "SYSTEM.h"
#include "Configuration.h"
#include "Files.h"
#include "Modules.h"
#include "Out.h"
#include "Platform.h"
#include "Strings.h"
@ -19,8 +18,6 @@ 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];
@ -29,7 +26,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, OPM_SetSize;
export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize;
export INT64 OPM_MaxIndex;
export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
export BOOLEAN OPM_noerr;
@ -44,48 +41,41 @@ 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_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
export void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
export void OPM_DeleteNewSym (void);
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, ADDRESS bytes__len);
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len);
export void OPM_Get (CHAR *ch);
export void OPM_GetComment (CHAR *text, ADDRESS text__len);
export void OPM_Init (BOOLEAN *done);
export void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
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, ADDRESS vt100code__len);
export void OPM_LogVT100 (CHAR *vt100code, LONGINT 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, ADDRESS s__len);
export void OPM_LogWStr (CHAR *s, LONGINT s__len);
export INT32 OPM_Longint (INT64 n);
static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len);
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len);
export void OPM_Mark (INT16 n, INT32 pos);
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 void OPM_NewSym (CHAR *modName, LONGINT modName__len);
export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
export BOOLEAN OPM_OpenPar (void);
export void OPM_RegisterNewSym (void);
static void OPM_ScanOptions (CHAR *s, ADDRESS s__len);
static void OPM_ScanOptions (CHAR *s, LONGINT 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);
@ -97,13 +87,14 @@ 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, ADDRESS s__len);
export void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
export void OPM_WriteString (CHAR *s, LONGINT s__len);
export void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
export BOOLEAN OPM_eofSF (void);
export void OPM_err (INT16 n);
@ -114,7 +105,7 @@ void OPM_LogW (CHAR ch)
Out_Char(ch);
}
void OPM_LogWStr (CHAR *s, ADDRESS s__len)
void OPM_LogWStr (CHAR *s, LONGINT s__len)
{
__DUP(s, s__len, CHAR);
Out_String(s, s__len);
@ -131,7 +122,7 @@ void OPM_LogWLn (void)
Out_Ln();
}
void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len)
void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
{
__DUP(vt100code, vt100code__len, CHAR);
if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) {
@ -140,57 +131,6 @@ void OPM_LogVT100 (CHAR *vt100code, ADDRESS 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;
@ -214,7 +154,7 @@ INT16 OPM_Integer (INT64 n)
return __VAL(INT16, n);
}
static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
@ -287,6 +227,29 @@ static void OPM_ScanOptions (CHAR *s, ADDRESS 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('-');
@ -303,19 +266,16 @@ static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
BOOLEAN OPM_OpenPar (void)
{
CHAR s[256];
if (Modules_ArgCount == 1) {
if (Platform_ArgCount == 1) {
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20);
OPM_LogWStr(Configuration_versionLong, 76);
OPM_LogWStr(Configuration_versionLong, 75);
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();
@ -372,7 +332,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 and SET, 64 bit LONGINT.", 95);
OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
OPM_LogWLn();
@ -402,38 +362,64 @@ BOOLEAN OPM_OpenPar (void)
OPM_Options = 0xa9;
OPM_S = 1;
s[0] = 0x00;
Modules_GetArg(OPM_S, (void*)s, 256);
Platform_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
Modules_GetArg(OPM_S, (void*)s, 256);
Platform_GetArg(OPM_S, (void*)s, 256);
}
OPM_GlobalAddressSize = OPM_AddressSize;
OPM_GlobalAlignment = OPM_Alignment;
__MOVE(OPM_Model, OPM_GlobalModel, 10);
__COPY(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;
__MOVE(OPM_GlobalModel, OPM_Model, 10);
__COPY(OPM_GlobalModel, OPM_Model, 10);
OPM_Alignment = OPM_GlobalAlignment;
OPM_AddressSize = OPM_GlobalAddressSize;
s[0] = 0x00;
Modules_GetArg(OPM_S, (void*)s, 256);
Platform_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
Modules_GetArg(OPM_S, (void*)s, 256);
Platform_GetArg(OPM_S, (void*)s, 256);
}
if (__IN(15, OPM_Options, 32)) {
OPM_Options |= __SETOF(10,32);
@ -444,32 +430,29 @@ void OPM_InitOptions (void)
OPM_ShortintSize = 1;
OPM_IntegerSize = 2;
OPM_LongintSize = 4;
OPM_SetSize = 4;
break;
case 'C':
OPM_ShortintSize = 2;
OPM_IntegerSize = 4;
OPM_LongintSize = 8;
OPM_SetSize = 4;
break;
case 'V':
OPM_ShortintSize = 1;
OPM_IntegerSize = 4;
OPM_LongintSize = 8;
OPM_SetSize = 8;
break;
default:
OPM_ShortintSize = 1;
OPM_IntegerSize = 2;
OPM_LongintSize = 4;
OPM_SetSize = 4;
break;
}
__MOVE(OPM_InstallDir, OPM_ResourceDir, 1024);
if (OPM_ResourceDir[0] != 0x00) {
Strings_Append((CHAR*)"/", 2, (void*)OPM_ResourceDir, 1024);
Strings_Append(OPM_Model, 10, (void*)OPM_ResourceDir, 1024);
if (__IN(18, OPM_Options, 32)) {
OPM_VerboseListSizes();
}
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);
@ -482,22 +465,23 @@ void OPM_InitOptions (void)
Files_SetSearchPath(searchpath, 1024);
}
void OPM_Init (BOOLEAN *done)
void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
{
Texts_Text T = NIL;
INT32 beg, end, time;
CHAR s[256];
*done = 0;
OPM_curpos = 0;
if (OPM_S >= Modules_ArgCount) {
if (OPM_S >= Platform_ArgCount) {
return;
}
s[0] = 0x00;
Modules_GetArg(OPM_S, (void*)s, 256);
Platform_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);
@ -519,14 +503,18 @@ void OPM_Init (BOOLEAN *done)
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, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len)
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len)
{
INT16 i, j;
CHAR ch;
@ -644,7 +632,7 @@ static void OPM_ShowLine (INT64 pos)
if (pos >= (INT64)OPM_ErrorLineLimitPos) {
pos = OPM_ErrorLineLimitPos - 1;
}
i = __SHORTF(OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos), 32768);
i = (INT16)OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos);
while (i > 0) {
OPM_LogW(' ');
i -= 1;
@ -652,6 +640,7 @@ 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)
@ -711,7 +700,7 @@ void OPM_err (INT16 n)
OPM_Mark(n, OPM_errpos);
}
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len)
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len)
{
INT16 i;
INT32 l;
@ -783,13 +772,10 @@ void OPM_CloseOldSym (void)
Files_Close(Files_Base(&OPM_oldSF, Files_Rider__typ));
}
void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done)
void OPM_OldSym (CHAR *modName, LONGINT 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;
@ -797,10 +783,8 @@ void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done)
Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, 0);
Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&tag);
Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ver);
if (tag != 0xf7 || ver != 0x84) {
if (!__IN(4, OPM_Options, 32)) {
OPM_err(-306);
}
if (tag != 0xf7 || ver != 0x82) {
OPM_err(-306);
OPM_CloseOldSym();
*done = 0;
}
@ -844,23 +828,11 @@ void OPM_RegisterNewSym (void)
}
}
void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len)
void OPM_DeleteNewSym (void)
{
OPM_FileName fn;
INT16 res;
OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".sym", 5);
Files_Delete(fn, 32, &res);
}
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)
void OPM_NewSym (CHAR *modName, LONGINT modName__len)
{
OPM_FileName fileName;
OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
@ -868,7 +840,7 @@ void OPM_NewSym (CHAR *modName, ADDRESS modName__len)
if (OPM_newSFile != NIL) {
Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, 0);
Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7);
Files_Write(&OPM_newSF, Files_Rider__typ, 0x84);
Files_Write(&OPM_newSF, Files_Rider__typ, 0x82);
} else {
OPM_err(153);
}
@ -879,7 +851,7 @@ void OPM_Write (CHAR ch)
Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, ch);
}
void OPM_WriteString (CHAR *s, ADDRESS s__len)
void OPM_WriteString (CHAR *s, LONGINT s__len)
{
INT16 i;
i = 0;
@ -889,7 +861,7 @@ void OPM_WriteString (CHAR *s, ADDRESS s__len)
Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}
void OPM_WriteStringVar (CHAR *s, ADDRESS s__len)
void OPM_WriteStringVar (CHAR *s, LONGINT s__len)
{
INT16 i;
i = 0;
@ -903,17 +875,17 @@ void OPM_WriteHex (INT64 i)
{
CHAR s[3];
INT32 digit;
digit = __ASHR(__SHORT(i, 2147483648LL), 4);
digit = __ASHR((INT32)i, 4);
if (digit < 10) {
s[0] = __CHR(48 + digit);
s[0] = (CHAR)(48 + digit);
} else {
s[0] = __CHR(87 + digit);
s[0] = (CHAR)(87 + digit);
}
digit = __MASK(__SHORT(i, 2147483648LL), -16);
digit = __MASK((INT32)i, -16);
if (digit < 10) {
s[1] = __CHR(48 + digit);
s[1] = (CHAR)(48 + digit);
} else {
s[1] = __CHR(87 + digit);
s[1] = (CHAR)(87 + digit);
}
s[2] = 0x00;
OPM_WriteString(s, 3);
@ -921,7 +893,7 @@ void OPM_WriteHex (INT64 i)
void OPM_WriteInt (INT64 i)
{
CHAR s[26];
CHAR s[24];
INT64 i1, k;
if ((i == OPM_SignedMinimum(2) || i == OPM_SignedMinimum(4)) || i == OPM_SignedMinimum(8)) {
OPM_Write('(');
@ -929,27 +901,21 @@ void OPM_WriteInt (INT64 i)
OPM_WriteString((CHAR*)"-1)", 4);
} else {
i1 = __ABS(i);
if (i1 <= 2147483647) {
k = 0;
} else {
__MOVE("LL", s, 3);
k = 2;
}
s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
s[0] = (CHAR)(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k += 1;
k = 1;
while (i1 > 0) {
s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
s[__X(k, 24)] = (CHAR)(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k += 1;
}
if (i < 0) {
s[__X(k, 26)] = '-';
s[__X(k, 24)] = '-';
k += 1;
}
while (k > 0) {
k -= 1;
OPM_Write(s[__X(k, 26)]);
OPM_Write(s[__X(k, 24)]);
}
}
}
@ -962,13 +928,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 == (__SHORT(__ENTIER(r), 2147483648LL)))) {
if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == ((INT32)__ENTIER(r)))) {
if (suffx == 'f') {
OPM_WriteString((CHAR*)"(REAL)", 7);
} else {
OPM_WriteString((CHAR*)"(LONGREAL)", 11);
}
OPM_WriteInt(__SHORT(__ENTIER(r), 2147483648LL));
OPM_WriteInt((INT32)__ENTIER(r));
} else {
Texts_OpenWriter(&W, Texts_Writer__typ);
if (suffx == 'f') {
@ -1020,9 +986,9 @@ static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F)
}
}
void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len)
void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
{
OPM_FileName FName;
CHAR FName[32];
__COPY(moduleName, OPM_modName, 32);
OPM_HFile = Files_New((CHAR*)"", 1);
if (OPM_HFile != NIL) {
@ -1048,7 +1014,7 @@ void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len)
void OPM_CloseFiles (void)
{
OPM_FileName FName;
CHAR FName[32];
INT16 res;
if (OPM_noerr) {
OPM_LogWStr((CHAR*)" ", 3);
@ -1084,59 +1050,6 @@ 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);
@ -1158,7 +1071,6 @@ export void *OPM__init(void)
__DEFMOD;
__MODULE_IMPORT(Configuration);
__MODULE_IMPORT(Files);
__MODULE_IMPORT(Modules);
__MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
@ -1167,6 +1079,7 @@ 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);
@ -1176,8 +1089,5 @@ 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;
}

27
bootstrap/unix-48/OPM.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#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, OPM_SetSize;
import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize;
import INT64 OPM_MaxIndex;
import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
import BOOLEAN OPM_noerr;
@ -17,39 +17,34 @@ 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_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
import void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
import void OPM_DeleteNewSym (void);
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_GetComment (CHAR *text, ADDRESS text__len);
import void OPM_Init (BOOLEAN *done);
import void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
import void OPM_InitOptions (void);
import INT16 OPM_Integer (INT64 n);
import void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len);
import void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len);
import void OPM_LogVT100 (CHAR *vt100code, LONGINT 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, ADDRESS s__len);
import void OPM_LogWStr (CHAR *s, LONGINT s__len);
import INT32 OPM_Longint (INT64 n);
import void OPM_Mark (INT16 n, INT32 pos);
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 void OPM_NewSym (CHAR *modName, LONGINT modName__len);
import void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
import void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
import BOOLEAN OPM_OpenPar (void);
import void OPM_RegisterNewSym (void);
import 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);
@ -66,8 +61,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, ADDRESS s__len);
import void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
import void OPM_WriteString (CHAR *s, LONGINT s__len);
import void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
import BOOLEAN OPM_eofSF (void);
import void OPM_err (INT16 n);
import void *OPM__init(void);

43
bootstrap/unix-48/OPP.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#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) {
__MOVE(OPS_name, name, 256);
__COPY(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 = __SHORT(__SHORT((*x)->obj->adr, 32768), 128);
m = (INT8)((INT16)(*x)->obj->adr);
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;
}
__MOVE(OPS_name, name, 256);
__COPY(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] = __CHR(n);
(*ext)[0] = (CHAR)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)] = __CHR(c);
(*ext)[__X(n, 256)] = (CHAR)c;
}
if (OPP_sym == 19) {
OPS_Get(&OPP_sym);
} else if (OPP_sym == 35) {
OPP_err(19);
} else {
(*ext)[0] = __CHR(n);
(*ext)[0] = (CHAR)n;
break;
}
}
@ -1030,7 +1030,7 @@ static void TProcDecl__23 (void)
}
OPP_Receiver(&objMode, objName, &objTyp, &recTyp);
if (OPP_sym == 38) {
__MOVE(OPS_name, *ProcedureDeclaration__16_s->name, 256);
__COPY(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);
__MOVE(OPS_name, name, 256);
__COPY(OPS_name, name, 256);
OPP_CheckMark(&vis);
if ((vis != 0 && mode == 6)) {
mode = 7;
@ -1665,9 +1665,6 @@ 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) {
@ -1793,10 +1790,30 @@ 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_LogCompiling(OPS_name, 256);
OPM_LogWStr((CHAR*)"compiling ", 11);
OPM_LogWStr(OPS_name, 256);
OPM_LogW('.');
OPT_Init(OPS_name, opt);
OPS_Get(&OPP_sym);
OPP_CheckSym(39);

2
bootstrap/unix-48/OPP.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPP__h
#define OPP__h

100
bootstrap/unix-48/OPS.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -56,11 +56,11 @@ static void OPS_Str (INT8 *sym)
OPS_err(241);
break;
}
OPS_str[__X(i, 256)] = OPS_ch;
OPS_str[i] = OPS_ch;
i += 1;
}
OPM_Get(&OPS_ch);
OPS_str[__X(i, 256)] = 0x00;
OPS_str[i] = 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[__X(i, 256)] = OPS_ch;
OPS_name[i] = OPS_ch;
i += 1;
OPM_Get(&OPS_ch);
} while (!(((OPS_ch < '0' || ('9' < OPS_ch && __CAP(OPS_ch) < 'A')) || 'Z' < __CAP(OPS_ch)) || i == 256));
@ -84,7 +84,7 @@ static void OPS_Identifier (INT8 *sym)
OPS_err(240);
i -= 1;
}
OPS_name[__X(i, 256)] = 0x00;
OPS_name[i] = 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[__X(n, 24)] = OPS_ch;
dig[n] = 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[__X(i, 24)], 1);
OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 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[__X(i, 24)], 1);
OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1);
i += 1;
}
} else {
@ -196,9 +196,9 @@ static void OPS_Number (void)
} else {
OPS_numtyp = 2;
while (i < n) {
d = Ord__7(dig[__X(i, 24)], 0);
d = Ord__7(dig[i], 0);
i += 1;
if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) {
if (OPS_intval <= __DIV(9223372036854775807 - (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[__X(n, 24)], 0) + f) / (LONGREAL)(LONGREAL)10;
f = (Ord__7(dig[n], 0) + f) / (LONGREAL)(LONGREAL)10;
}
if (OPS_ch == 'E' || OPS_ch == 'D') {
expCh = OPS_ch;
@ -279,74 +279,32 @@ 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);
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) {
for (;;) {
for (;;) {
while (OPS_ch == '(') {
OPM_Get(&OPS_ch);
} else {
prevCh = 0x00;
}
} else {
if ((((isExported && nestLevel == 1)) && prevCh != 0x00)) {
if (i < 255) {
commentText[__X(i, 256)] = prevCh;
i += 1;
if (OPS_ch == '*') {
Comment__2();
}
}
prevCh = OPS_ch;
}
if (nestLevel > 0) {
if (OPS_ch == '*') {
OPM_Get(&OPS_ch);
break;
}
if (OPS_ch == 0x00) {
break;
}
OPM_Get(&OPS_ch);
}
}
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 == ')') {
OPM_Get(&OPS_ch);
break;
}
}
if (isExported) {
if (i >= 256) {
OPM_LogWStr((CHAR*)"Warning: commentText overflow", 30);
OPM_LogWLn();
i = 255;
if (OPS_ch == 0x00) {
OPS_err(5);
break;
}
commentText[__X(i, 256)] = 0x00;
OPM_StoreComment(commentText, 256);
}
}

2
bootstrap/unix-48/OPS.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#ifndef OPS__h
#define OPS__h

195
bootstrap/unix-48/OPT.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -49,15 +49,6 @@ 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;
@ -83,7 +74,6 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@ -111,7 +101,6 @@ 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;
@ -119,7 +108,6 @@ 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);
@ -132,7 +120,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, ADDRESS name__len);
static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT 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);
@ -143,9 +131,8 @@ 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, ADDRESS name__len);
static void OPT_InName (CHAR *name, LONGINT 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);
@ -167,14 +154,12 @@ 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, ADDRESS name__len);
static void OPT_OutName (CHAR *name, LONGINT name__len);
static void OPT_OutObj (OPT_Object obj);
static void OPT_OutSign (OPT_Struct result, OPT_Object par);
static void OPT_OutStr (OPT_Struct typ);
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj);
static void OPT_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);
@ -354,7 +339,7 @@ void OPT_TypSize (OPT_Struct typ)
}
typ->size = offset;
typ->align = base;
typ->sysflag = __MASK(typ->sysflag, -256) + __SHORT(__ASHL(offset - off0, 8), 32768);
typ->sysflag = __MASK(typ->sysflag, -256) + (INT16)__ASHL(offset - off0, 8);
} else if (c == 2) {
OPT_TypSize(typ->BaseTyp);
typ->size = typ->n * typ->BaseTyp->size;
@ -390,10 +375,6 @@ 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;
}
@ -453,16 +434,14 @@ void OPT_Init (OPS_Name name, UINT32 opt)
OPT_topScope = OPT_universe;
OPT_OpenScope(0, NIL);
OPT_SYSimported = 0;
__MOVE(name, OPT_SelfName, 256);
__MOVE(name, OPT_topScope->name, 256);
__COPY(name, OPT_SelfName, 256);
__COPY(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)
@ -560,8 +539,6 @@ 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;
@ -593,23 +570,13 @@ 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, ADDRESS name__len)
static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len)
{
INT16 i;
CHAR ch;
@ -990,7 +957,7 @@ void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old)
}
}
static void OPT_InName (CHAR *name, ADDRESS name__len)
static void OPT_InName (CHAR *name, LONGINT name__len)
{
INT16 i;
CHAR ch;
@ -1044,26 +1011,6 @@ 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;
@ -1121,13 +1068,6 @@ 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) {
@ -1246,7 +1186,7 @@ static void OPT_InStruct (OPT_Struct *typ)
}
*typ = OPT_NewStr(0, 1);
} else {
__MOVE(name, obj->name, 256);
__COPY(name, obj->name, 256);
OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
if (old != NIL) {
OPT_FPrintObj(old);
@ -1276,7 +1216,7 @@ static void OPT_InStruct (OPT_Struct *typ)
obj->vis = 0;
tag = OPM_SymRInt();
if (tag == 35) {
(*typ)->sysflag = __SHORTF(OPM_SymRInt(), 32768);
(*typ)->sysflag = (INT16)OPM_SymRInt();
tag = OPM_SymRInt();
}
switch (tag) {
@ -1406,37 +1346,7 @@ 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;
@ -1452,7 +1362,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 && tag <= 33)) {
} else if (tag >= 31) {
obj->conval = OPT_NewConst();
obj->conval->intval = -1;
OPT_InSign(mno, &obj->typ, &obj->link);
@ -1467,8 +1377,8 @@ static OPT_Object OPT_InObj (INT8 mno)
obj->mode = 9;
ext = OPT_NewExt();
obj->conval->ext = ext;
s = __SHORTF(OPM_SymRInt(), 32768);
(*ext)[0] = __CHR(s);
s = (INT16)OPM_SymRInt();
(*ext)[0] = (CHAR)s;
i = 1;
while (i <= s) {
OPM_SymRCh(&(*ext)[__X(i, 256)]);
@ -1479,37 +1389,20 @@ 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 if (tag == 21 || tag == 22) {
} else {
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);
@ -1565,15 +1458,9 @@ 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;
if ((OPT_impCtxt.self && __IN(17, OPM_Options, 32))) {
OPM_DeleteSym((void*)name, 256);
*done = 0;
} else {
OPM_OldSym((void*)name, 256, &*done);
}
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);
@ -1596,7 +1483,7 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
}
}
static void OPT_OutName (CHAR *name, ADDRESS name__len)
static void OPT_OutName (CHAR *name, LONGINT name__len)
{
INT16 i;
CHAR ch;
@ -1620,17 +1507,6 @@ 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;
@ -1824,7 +1700,7 @@ static void OPT_OutConstant (OPT_Object obj)
OPM_SymWInt(f);
switch (f) {
case 2: case 3:
OPM_SymWCh(__CHR(obj->conval->intval));
OPM_SymWCh((CHAR)obj->conval->intval);
break;
case 4:
OPM_SymWInt(obj->conval->intval);
@ -1852,40 +1728,13 @@ 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) {
@ -1984,7 +1833,6 @@ 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;
@ -2006,7 +1854,7 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
OPT_newsf = 0;
OPT_symNew = 0;
if (!OPM_noerr || OPT_findpc) {
OPM_DeleteSym((void*)OPT_SelfName, 256);
OPM_DeleteNewSym();
}
}
}
@ -2121,11 +1969,10 @@ 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, 7) = {__TDFLDS("ObjDesc", 308), {0, 4, 8, 12, 284, 288, 304, -32}};
__TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 304), {0, 4, 8, 12, 284, 288, -28}};
__TDESC(OPT_StrDesc, 1, 3) = {__TDFLDS("StrDesc", 56), {44, 48, 52, -16}};
__TDESC(OPT_NodeDesc, 1, 6) = {__TDFLDS("NodeDesc", 28), {0, 4, 8, 16, 20, 24, -28}};
__TDESC(OPT_ImpCtxt, 1, 510) = {__TDFLDS("ImpCtxt", 3140), {16, 20, 24, 28, 32, 36, 40, 44, 48, 52, 56, 60, 64, 68, 72, 76,
@ -2161,7 +2008,6 @@ __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)
{
@ -2178,7 +2024,6 @@ 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);

14
bootstrap/unix-48/OPT.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPT__h
#define OPT__h
@ -21,15 +21,6 @@ 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;
@ -61,7 +52,6 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@ -85,13 +75,11 @@ 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);

41
bootstrap/unix-48/OPV.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#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)] = __CHR((int)__MOD(j, 10) + 48);
n[__X(k, 10)] = (CHAR)((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;
__MOVE(obj->name, scope->name, 256);
__COPY(obj->name, scope->name, 256);
OPV_Stamp(scope->name);
if (mode == 9) {
obj->adr = 1;
@ -317,27 +317,15 @@ 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)) {
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);
}
OPV_design(n->left, 10);
OPM_WriteString((CHAR*)"->len[", 7);
OPM_WriteInt(dim);
OPM_Write(']');
} else {
OPC_Len(n->obj, n->typ, dim);
}
@ -382,7 +370,6 @@ static void OPV_SizeCast (OPT_Node n, INT32 to)
OPM_WriteInt(__ASHL(to, 3));
OPM_WriteString((CHAR*)")", 2);
}
OPV_Entier(n, 9);
}
}
@ -394,6 +381,7 @@ 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);
@ -403,6 +391,7 @@ 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);
@ -1194,7 +1183,7 @@ static void OPV_NewArr (OPT_Node d, OPT_Node x)
base = base->BaseTyp;
}
if ((base->comp == 4 && OPC_NofPtrs(base) != 0)) {
OPC_Andent(base);
OPC_Ident(base->strobj);
OPM_WriteString((CHAR*)"__typ", 6);
} else if (base->form == 11) {
OPM_WriteString((CHAR*)"POINTER__typ", 13);
@ -1297,17 +1286,7 @@ 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(')');

2
bootstrap/unix-48/OPV.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPV__h
#define OPV__h

61
bootstrap/unix-48/Out.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -6,7 +6,6 @@
#define SET UINT32
#include "SYSTEM.h"
#include "Heap.h"
#include "Platform.h"
@ -17,18 +16,17 @@ 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, ADDRESS s__len);
static INT32 Out_Length (CHAR *s, LONGINT 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, ADDRESS str__len);
export void Out_String (CHAR *str, LONGINT str__len);
export LONGREAL Out_Ten (INT16 e);
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);
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);
#define Out_Entier64(x) (INT64)(x)
@ -57,7 +55,7 @@ void Out_Char (CHAR ch)
}
}
static INT32 Out_Length (CHAR *s, ADDRESS s__len)
static INT32 Out_Length (CHAR *s, LONGINT s__len)
{
INT32 l;
l = 0;
@ -67,7 +65,7 @@ static INT32 Out_Length (CHAR *s, ADDRESS s__len)
return l;
}
void Out_String (CHAR *str, ADDRESS str__len)
void Out_String (CHAR *str, LONGINT str__len)
{
INT32 l;
INT16 error;
@ -80,7 +78,7 @@ void Out_String (CHAR *str, ADDRESS str__len)
error = Platform_Write(1, (ADDRESS)str, l);
} else {
__MOVE((ADDRESS)str, (ADDRESS)&Out_buf[__X(Out_in, 128)], l);
Out_in += __SHORT(l, 32768);
Out_in += (INT16)l;
}
__DEL(str);
}
@ -91,18 +89,18 @@ void Out_Int (INT64 x, INT64 n)
INT16 i;
BOOLEAN negative;
negative = x < 0;
if (x == (-9223372036854775807LL-1)) {
if (x == (-9223372036854775807-1)) {
__MOVE("8085774586302733229", s, 20);
i = 19;
} else {
if (x < 0) {
x = -x;
}
s[0] = __CHR(48 + __MOD(x, 10));
s[0] = (CHAR)(48 + __MOD(x, 10));
x = __DIV(x, 10);
i = 1;
while (x != 0) {
s[__X(i, 22)] = __CHR(48 + __MOD(x, 10));
s[__X(i, 22)] = (CHAR)(48 + __MOD(x, 10));
x = __DIV(x, 10);
i += 1;
}
@ -121,43 +119,19 @@ 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, ADDRESS s__len, INT16 *i)
static void Out_digit (INT64 n, CHAR *s, LONGINT s__len, INT16 *i)
{
*i -= 1;
s[__X(*i, s__len)] = __CHR(__MOD(n, 10) + 48);
s[__X(*i, s__len)] = (CHAR)(__MOD(n, 10) + 48);
}
static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16 *i)
static void Out_prepend (CHAR *t, LONGINT t__len, CHAR *s, LONGINT s__len, INT16 *i)
{
INT16 j;
INT32 l;
@ -166,7 +140,7 @@ static void Out_prepend (CHAR *t, ADDRESS t__len, CHAR *s, ADDRESS s__len, INT16
if (l > *i) {
l = *i;
}
*i -= __SHORT(l, 32768);
*i -= (INT16)l;
j = 0;
while (j < l) {
s[__X(*i + j, s__len)] = t[__X(j, t__len)];
@ -201,7 +175,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)), -4503599627370496LL);
f = __MASK((__VAL(INT64, x)), -4503599627370496);
nn = (__VAL(INT64, x) < 0 && !((e == 2047 && f != 0)));
if (nn) {
n -= 1;
@ -248,7 +222,7 @@ static void Out_RealP (LONGREAL x, INT16 n, BOOLEAN long_)
if (nn) {
x = -x;
}
e = __SHORT(__ASHR((e - 1023) * 77, 8), 32768);
e = (INT16)__ASHR((e - 1023) * 77, 8);
if (e >= 0) {
x = x / (LONGREAL)Out_Ten(e);
} else {
@ -332,7 +306,6 @@ 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);

5
bootstrap/unix-48/Out.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Out__h
#define Out__h
@ -11,13 +11,12 @@ 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, ADDRESS str__len);
import void Out_String (CHAR *str, LONGINT str__len);
import LONGREAL Out_Ten (INT16 e);
import void *Out__init(void);

156
bootstrap/unix-48/Platform.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -7,18 +7,37 @@
#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];
@ -26,33 +45,35 @@ export CHAR Platform_NL[3];
export ADDRESS *Platform_FileIdentity__typ;
export BOOLEAN Platform_Absent (INT16 e);
export INT16 Platform_Chdir (CHAR *n, ADDRESS n__len);
export INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
export INT16 Platform_Chdir (CHAR *n, LONGINT 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, ADDRESS var__len, CHAR *val, ADDRESS val__len);
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_GetTimeOfDay (INT32 *sec, INT32 *usec);
export INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *identity__typ);
export INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
export INT16 Platform_IdentifyByName (CHAR *n, LONGINT 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_MaxNameLength (void);
export INT16 Platform_MaxPathLength (void);
export INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h);
export INT16 Platform_New (CHAR *n, LONGINT 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, ADDRESS n__len, INT32 *h);
export INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h);
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_Read (INT32 h, INT32 p, INT32 l, INT32 *n);
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 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 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);
@ -62,16 +83,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, ADDRESS cmd__len);
export INT16 Platform_System (CHAR *cmd, LONGINT 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, ADDRESS n__len);
export INT16 Platform_Unlink (CHAR *n, LONGINT 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, ADDRESS var__len, CHAR *val, ADDRESS val__len);
export BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
#include <errno.h>
#include <errno.h>
@ -81,7 +102,6 @@ export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS
#include <sys/types.h>
#include <time.h>
#include <unistd.h>
#include <limits.h>
#include <stdio.h>
#include <stdlib.h>
#define Platform_EACCES() EACCES
@ -97,8 +117,8 @@ export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS
#define Platform_EROFS() EROFS
#define Platform_ETIMEDOUT() ETIMEDOUT
#define Platform_EXDEV() EXDEV
#define Platform_NAMEMAX() NAME_MAX
#define Platform_PATHMAX() PATH_MAX
extern void Heap_InitHeap();
#define Platform_HeapInitHeap() Heap_InitHeap()
#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)
@ -109,7 +129,7 @@ export BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS
#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) getenv((char*)var)
#define Platform_getenv(var, var__len) (Platform_EnvPtr)getenv((char*)var)
#define Platform_getpid() (INTEGER)getpid()
#define Platform_gettimeval() struct timeval tv; gettimeofday(&tv,0)
#define Platform_isatty(fd) isatty(fd)
@ -183,16 +203,6 @@ 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);
@ -203,14 +213,21 @@ void Platform_OSFree (INT32 address)
Platform_free(address);
}
typedef
CHAR (*EnvPtr__83)[1024];
BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
void Platform_Init (INT32 argc, INT32 argvadr)
{
EnvPtr__83 p = NIL;
Platform_ArgVecPtr av = NIL;
Platform_MainStackFrame = argvadr;
Platform_ArgCount = __VAL(INT16, argc);
av = (Platform_ArgVecPtr)(ADDRESS)argvadr;
Platform_ArgVector = (*av)[0];
Platform_HeapInitHeap();
}
BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
{
Platform_EnvPtr p = NIL;
__DUP(var, var__len, CHAR);
p = (EnvPtr__83)(ADDRESS)Platform_getenv(var, var__len);
p = Platform_getenv(var, var__len);
if (p != NIL) {
__COPY(*p, val, val__len);
}
@ -218,7 +235,7 @@ BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__le
return p != NIL;
}
void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len)
void Platform_GetEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len)
{
__DUP(var, var__len, CHAR);
if (!Platform_getEnv(var, var__len, (void*)val, val__len)) {
@ -227,6 +244,56 @@ void Platform_GetEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS 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);
@ -278,7 +345,7 @@ void Platform_Delay (INT32 ms)
Platform_nanosleep(s, ns);
}
INT16 Platform_System (CHAR *cmd, ADDRESS cmd__len)
INT16 Platform_System (CHAR *cmd, LONGINT cmd__len)
{
__DUP(cmd, cmd__len, CHAR);
__DEL(cmd);
@ -290,7 +357,7 @@ INT16 Platform_Error (void)
return Platform_err();
}
INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h)
INT16 Platform_OldRO (CHAR *n, LONGINT n__len, INT32 *h)
{
INT16 fd;
fd = Platform_openro(n, n__len);
@ -303,7 +370,7 @@ INT16 Platform_OldRO (CHAR *n, ADDRESS n__len, INT32 *h)
__RETCHK;
}
INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h)
INT16 Platform_OldRW (CHAR *n, LONGINT n__len, INT32 *h)
{
INT16 fd;
fd = Platform_openrw(n, n__len);
@ -316,7 +383,7 @@ INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h)
__RETCHK;
}
INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h)
INT16 Platform_New (CHAR *n, LONGINT n__len, INT32 *h)
{
INT16 fd;
fd = Platform_opennew(n, n__len);
@ -356,7 +423,7 @@ INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *iden
return 0;
}
INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
INT16 Platform_IdentifyByName (CHAR *n, LONGINT n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ)
{
__DUP(n, n__len, CHAR);
Platform_structstats();
@ -414,7 +481,7 @@ INT16 Platform_Read (INT32 h, INT32 p, INT32 l, INT32 *n)
__RETCHK;
}
INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, ADDRESS b__len, INT32 *n)
INT16 Platform_ReadBuf (INT32 h, SYSTEM_BYTE *b, LONGINT b__len, INT32 *n)
{
*n = Platform_readfile(h, (ADDRESS)b, b__len);
if (*n < 0) {
@ -468,7 +535,7 @@ INT16 Platform_Truncate (INT32 h, INT32 l)
__RETCHK;
}
INT16 Platform_Unlink (CHAR *n, ADDRESS n__len)
INT16 Platform_Unlink (CHAR *n, LONGINT n__len)
{
if (Platform_unlink(n, n__len) < 0) {
return Platform_err();
@ -478,7 +545,7 @@ INT16 Platform_Unlink (CHAR *n, ADDRESS n__len)
__RETCHK;
}
INT16 Platform_Chdir (CHAR *n, ADDRESS n__len)
INT16 Platform_Chdir (CHAR *n, LONGINT n__len)
{
INT16 r;
if ((Platform_chdir(n, n__len) >= 0 && Platform_getcwd((void*)Platform_CWD, 256) != NIL)) {
@ -489,7 +556,7 @@ INT16 Platform_Chdir (CHAR *n, ADDRESS n__len)
__RETCHK;
}
INT16 Platform_Rename (CHAR *o, ADDRESS o__len, CHAR *n, ADDRESS n__len)
INT16 Platform_Rename (CHAR *o, LONGINT o__len, CHAR *n, LONGINT n__len)
{
if (Platform_rename(o, o__len, n, n__len) < 0) {
return Platform_err();
@ -520,6 +587,7 @@ 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();

33
bootstrap/unix-48/Platform.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Platform__h
#define Platform__h
@ -16,41 +16,46 @@ 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_Chdir (CHAR *n, ADDRESS n__len);
import INT16 Platform_ArgPos (CHAR *s, LONGINT s__len);
import INT16 Platform_Chdir (CHAR *n, LONGINT 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, ADDRESS var__len, CHAR *val, ADDRESS val__len);
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_GetTimeOfDay (INT32 *sec, INT32 *usec);
import INT16 Platform_Identify (INT32 h, Platform_FileIdentity *identity, ADDRESS *identity__typ);
import INT16 Platform_IdentifyByName (CHAR *n, ADDRESS n__len, Platform_FileIdentity *identity, ADDRESS *identity__typ);
import INT16 Platform_IdentifyByName (CHAR *n, LONGINT 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_MaxNameLength (void);
import INT16 Platform_MaxPathLength (void);
import INT16 Platform_New (CHAR *n, ADDRESS n__len, INT32 *h);
import INT16 Platform_New (CHAR *n, LONGINT 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, ADDRESS n__len, INT32 *h);
import INT16 Platform_OldRW (CHAR *n, ADDRESS n__len, INT32 *h);
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_Read (INT32 h, INT32 p, INT32 l, INT32 *n);
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 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 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);
@ -60,14 +65,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, ADDRESS cmd__len);
import INT16 Platform_System (CHAR *cmd, LONGINT 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, ADDRESS n__len);
import INT16 Platform_Unlink (CHAR *n, LONGINT n__len);
import INT16 Platform_Write (INT32 h, INT32 p, INT32 l);
import BOOLEAN Platform_getEnv (CHAR *var, ADDRESS var__len, CHAR *val, ADDRESS val__len);
import BOOLEAN Platform_getEnv (CHAR *var, LONGINT var__len, CHAR *val, LONGINT val__len);
import void *Platform__init(void);

40
bootstrap/unix-48/Reals.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -10,11 +10,11 @@
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);
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);
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, __CHR(__ASHL(__ASHR((INT16)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR);
__PUT((ADDRESS)x + 3, (CHAR)(__ASHL(__ASHR((INT16)c, 7), 7) + __MASK(__ASHR(ex, 1), -128)), CHAR);
__GET((ADDRESS)x + 2, c, CHAR);
__PUT((ADDRESS)x + 2, __CHR(__MASK((INT16)c, -128) + __ASHL(__MASK(ex, -2), 7)), CHAR);
__PUT((ADDRESS)x + 2, (CHAR)(__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, ADDRESS d__len)
void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, LONGINT d__len)
{
INT32 i, j, k;
if (x < (LONGREAL)0) {
@ -87,27 +87,27 @@ void Reals_ConvertL (LONGREAL x, INT16 n, CHAR *d, ADDRESS d__len)
}
k = 0;
if (n > 9) {
i = __SHORT(__ENTIER(x / (LONGREAL)(LONGREAL)1000000000), 2147483648LL);
j = __SHORT(__ENTIER(x - i * (LONGREAL)1000000000), 2147483648LL);
i = (INT32)__ENTIER(x / (LONGREAL)(LONGREAL)1000000000);
j = (INT32)__ENTIER(x - i * (LONGREAL)1000000000);
if (j < 0) {
j = 0;
}
while (k < 9) {
d[__X(k, d__len)] = __CHR((int)__MOD(j, 10) + 48);
d[__X(k, d__len)] = (CHAR)((int)__MOD(j, 10) + 48);
j = __DIV(j, 10);
k += 1;
}
} else {
i = __SHORT(__ENTIER(x), 2147483648LL);
i = (INT32)__ENTIER(x);
}
while (k < n) {
d[__X(k, d__len)] = __CHR((int)__MOD(i, 10) + 48);
d[__X(k, d__len)] = (CHAR)((int)__MOD(i, 10) + 48);
i = __DIV(i, 10);
k += 1;
}
}
void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len)
void Reals_Convert (REAL x, INT16 n, CHAR *d, LONGINT d__len)
{
Reals_ConvertL(x, n, (void*)d, d__len);
}
@ -115,14 +115,14 @@ void Reals_Convert (REAL x, INT16 n, CHAR *d, ADDRESS d__len)
static CHAR Reals_ToHex (INT16 i)
{
if (i < 10) {
return __CHR(i + 48);
return (CHAR)(i + 48);
} else {
return __CHR(i + 55);
return (CHAR)(i + 55);
}
__RETCHK;
}
static void Reals_BytesToHex (SYSTEM_BYTE *b, ADDRESS b__len, SYSTEM_BYTE *d, ADDRESS d__len)
static void Reals_BytesToHex (SYSTEM_BYTE *b, LONGINT b__len, SYSTEM_BYTE *d, LONGINT d__len)
{
INT16 i;
INT32 l;
@ -137,12 +137,12 @@ static void Reals_BytesToHex (SYSTEM_BYTE *b, ADDRESS b__len, SYSTEM_BYTE *d, AD
}
}
void Reals_ConvertH (REAL y, CHAR *d, ADDRESS d__len)
void Reals_ConvertH (REAL y, CHAR *d, LONGINT d__len)
{
Reals_BytesToHex((void*)&y, 4, (void*)d, d__len * 1);
}
void Reals_ConvertHL (LONGREAL x, CHAR *d, ADDRESS d__len)
void Reals_ConvertHL (LONGREAL x, CHAR *d, LONGINT d__len)
{
Reals_BytesToHex((void*)&x, 8, (void*)d, d__len * 1);
}

10
bootstrap/unix-48/Reals.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Reals__h
#define Reals__h
@ -8,10 +8,10 @@
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 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 INT16 Reals_Expo (REAL x);
import INT16 Reals_ExpoL (LONGREAL x);
import void Reals_SetExpo (REAL *x, INT16 ex);

174
bootstrap/unix-48/Strings.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -6,25 +6,22 @@
#define SET UINT32
#include "SYSTEM.h"
#include "Reals.h"
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);
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);
INT16 Strings_Length (CHAR *s, ADDRESS s__len)
INT16 Strings_Length (CHAR *s, LONGINT s__len)
{
INT32 i;
__DUP(s, s__len, CHAR);
@ -34,7 +31,7 @@ INT16 Strings_Length (CHAR *s, ADDRESS s__len)
}
if (i <= 32767) {
__DEL(s);
return __SHORT(i, 32768);
return (INT16)i;
} else {
__DEL(s);
return 32767;
@ -42,7 +39,7 @@ INT16 Strings_Length (CHAR *s, ADDRESS s__len)
__RETCHK;
}
void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__len)
void Strings_Append (CHAR *extra, LONGINT extra__len, CHAR *dest, LONGINT dest__len)
{
INT16 n1, n2, i;
__DUP(extra, extra__len, CHAR);
@ -59,7 +56,7 @@ void Strings_Append (CHAR *extra, ADDRESS extra__len, CHAR *dest, ADDRESS dest__
__DEL(extra);
}
void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
void Strings_Insert (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
{
INT16 n1, n2, i;
__DUP(source, source__len, CHAR);
@ -90,7 +87,7 @@ void Strings_Insert (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, A
__DEL(source);
}
void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n)
void Strings_Delete (CHAR *s, LONGINT s__len, INT16 pos, INT16 n)
{
INT16 len, i;
len = Strings_Length(s, s__len);
@ -113,7 +110,7 @@ void Strings_Delete (CHAR *s, ADDRESS s__len, INT16 pos, INT16 n)
}
}
void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest, ADDRESS dest__len)
void Strings_Replace (CHAR *source, LONGINT source__len, INT16 pos, CHAR *dest, LONGINT dest__len)
{
__DUP(source, source__len, CHAR);
Strings_Delete((void*)dest, dest__len, pos, pos + Strings_Length(source, source__len));
@ -121,12 +118,12 @@ void Strings_Replace (CHAR *source, ADDRESS source__len, INT16 pos, CHAR *dest,
__DEL(source);
}
void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHAR *dest, ADDRESS dest__len)
void Strings_Extract (CHAR *source, LONGINT source__len, INT16 pos, INT16 n, CHAR *dest, LONGINT dest__len)
{
INT16 len, destLen, i;
__DUP(source, source__len, CHAR);
len = Strings_Length(source, source__len);
destLen = __SHORT(dest__len, 32768) - 1;
destLen = (INT16)dest__len - 1;
if (pos < 0) {
pos = 0;
}
@ -146,7 +143,7 @@ void Strings_Extract (CHAR *source, ADDRESS source__len, INT16 pos, INT16 n, CHA
__DEL(source);
}
INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len, INT16 pos)
INT16 Strings_Pos (CHAR *pattern, LONGINT pattern__len, CHAR *s, LONGINT s__len, INT16 pos)
{
INT16 n1, n2, i, j;
__DUP(pattern, pattern__len, CHAR);
@ -178,7 +175,7 @@ INT16 Strings_Pos (CHAR *pattern, ADDRESS pattern__len, CHAR *s, ADDRESS s__len,
return -1;
}
void Strings_Cap (CHAR *s, ADDRESS s__len)
void Strings_Cap (CHAR *s, LONGINT s__len)
{
INT16 i;
i = 0;
@ -194,9 +191,9 @@ static struct Match__7 {
struct Match__7 *lnk;
} *Match__7_s;
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)
static BOOLEAN M__8 (CHAR *name, LONGINT name__len, CHAR *mask, LONGINT 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)]) {
@ -223,7 +220,7 @@ static BOOLEAN M__8 (CHAR *name, ADDRESS name__len, CHAR *mask, ADDRESS mask__le
return 0;
}
BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS pattern__len)
BOOLEAN Strings_Match (CHAR *string, LONGINT string__len, CHAR *pattern, LONGINT pattern__len)
{
struct Match__7 _s;
BOOLEAN __retval;
@ -239,135 +236,10 @@ BOOLEAN Strings_Match (CHAR *string, ADDRESS string__len, CHAR *pattern, ADDRESS
return __retval;
}
void Strings_StrToReal (CHAR *s, ADDRESS s__len, REAL *r)
{
INT16 p, e;
REAL y, g;
BOOLEAN neg, negE;
__DUP(s, s__len, CHAR);
p = 0;
while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') {
p += 1;
}
if (s[__X(p, s__len)] == '-') {
neg = 1;
p += 1;
} else {
neg = 0;
}
while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') {
p += 1;
}
y = (REAL)0;
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
y = y * (REAL)10 + ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
if (s[__X(p, s__len)] == '.') {
p += 1;
g = (REAL)1;
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
g = g / (REAL)(REAL)10;
y = y + g * ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
}
if (s[__X(p, s__len)] == 'D' || s[__X(p, s__len)] == 'E') {
p += 1;
e = 0;
if (s[__X(p, s__len)] == '-') {
negE = 1;
p += 1;
} else {
negE = 0;
}
while (s[__X(p, s__len)] == '0') {
p += 1;
}
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
e = e * 10 + ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
if (negE) {
y = y / (REAL)Reals_Ten(e);
} else {
y = y * Reals_Ten(e);
}
}
if (neg) {
y = -y;
}
*r = y;
__DEL(s);
}
void Strings_StrToLongReal (CHAR *s, ADDRESS s__len, LONGREAL *r)
{
INT16 p, e;
LONGREAL y, g;
BOOLEAN neg, negE;
__DUP(s, s__len, CHAR);
p = 0;
while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') {
p += 1;
}
if (s[__X(p, s__len)] == '-') {
neg = 1;
p += 1;
} else {
neg = 0;
}
while (s[__X(p, s__len)] == ' ' || s[__X(p, s__len)] == '0') {
p += 1;
}
y = (LONGREAL)0;
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
y = y * (LONGREAL)10 + ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
if (s[__X(p, s__len)] == '.') {
p += 1;
g = (LONGREAL)1;
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
g = g / (LONGREAL)(LONGREAL)10;
y = y + g * ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
}
if (s[__X(p, s__len)] == 'D' || s[__X(p, s__len)] == 'E') {
p += 1;
e = 0;
if (s[__X(p, s__len)] == '-') {
negE = 1;
p += 1;
} else {
negE = 0;
}
while (s[__X(p, s__len)] == '0') {
p += 1;
}
while (('0' <= s[__X(p, s__len)] && s[__X(p, s__len)] <= '9')) {
e = e * 10 + ((INT16)s[__X(p, s__len)] - 48);
p += 1;
}
if (negE) {
y = y / (LONGREAL)Reals_Ten(e);
} else {
y = y * Reals_Ten(e);
}
}
if (neg) {
y = -y;
}
*r = y;
__DEL(s);
}
export void *Strings__init(void)
{
__DEFMOD;
__MODULE_IMPORT(Reals);
__REGMOD("Strings", 0);
/* BEGIN */
__ENDMOD;

22
bootstrap/unix-48/Strings.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Strings__h
#define Strings__h
@ -8,17 +8,15 @@
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_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__init(void);

84
bootstrap/unix-48/Texts.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#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, ADDRESS name__len);
export void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
export void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
export void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
export void Texts_Delete (Texts_Text T, 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, ADDRESS name__len);
static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT 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, ADDRESS name__len);
export void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
export void Texts_OpenBuf (Texts_Buffer B);
export void Texts_OpenReader (Texts_Reader *R, 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, ADDRESS s__len);
export void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
static Texts_FontsFont Texts_FontsThis (CHAR *name, ADDRESS name__len)
static Texts_FontsFont Texts_FontsThis (CHAR *name, LONGINT 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;
__MOVE((*(Texts_Alien*)&E)->mod, e->mod, 32);
__MOVE((*(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;
__COPY(((Texts_Alien)E)->mod, e->mod, 32);
__COPY(((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 = __CHR((INT16)ch - 7);
ch = (CHAR)((INT16)ch - 7);
} else if (('a' <= ch && ch <= 'f')) {
hex = 1;
ch = __CHR((INT16)ch - 39);
ch = (CHAR)((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, ADDRESS s__len)
void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT 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 == (-9223372036854775807LL-1)) {
if (x == (-9223372036854775807-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)] = __CHR(__MOD(x0, 10) + 48);
a[__X(i, 24)] = (CHAR)(__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)] = __CHR(y + 48);
a[__X(i, 20)] = (CHAR)(y + 48);
} else {
a[__X(i, 20)] = __CHR(y + 55);
a[__X(i, 20)] = (CHAR)(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, __CHR(__DIV(e, 10) + 48));
Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48));
Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48));
Texts_Write(&*W, W__typ, (CHAR)((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 = __SHORT(__ASHR((e - 1023) * 77, 8), 32768);
e = (INT16)__ASHR((e - 1023) * 77, 8);
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, __CHR(__DIV(e, 100) + 48));
Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 100) + 48));
e = (int)__MOD(e, 100);
Texts_Write(&*W, W__typ, __CHR(__DIV(e, 10) + 48));
Texts_Write(&*W, W__typ, __CHR((int)__MOD(e, 10) + 48));
Texts_Write(&*W, W__typ, (CHAR)(__DIV(e, 10) + 48));
Texts_Write(&*W, W__typ, (CHAR)((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, __CHR(__DIV(x, 10) + 48));
Texts_Write(&*WriteDate__43_s->W, WriteDate__43_s->W__typ, __CHR((int)__MOD(x, 10) + 48));
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));
}
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)
{
Heap_Module M = NIL;
Heap_Command Cmd;
Modules_Module M = NIL;
Modules_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, ADDRESS name__len)
void Texts_Open (Texts_Text T, CHAR *name, LONGINT 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, ADDRESS name__len)
void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len)
{
Files_File f = NIL;
Files_Rider r;

8
bootstrap/unix-48/Texts.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#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, ADDRESS name__len);
import void Texts_Close (Texts_Text T, CHAR *name, LONGINT name__len);
import void Texts_Copy (Texts_Buffer SB, Texts_Buffer DB);
import void Texts_CopyElem (Texts_Elem SE, Texts_Elem DE);
import void Texts_Delete (Texts_Text T, 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, ADDRESS name__len);
import void Texts_Open (Texts_Text T, CHAR *name, LONGINT name__len);
import void Texts_OpenBuf (Texts_Buffer B);
import void Texts_OpenReader (Texts_Reader *R, 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, ADDRESS s__len);
import void Texts_WriteString (Texts_Writer *W, ADDRESS *W__typ, CHAR *s, LONGINT s__len);
import void *Texts__init(void);

43
bootstrap/unix-48/VT100.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -27,24 +27,23 @@ 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, 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);
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);
export void VT100_HVP (INT16 n, INT16 m);
export void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len);
export void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len);
export void VT100_RCP (void);
export void VT100_Reset (void);
static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end);
static void VT100_Reverse0 (CHAR *str, LONGINT 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, ADDRESS attr__len);
export void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end)
static void VT100_Reverse0 (CHAR *str, LONGINT str__len, INT16 start, INT16 end)
{
CHAR h;
while (start < end) {
@ -56,7 +55,7 @@ static void VT100_Reverse0 (CHAR *str, ADDRESS str__len, INT16 start, INT16 end)
}
}
void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len)
void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT str__len)
{
CHAR b[21];
INT16 s, e;
@ -75,7 +74,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len)
}
e = s;
do {
b[__X(e, 21)] = __CHR((int)__MOD(int_, 10) + 48);
b[__X(e, 21)] = (CHAR)((int)__MOD(int_, 10) + 48);
int_ = __DIV(int_, 10);
e += 1;
} while (!(int_ == 0));
@ -85,7 +84,7 @@ void VT100_IntToStr (INT32 int_, CHAR *str, ADDRESS str__len)
__COPY(b, str, str__len);
}
static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len)
static void VT100_EscSeq0 (CHAR *letter, LONGINT letter__len)
{
CHAR cmd[9];
__DUP(letter, letter__len, CHAR);
@ -95,7 +94,7 @@ static void VT100_EscSeq0 (CHAR *letter, ADDRESS letter__len)
__DEL(letter);
}
static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len)
static void VT100_EscSeq (INT16 n, CHAR *letter, LONGINT letter__len)
{
CHAR nstr[2];
CHAR cmd[7];
@ -108,7 +107,7 @@ static void VT100_EscSeq (INT16 n, CHAR *letter, ADDRESS letter__len)
__DEL(letter);
}
static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len)
static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, LONGINT letter__len)
{
CHAR nstr[2];
CHAR cmd[7];
@ -121,7 +120,7 @@ static void VT100_EscSeqSwapped (INT16 n, CHAR *letter, ADDRESS letter__len)
__DEL(letter);
}
static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len)
static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, LONGINT letter__len)
{
CHAR nstr[5], mstr[5];
CHAR cmd[12];
@ -137,15 +136,6 @@ static void VT100_EscSeq2 (INT16 n, INT16 m, CHAR *letter, ADDRESS letter__len)
__DEL(letter);
}
void VT100_Reset (void)
{
CHAR cmd[6];
__COPY("\033", cmd, 6);
Strings_Append((CHAR*)"c", 2, (void*)cmd, 6);
Out_String(cmd, 6);
Out_Ln();
}
void VT100_CUU (INT16 n)
{
VT100_EscSeq(n, (CHAR*)"A", 2);
@ -246,7 +236,7 @@ void VT100_DECTCEMh (void)
VT100_EscSeq0((CHAR*)"\?25h", 5);
}
void VT100_SetAttr (CHAR *attr, ADDRESS attr__len)
void VT100_SetAttr (CHAR *attr, LONGINT attr__len)
{
CHAR tmpstr[16];
__DUP(attr, attr__len, CHAR);
@ -266,7 +256,6 @@ 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);

7
bootstrap/unix-48/VT100.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef VT100__h
#define VT100__h
@ -23,15 +23,14 @@ 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, ADDRESS str__len);
import void VT100_IntToStr (INT32 int_, CHAR *str, LONGINT 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, ADDRESS attr__len);
import void VT100_SetAttr (CHAR *attr, LONGINT attr__len);
import void *VT100__init(void);

89
bootstrap/unix-48/extTools.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -7,40 +7,33 @@
#include "SYSTEM.h"
#include "Configuration.h"
#include "Heap.h"
#include "Modules.h"
#include "OPM.h"
#include "Out.h"
#include "Platform.h"
#include "Strings.h"
typedef
CHAR extTools_CommandString[4096];
static CHAR extTools_CFLAGS[1023];
static extTools_CommandString extTools_CFLAGS;
export void extTools_Assemble (CHAR *moduleName, 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);
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)
static void extTools_execute (CHAR *title, LONGINT title__len, CHAR *cmd, LONGINT 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((CHAR*)" ", 3);
Out_String(title, title__len);
Out_String(cmd, cmd__len);
Out_Ln();
}
__COPY(cmd, fullcmd, 4096);
Heap_GC(0);
r = Platform_System(fullcmd, 4096);
r = Platform_System(cmd, cmd__len);
status = __MASK(r, -128);
exitcode = __ASHR(r, 8);
if (exitcode > 127) {
@ -70,55 +63,50 @@ static void extTools_execute (CHAR *title, ADDRESS title__len, CHAR *cmd, ADDRES
__DEL(cmd);
}
static void extTools_InitialiseCompilerCommand (CHAR *s, ADDRESS s__len, CHAR *additionalopts, ADDRESS additionalopts__len)
static void extTools_InitialiseCompilerCommand (CHAR *s, LONGINT s__len)
{
__DUP(additionalopts, additionalopts__len, CHAR);
__COPY("gcc -fPIC -g -Wno-stringop-overflow", s, s__len);
__COPY("gcc -g", 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);
Strings_Append(additionalopts, additionalopts__len, (void*)s, s__len);
Platform_GetEnv((CHAR*)"CFLAGS", 7, (void*)extTools_CFLAGS, 1023);
Strings_Append(extTools_CFLAGS, 1023, (void*)s, s__len);
Strings_Append((CHAR*)" ", 2, (void*)s, s__len);
Platform_GetEnv((CHAR*)"CFLAGS", 7, (void*)extTools_CFLAGS, 4096);
Strings_Append(extTools_CFLAGS, 4096, (void*)s, s__len);
Strings_Append((CHAR*)" ", 2, (void*)s, s__len);
__DEL(additionalopts);
}
void extTools_Assemble (CHAR *moduleName, ADDRESS moduleName__len)
void extTools_Assemble (CHAR *moduleName, LONGINT moduleName__len)
{
extTools_CommandString cmd;
CHAR cmd[1023];
__DUP(moduleName, moduleName__len, CHAR);
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);
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);
__DEL(moduleName);
}
void extTools_LinkMain (CHAR *moduleName, ADDRESS moduleName__len, BOOLEAN statically, CHAR *additionalopts, ADDRESS additionalopts__len)
void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len)
{
extTools_CommandString cmd;
CHAR cmd[1023];
__DUP(additionalopts, additionalopts__len, CHAR);
extTools_InitialiseCompilerCommand((void*)cmd, 4096, additionalopts, additionalopts__len);
Strings_Append(moduleName, moduleName__len, (void*)cmd, 4096);
Strings_Append((CHAR*)".c ", 4, (void*)cmd, 4096);
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);
if (statically) {
Strings_Append((CHAR*)" -static", 9, (void*)cmd, 4096);
Strings_Append((CHAR*)"-static", 8, (void*)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);
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);
__DEL(additionalopts);
}
@ -127,7 +115,6 @@ export void *extTools__init(void)
{
__DEFMOD;
__MODULE_IMPORT(Configuration);
__MODULE_IMPORT(Heap);
__MODULE_IMPORT(Modules);
__MODULE_IMPORT(OPM);
__MODULE_IMPORT(Out);

6
bootstrap/unix-48/extTools.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef extTools__h
#define extTools__h
@ -8,8 +8,8 @@
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_Assemble (CHAR *moduleName, LONGINT moduleName__len);
import void extTools_LinkMain (CHAR *moduleName, LONGINT moduleName__len, BOOLEAN statically, CHAR *additionalopts, LONGINT additionalopts__len);
import void *extTools__init(void);

53
bootstrap/unix-88/Compiler.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspamS */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspamS */
#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,12 +41,11 @@ 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_DeleteSym((void*)OPT_SelfName, 256);
OPM_DeleteNewSym();
OPM_LogVT100((CHAR*)"32m", 4);
OPM_LogWStr((CHAR*)" Main program.", 16);
OPM_LogVT100((CHAR*)"0m", 3);
@ -62,7 +61,7 @@ void Compiler_Module (BOOLEAN *done)
}
}
} else {
OPM_DeleteSym((void*)OPT_SelfName, 256);
OPM_DeleteNewSym();
}
}
}
@ -89,7 +88,7 @@ static void Compiler_PropagateElementaryTypeSizes (void)
OPT_sintobj->typ = OPT_sinttyp;
OPT_intobj->typ = OPT_inttyp;
OPT_lintobj->typ = OPT_linttyp;
switch (OPM_SetSize) {
switch (OPM_LongintSize) {
case 4:
OPT_settyp = OPT_set32typ;
break;
@ -105,44 +104,14 @@ 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 linkfiles[2048];
CHAR modulesobj[2048];
modulesobj[0] = 0x00;
if (OPM_OpenPar()) {
for (;;) {
OPM_Init(&done);
OPM_Init(&done, (void*)Compiler_mname, 256);
if (!done) {
return;
}
@ -162,9 +131,11 @@ 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 {
Compiler_FindLocalObjectFiles((void*)linkfiles, 2048);
extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), linkfiles, 2048);
extTools_LinkMain((void*)OPM_modName, 32, __IN(15, OPM_Options, 32), modulesobj, 2048);
}
}
}

6
bootstrap/unix-88/Configuration.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -8,7 +8,7 @@
#include "SYSTEM.h"
export CHAR Configuration_versionLong[76];
export CHAR Configuration_versionLong[75];
@ -19,6 +19,6 @@ export void *Configuration__init(void)
__DEFMOD;
__REGMOD("Configuration", 0);
/* BEGIN */
__MOVE("2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 76);
__MOVE("1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8.", Configuration_versionLong, 75);
__ENDMOD;
}

4
bootstrap/unix-88/Configuration.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Configuration__h
#define Configuration__h
@ -6,7 +6,7 @@
#include "SYSTEM.h"
import CHAR Configuration_versionLong[76];
import CHAR Configuration_versionLong[75];
import void *Configuration__init(void);

426
bootstrap/unix-88/Files.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -26,7 +26,7 @@ typedef
Files_BufDesc *Files_Buffer;
typedef
CHAR Files_FileName[256];
CHAR Files_FileName[101];
typedef
struct Files_FileDesc {
@ -36,7 +36,7 @@ typedef
INT32 fd, len, pos;
Files_Buffer bufs[4];
INT16 swapper, state;
struct Files_FileDesc *next;
Files_File next;
} Files_FileDesc;
typedef
@ -48,12 +48,11 @@ typedef
} Files_Rider;
export INT16 Files_MaxPathLength, Files_MaxNameLength;
static Files_FileDesc *Files_files;
static Files_File Files_files;
static INT16 Files_tempno;
static CHAR Files_HOME[1024];
static struct {
ADDRESS len[1];
LONGINT len[1];
CHAR data[1];
} *Files_SearchPath;
@ -61,68 +60,58 @@ 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, ADDRESS path__len, INT16 *res);
export void Files_ChangeDirectory (CHAR *path, LONGINT 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, 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);
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);
static void Files_Finalize (SYSTEM_PTR o);
static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len);
static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len);
static void Files_Flush (Files_Buffer buf);
export void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
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 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 INT32 Files_Length (Files_File f);
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);
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len);
export Files_File Files_New (CHAR *name, LONGINT name__len);
export Files_File Files_Old (CHAR *name, LONGINT name__len);
export INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ);
export void Files_Purge (Files_File f);
export void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
export void Files_ReadBool (Files_Rider *R, ADDRESS *R__typ, BOOLEAN *x);
export void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x);
export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n);
export void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT 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, ADDRESS x__len);
export void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
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_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, ADDRESS x__len);
export void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
export void Files_Register (Files_File f);
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_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_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos);
export void Files_SetSearchPath (CHAR *path, ADDRESS path__len);
export void Files_SetSearchPath (CHAR *path, LONGINT 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, ADDRESS x__len, INT32 n);
export void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT 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, ADDRESS x__len);
export void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
#define Files_IdxTrap() __HALT(-1)
#define Files_ToAdr(x) (ADDRESS)x
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)
static void Files_Err (CHAR *s, LONGINT s__len, Files_File f, INT16 errcode)
{
__DUP(s, s__len, CHAR);
Out_Ln();
@ -131,17 +120,17 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
Out_String((CHAR*)": ", 3);
if (f != NIL) {
if (f->registerName[0] != 0x00) {
Out_String(f->registerName, 256);
Out_String(f->registerName, 101);
} else {
Out_String(f->workName, 256);
Out_String(f->workName, 101);
}
if (f->fd != 0) {
Out_String((CHAR*)", f.fd = ", 10);
Out_String((CHAR*)"f.fd = ", 8);
Out_Int(f->fd, 1);
}
}
if (errcode != 0) {
Out_String((CHAR*)", errcode = ", 13);
Out_String((CHAR*)" errcode = ", 12);
Out_Int(errcode, 1);
}
Out_Ln();
@ -149,125 +138,98 @@ static void Files_Err (CHAR *s, ADDRESS s__len, Files_File f, INT16 errcode)
__DEL(s);
}
static void Files_MakeFileName (CHAR *dir, ADDRESS dir__len, CHAR *name, ADDRESS name__len, CHAR *dest, ADDRESS dest__len)
static void Files_MakeFileName (CHAR *dir, LONGINT dir__len, CHAR *name, LONGINT name__len, CHAR *dest, LONGINT dest__len)
{
INT16 i, j, ld, ln;
INT16 i, j;
__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 (j < ln) {
dest[__X(i, dest__len)] = name[__X(j, name__len)];
while (dir[i] != 0x00) {
dest[i] = dir[i];
i += 1;
}
if (dest[i - 1] != '/') {
dest[i] = '/';
i += 1;
}
while (name[j] != 0x00) {
dest[i] = name[j];
i += 1;
j += 1;
}
dest[__X(i, dest__len)] = 0x00;
dest[i] = 0x00;
__DEL(dir);
__DEL(name);
}
static void Files_GetTempName (CHAR *finalName, ADDRESS finalName__len, CHAR *name, ADDRESS name__len)
static void Files_GetTempName (CHAR *finalName, LONGINT finalName__len, CHAR *name, LONGINT name__len)
{
INT16 i, n;
INT32 n, i, j;
__DUP(finalName, finalName__len, CHAR);
if (finalName[0] == '/') {
__COPY(finalName, name, name__len);
} else {
Files_MakeFileName(Platform_CWD, 256, finalName, finalName__len, (void*)name, name__len);
}
i = Strings_Length(name, name__len) - 1;
while ((i > 0 && name[__X(i, name__len)] != '/')) {
i -= 1;
}
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 = 0;
if (finalName[0] != '/') {
while (Platform_CWD[i] != 0x00) {
name[i] = Platform_CWD[i];
i += 1;
}
if (Platform_CWD[i - 1] != '/') {
name[i] = '/';
i += 1;
}
}
j = 0;
while (finalName[j] != 0x00) {
name[i] = finalName[j];
i += 1;
j += 1;
}
i -= 1;
while (name[i] != '/') {
i -= 1;
}
name[i + 1] = '.';
name[i + 2] = 't';
name[i + 3] = 'm';
name[i + 4] = 'p';
name[i + 5] = '.';
i += 6;
while (n > 0) {
name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48);
name[i] = (CHAR)((int)__MOD(n, 10) + 48);
n = __DIV(n, 10);
i += 1;
}
name[__X(i, name__len)] = '.';
name[i] = '.';
i += 1;
n = Platform_PID;
while (n > 0) {
name[__X(i, name__len)] = __CHR((int)__MOD(n, 10) + 48);
name[i] = (CHAR)((int)__MOD(n, 10) + 48);
n = __DIV(n, 10);
i += 1;
}
name[__X(i, name__len)] = 0x00;
name[i] = 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, 256, (void*)f->workName, 256);
Files_GetTempName(f->registerName, 101, (void*)f->workName, 101);
f->tempFile = 1;
} else {
__ASSERT(f->state == 2, 0);
Files_Deregister(f->registerName, 256);
__MOVE(f->registerName, f->workName, 256);
} else if (f->state == 2) {
__COPY(f->registerName, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
error = Platform_Unlink((void*)f->workName, 256);
error = Platform_New((void*)f->workName, 256, &f->fd);
error = Platform_Unlink((void*)f->workName, 101);
error = Platform_New((void*)f->workName, 101, &f->fd);
done = error == 0;
if (done) {
f->next = Files_files;
@ -313,6 +275,27 @@ 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;
@ -320,10 +303,11 @@ void Files_Close (Files_File f)
if (f->state != 1 || f->registerName[0] != 0x00) {
Files_Create(f);
i = 0;
while ((i < 4 && f->bufs[__X(i, 4)] != NIL)) {
Files_Flush(f->bufs[__X(i, 4)]);
while ((i < 4 && f->bufs[i] != NIL)) {
Files_Flush(f->bufs[i]);
i += 1;
}
Files_CloseOSFile(f);
}
}
@ -332,13 +316,13 @@ INT32 Files_Length (Files_File f)
return f->len;
}
Files_File Files_New (CHAR *name, ADDRESS name__len)
Files_File Files_New (CHAR *name, LONGINT name__len)
{
Files_File f = NIL;
__DUP(name, name__len, CHAR);
__NEW(f, Files_FileDesc);
f->workName[0] = 0x00;
__COPY(name, f->registerName, 256);
__COPY(name, f->registerName, 101);
f->fd = -1;
f->state = 1;
f->len = 0;
@ -348,7 +332,7 @@ Files_File Files_New (CHAR *name, ADDRESS name__len)
return f;
}
static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len)
static void Files_ScanPath (INT16 *pos, CHAR *dir, LONGINT dir__len)
{
INT16 i;
CHAR ch;
@ -360,38 +344,38 @@ static void Files_ScanPath (INT16 *pos, CHAR *dir, ADDRESS dir__len)
*pos += 1;
}
} else {
ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
ch = (Files_SearchPath->data)[*pos];
while (ch == ' ' || ch == ';') {
*pos += 1;
ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
ch = (Files_SearchPath->data)[*pos];
}
if (ch == '~') {
*pos += 1;
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)];
ch = (Files_SearchPath->data)[*pos];
while (Files_HOME[i] != 0x00) {
dir[i] = Files_HOME[i];
i += 1;
}
if ((((((ch != '/' && ch != 0x00)) && ch != ';')) && ch != ' ')) {
while ((i > 0 && dir[__X(i - 1, dir__len)] != '/')) {
while ((i > 0 && dir[i - 1] != '/')) {
i -= 1;
}
}
}
while ((ch != 0x00 && ch != ';')) {
dir[__X(i, dir__len)] = ch;
dir[i] = ch;
i += 1;
*pos += 1;
ch = (Files_SearchPath->data)[__X(*pos, Files_SearchPath->len[0])];
ch = (Files_SearchPath->data)[*pos];
}
while ((i > 0 && dir[__X(i - 1, dir__len)] == ' ')) {
while ((i > 0 && dir[i - 1] == ' ')) {
i -= 1;
}
}
dir[__X(i, dir__len)] = 0x00;
dir[i] = 0x00;
}
static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len)
static BOOLEAN Files_HasDir (CHAR *name, LONGINT name__len)
{
INT16 i;
CHAR ch;
@ -399,7 +383,7 @@ static BOOLEAN Files_HasDir (CHAR *name, ADDRESS name__len)
ch = name[0];
while ((ch != 0x00 && ch != '/')) {
i += 1;
ch = name[__X(i, name__len)];
ch = name[i];
}
return ch == '/';
}
@ -408,15 +392,15 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
{
Files_File f = NIL;
INT16 i, error;
f = (Files_File)Files_files;
f = 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[__X(i, 4)] != NIL) {
f->bufs[__X(i, 4)]->org = -1;
f->bufs[__X(i, 4)] = NIL;
if (f->bufs[i] != NIL) {
f->bufs[i]->org = -1;
f->bufs[i] = NIL;
}
i += 1;
}
@ -426,12 +410,12 @@ static Files_File Files_CacheEntry (Platform_FileIdentity identity)
}
return f;
}
f = (Files_File)f->next;
f = f->next;
}
return NIL;
}
Files_File Files_Old (CHAR *name, ADDRESS name__len)
Files_File Files_Old (CHAR *name, LONGINT name__len)
{
Files_File f = NIL;
INT32 fd;
@ -472,7 +456,6 @@ Files_File Files_Old (CHAR *name, ADDRESS 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 {
@ -483,7 +466,7 @@ Files_File Files_Old (CHAR *name, ADDRESS name__len)
f->pos = 0;
f->swapper = -1;
error = Platform_Size(fd, &f->len);
__COPY(name, f->workName, 256);
__COPY(name, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
f->identity = identity;
@ -515,9 +498,9 @@ void Files_Purge (Files_File f)
INT16 error;
i = 0;
while (i < 4) {
if (f->bufs[__X(i, 4)] != NIL) {
f->bufs[__X(i, 4)]->org = -1;
f->bufs[__X(i, 4)] = NIL;
if (f->bufs[i] != NIL) {
f->bufs[i]->org = -1;
f->bufs[i] = NIL;
}
i += 1;
}
@ -543,7 +526,7 @@ void Files_GetDate (Files_File f, INT32 *t, INT32 *d)
INT32 Files_Pos (Files_Rider *r, ADDRESS *r__typ)
{
Files_Assert((*r).offset <= 4096);
__ASSERT((*r).offset <= 4096, 0);
return (*r).org + (*r).offset;
}
@ -561,22 +544,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[__X(i, 4)] != NIL)) && org != f->bufs[__X(i, 4)]->org)) {
while ((((i < 4 && f->bufs[i] != NIL)) && org != f->bufs[i]->org)) {
i += 1;
}
if (i < 4) {
if (f->bufs[__X(i, 4)] == NIL) {
if (f->bufs[i] == NIL) {
__NEW(buf, Files_BufDesc);
buf->chg = 0;
buf->org = -1;
buf->f = f;
f->bufs[__X(i, 4)] = buf;
f->bufs[i] = buf;
} else {
buf = f->bufs[__X(i, 4)];
buf = f->bufs[i];
}
} else {
f->swapper = __MASK(f->swapper + 1, -4);
buf = f->bufs[__X(f->swapper, 4)];
buf = f->bufs[f->swapper];
Files_Flush(buf);
}
if (buf->org != org) {
@ -602,7 +585,7 @@ void Files_Set (Files_Rider *r, ADDRESS *r__typ, Files_File f, INT32 pos)
org = 0;
offset = 0;
}
Files_Assert(offset <= 4096);
__ASSERT(offset <= 4096, 0);
(*r).buf = buf;
(*r).org = org;
(*r).offset = offset;
@ -621,9 +604,9 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
buf = (*r).buf;
offset = (*r).offset;
}
Files_Assert(offset <= buf->size);
__ASSERT(offset <= buf->size, 0);
if (offset < buf->size) {
*x = buf->data[__X(offset, 4096)];
*x = buf->data[offset];
(*r).offset = offset + 1;
} else if ((*r).org + offset < buf->f->len) {
Files_Set(&*r, r__typ, (*r).buf->f, (*r).org + offset);
@ -635,12 +618,7 @@ void Files_Read (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
}
}
void Files_ReadByte (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x)
{
Files_Read(&*r, r__typ, &*x);
}
void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x__len, INT32 n)
void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
{
INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
@ -666,12 +644,12 @@ void Files_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS x
} else {
min = n;
}
__MOVE((ADDRESS)&buf->data[__X(offset, 4096)], (ADDRESS)&x[__X(xpos, x__len)], min);
__MOVE((ADDRESS)buf->data + Files_ToAdr(offset), (ADDRESS)x + Files_ToAdr(xpos), min);
offset += min;
(*r).offset = offset;
xpos += min;
n -= min;
Files_Assert(offset <= 4096);
__ASSERT(offset <= 4096, 0);
}
(*r).res = 0;
(*r).eof = 0;
@ -688,14 +666,14 @@ void Files_Write (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE x)
INT32 offset;
buf = (*r).buf;
offset = (*r).offset;
Files_Assert(offset <= 4096);
__ASSERT(offset <= 4096, 0);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
Files_Assert(offset < 4096);
buf->data[__X(offset, 4096)] = x;
__ASSERT(offset < 4096, 0);
buf->data[offset] = x;
buf->chg = 1;
if (offset == buf->size) {
buf->size += 1;
@ -705,7 +683,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, ADDRESS x__len, INT32 n)
void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT x__len, INT32 n)
{
INT32 xpos, min, restInBuf, offset;
Files_Buffer buf = NIL;
@ -716,23 +694,23 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS
buf = (*r).buf;
offset = (*r).offset;
while (n > 0) {
Files_Assert(offset <= 4096);
__ASSERT(offset <= 4096, 0);
if ((*r).org != buf->org || offset >= 4096) {
Files_Set(&*r, r__typ, buf->f, (*r).org + offset);
buf = (*r).buf;
offset = (*r).offset;
}
Files_Assert(offset <= 4096);
__ASSERT(offset <= 4096, 0);
restInBuf = 4096 - offset;
if (n > restInBuf) {
min = restInBuf;
} else {
min = n;
}
__MOVE((ADDRESS)&x[__X(xpos, x__len)], (ADDRESS)&buf->data[__X(offset, 4096)], min);
__MOVE((ADDRESS)x + Files_ToAdr(xpos), (ADDRESS)buf->data + Files_ToAdr(offset), min);
offset += min;
(*r).offset = offset;
Files_Assert(offset <= 4096);
__ASSERT(offset <= 4096, 0);
if (offset > buf->size) {
buf->f->len += offset - buf->size;
buf->size = offset;
@ -744,15 +722,14 @@ void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, ADDRESS
(*r).res = 0;
}
void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res)
void Files_Delete (CHAR *name, LONGINT 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, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res)
void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT new__len, INT16 *res)
{
INT32 fdold, fdnew, n;
INT16 error, ignore;
@ -818,30 +795,31 @@ 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_Deregister(f->registerName, 256);
Files_Rename(f->workName, 256, f->registerName, 256, &errcode);
Files_Rename(f->workName, 101, f->registerName, 101, &errcode);
if (errcode != 0) {
Files_Err((CHAR*)"Couldn't rename temp name as register name", 43, f, errcode);
__COPY(f->registerName, file, 104);
__HALT(99);
}
__MOVE(f->registerName, f->workName, 256);
__COPY(f->registerName, f->workName, 101);
f->registerName[0] = 0x00;
f->tempFile = 0;
}
}
void Files_ChangeDirectory (CHAR *path, ADDRESS path__len, INT16 *res)
void Files_ChangeDirectory (CHAR *path, LONGINT 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, ADDRESS src__len, SYSTEM_BYTE *dest, ADDRESS dest__len)
static void Files_FlipBytes (SYSTEM_BYTE *src, LONGINT src__len, SYSTEM_BYTE *dest, LONGINT dest__len)
{
INT32 i, j;
if (!Platform_LittleEndian) {
@ -849,7 +827,7 @@ static void Files_FlipBytes (SYSTEM_BYTE *src, ADDRESS src__len, SYSTEM_BYTE *de
j = 0;
while (i > 0) {
i -= 1;
dest[__X(j, dest__len)] = src[__X(i, src__len)];
dest[j] = src[i];
j += 1;
}
} else {
@ -899,36 +877,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, ADDRESS x__len)
void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
INT16 i;
CHAR ch;
i = 0;
do {
Files_Read(&*R, R__typ, (void*)&ch);
x[__X(i, x__len)] = ch;
x[i] = ch;
i += 1;
} while (!(ch == 0x00));
}
void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len)
void Files_ReadLine (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
INT16 i;
i = 0;
do {
Files_Read(&*R, R__typ, (void*)&x[__X(i, x__len)]);
Files_Read(&*R, R__typ, (void*)&x[i]);
i += 1;
} while (!(x[__X(i - 1, x__len)] == 0x00 || x[__X(i - 1, x__len)] == 0x0a));
if (x[__X(i - 1, x__len)] == 0x0a) {
} while (!(x[i - 1] == 0x00 || x[i - 1] == 0x0a));
if (x[i - 1] == 0x0a) {
i -= 1;
}
if ((i > 0 && x[__X(i - 1, x__len)] == 0x0d)) {
if ((i > 0 && x[i - 1] == 0x0d)) {
i -= 1;
}
x[__X(i, x__len)] = 0x00;
x[i] = 0x00;
}
void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len)
void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, LONGINT x__len)
{
INT8 s, b;
INT64 q;
@ -941,7 +919,7 @@ void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__
Files_Read(&*R, R__typ, (void*)&b);
}
q += (INT64)__ASH((__MASK(b, -64) - __ASHL(__ASHR(b, 6), 6)), s);
Files_Assert(x__len <= 8);
__ASSERT(x__len <= 8, 0);
__MOVE((ADDRESS)&q, (ADDRESS)x, x__len);
}
@ -953,18 +931,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] = __CHR(x);
b[1] = __CHR(__ASHR(x, 8));
b[0] = (CHAR)x;
b[1] = (CHAR)__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] = __CHR(x);
b[1] = __CHR(__ASHR(x, 8));
b[2] = __CHR(__ASHR(x, 16));
b[3] = __CHR(__ASHR(x, 24));
b[0] = (CHAR)x;
b[1] = (CHAR)__ASHR(x, 8);
b[2] = (CHAR)__ASHR(x, 16);
b[3] = (CHAR)__ASHR(x, 24);
Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
@ -972,13 +950,11 @@ void Files_WriteSet (Files_Rider *R, ADDRESS *R__typ, UINT32 x)
{
CHAR b[4];
INT32 i;
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));
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);
Files_WriteBytes(&*R, R__typ, (void*)b, 4, 4);
}
@ -996,11 +972,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, ADDRESS x__len)
void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len)
{
INT16 i;
i = 0;
while (x[__X(i, x__len)] != 0x00) {
while (x[i] != 0x00) {
i += 1;
}
Files_WriteBytes(&*R, R__typ, (void*)x, x__len * 1, i + 1);
@ -1009,38 +985,17 @@ void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, ADDRESS x__len
void Files_WriteNum (Files_Rider *R, ADDRESS *R__typ, INT64 x)
{
while (x < -64 || x > 63) {
Files_Write(&*R, R__typ, __CHR(__MASK(x, -128) + 128));
Files_Write(&*R, R__typ, (CHAR)(__MASK(x, -128) + 128));
x = __ASHR(x, 7);
}
Files_Write(&*R, R__typ, __CHR(__MASK(x, -128)));
Files_Write(&*R, R__typ, (CHAR)__MASK(x, -128));
}
void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len)
void Files_GetName (Files_File f, CHAR *name, LONGINT 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;
@ -1049,12 +1004,12 @@ static void Files_Finalize (SYSTEM_PTR o)
if (f->fd >= 0) {
Files_CloseOSFile(f);
if (f->tempFile) {
res = Platform_Unlink((void*)f->workName, 256);
res = Platform_Unlink((void*)f->workName, 101);
}
}
}
void Files_SetSearchPath (CHAR *path, ADDRESS path__len)
void Files_SetSearchPath (CHAR *path, LONGINT path__len)
{
__DUP(path, path__len, CHAR);
if (Strings_Length(path, path__len) != 0) {
@ -1068,10 +1023,11 @@ void Files_SetSearchPath (CHAR *path, ADDRESS path__len)
static void EnumPtrs(void (*P)(void*))
{
P(Files_files);
P(Files_SearchPath);
}
__TDESC(Files_FileDesc, 1, 4) = {__TDFLDS("FileDesc", 592), {544, 552, 560, 568, -40}};
__TDESC(Files_FileDesc, 1, 5) = {__TDFLDS("FileDesc", 280), {232, 240, 248, 256, 272, -48}};
__TDESC(Files_BufDesc, 1, 1) = {__TDFLDS("BufDesc", 4120), {0, -16}};
__TDESC(Files_Rider, 1, 1) = {__TDFLDS("Rider", 24), {8, -16}};
@ -1091,7 +1047,5 @@ 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;
}

34
bootstrap/unix-88/Files.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#ifndef Files__h
#define Files__h
@ -11,7 +11,9 @@ typedef
typedef
struct Files_FileDesc {
INT64 _prvt0;
char _prvt1[584];
char _prvt1[208];
INT32 fd;
char _prvt2[60];
} Files_FileDesc;
typedef
@ -23,48 +25,46 @@ 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, ADDRESS path__len, INT16 *res);
import void Files_ChangeDirectory (CHAR *path, LONGINT path__len, INT16 *res);
import void Files_Close (Files_File f);
import void Files_Delete (CHAR *name, ADDRESS name__len, INT16 *res);
import void Files_Delete (CHAR *name, LONGINT name__len, INT16 *res);
import void Files_GetDate (Files_File f, INT32 *t, INT32 *d);
import void Files_GetName (Files_File f, CHAR *name, ADDRESS name__len);
import void Files_GetName (Files_File f, CHAR *name, LONGINT name__len);
import INT32 Files_Length (Files_File f);
import Files_File Files_New (CHAR *name, ADDRESS name__len);
import Files_File Files_Old (CHAR *name, ADDRESS name__len);
import Files_File Files_New (CHAR *name, LONGINT name__len);
import Files_File Files_Old (CHAR *name, LONGINT 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_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_ReadBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT 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, ADDRESS x__len);
import void Files_ReadNum (Files_Rider *R, ADDRESS *R__typ, SYSTEM_BYTE *x, ADDRESS x__len);
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_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, ADDRESS x__len);
import void Files_ReadString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void Files_Register (Files_File f);
import void Files_Rename (CHAR *old, ADDRESS old__len, CHAR *new, ADDRESS new__len, INT16 *res);
import void Files_Rename (CHAR *old, LONGINT old__len, CHAR *new, LONGINT 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, ADDRESS path__len);
import void Files_SetSearchPath (CHAR *path, LONGINT 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, ADDRESS x__len, INT32 n);
import void Files_WriteBytes (Files_Rider *r, ADDRESS *r__typ, SYSTEM_BYTE *x, LONGINT 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, ADDRESS x__len);
import void Files_WriteString (Files_Rider *R, ADDRESS *R__typ, CHAR *x, LONGINT x__len);
import void *Files__init(void);

336
bootstrap/unix-88/Heap.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tsSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -68,10 +68,8 @@ static INT64 Heap_freeList[10];
static INT64 Heap_bigBlocks;
export INT64 Heap_allocated;
static BOOLEAN Heap_firstTry;
static INT16 Heap_ldUnit;
export INT64 Heap_heap;
static INT64 Heap_heapMin, Heap_heapMax;
export INT64 Heap_heapsize, Heap_heapMinExpand;
static INT64 Heap_heap, Heap_heapend;
export INT64 Heap_heapsize;
static Heap_FinNode Heap_fin;
static INT16 Heap_lockdepth;
static BOOLEAN Heap_interrupted;
@ -86,16 +84,15 @@ 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 (INT32 n, INT64 *a, ADDRESS a__len);
static void Heap_HeapSort (INT64 n, INT64 *a, LONGINT a__len);
export void Heap_INCREF (Heap_Module m);
export void Heap_InitHeap (void);
export void Heap_Lock (void);
static void Heap_Mark (INT64 q);
static void Heap_MarkCandidates (INT32 n, INT64 *cand, ADDRESS cand__len);
static void Heap_MarkCandidates (INT64 n, INT64 *cand, LONGINT cand__len);
static void Heap_MarkP (SYSTEM_PTR p);
static void Heap_MarkStack (INT64 n, INT64 *cand, ADDRESS cand__len);
static void Heap_MarkStack (INT64 n, INT64 *cand, LONGINT cand__len);
export SYSTEM_PTR Heap_NEWBLK (INT64 size);
export SYSTEM_PTR Heap_NEWREC (INT64 tag);
static INT64 Heap_NewChunk (INT64 blksz);
@ -104,18 +101,16 @@ 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 (INT32 l, INT32 r, INT64 *a, ADDRESS a__len);
static void Heap_Sift (INT64 l, INT64 r, INT64 *a, LONGINT a__len);
export void Heap_Unlock (void);
extern void *Heap__init();
extern ADDRESS Modules_MainStackFrame;
extern ADDRESS Platform_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_uLE(x, y) ((size_t)x <= (size_t)y)
#define Heap_uLT(x, y) ((size_t)x < (size_t)y)
#define Heap_PlatformMainStackFrame() Platform_MainStackFrame
void Heap_Lock (void)
{
@ -148,35 +143,6 @@ 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;
@ -204,24 +170,16 @@ void Heap_INCREF (Heap_Module m)
static INT64 Heap_NewChunk (INT64 blksz)
{
INT64 chnk, blk, end;
INT64 chnk;
chnk = Heap_OSAllocate(blksz + 24);
if (chnk != 0) {
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;
__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;
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;
}
@ -229,28 +187,29 @@ static INT64 Heap_NewChunk (INT64 blksz)
static void Heap_ExtendHeap (INT64 blksz)
{
INT64 size, chnk, j, next;
if (Heap_uLT(Heap_heapMinExpand, blksz)) {
if (blksz > 320000) {
size = blksz;
} else {
size = Heap_heapMinExpand;
size = 320000;
}
chnk = Heap_NewChunk(size);
if (chnk != 0) {
if (Heap_uLT(chnk, Heap_heap)) {
if (chnk < Heap_heap) {
__PUT(chnk, Heap_heap, INT64);
Heap_heap = chnk;
} else {
j = Heap_heap;
__GET(j, next, INT64);
while ((next != 0 && Heap_uLT(next, chnk))) {
while ((next != 0 && chnk > next)) {
j = next;
__GET(j, next, INT64);
}
__PUT(chnk, next, INT64);
__PUT(j, chnk, INT64);
}
} else if (!Heap_firstTry) {
Heap_heapMinExpand = 32;
if (next == 0) {
__GET(chnk + 8, Heap_heapend, INT64);
}
}
}
@ -260,7 +219,7 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
SYSTEM_PTR new;
Heap_Lock();
__GET(tag, blksz, INT64);
i0 = __LSH(blksz, -Heap_ldUnit, 64);
i0 = __ASHR(blksz, 5);
i = i0;
if (i < 9) {
adr = Heap_freeList[i];
@ -292,17 +251,16 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
if (Heap_firstTry) {
Heap_GC(1);
blksz += 32;
t = __LSH(Heap_allocated + blksz, -(2 + Heap_ldUnit), 64) * 160;
if (Heap_uLT(Heap_heapsize, t)) {
Heap_ExtendHeap(t - Heap_heapsize);
if (__ASHL((Heap_heapsize - Heap_allocated) - blksz, 2) < Heap_heapsize) {
Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 96), 7) - Heap_heapsize);
}
Heap_firstTry = 0;
new = Heap_NEWREC(tag);
Heap_firstTry = 1;
if (new == NIL) {
Heap_ExtendHeap(blksz);
Heap_ExtendHeap(__ASHL(__DIV(Heap_allocated + blksz, 96), 7) - Heap_heapsize);
new = Heap_NEWREC(tag);
}
Heap_firstTry = 1;
Heap_Unlock();
return new;
} else {
@ -311,7 +269,7 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
}
}
__GET(adr + 8, t, INT64);
if (Heap_uLE(blksz, t)) {
if (t >= blksz) {
break;
}
prev = adr;
@ -322,7 +280,7 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
__PUT(end + 8, blksz, INT64);
__PUT(end + 16, -8, INT64);
__PUT(end, end + 8, INT64);
if (Heap_uLT(288, restsize)) {
if (restsize > 288) {
__PUT(adr + 8, restsize, INT64);
} else {
__GET(adr + 24, next, INT64);
@ -331,7 +289,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);
@ -342,7 +300,7 @@ SYSTEM_PTR Heap_NEWREC (INT64 tag)
}
i = adr + 32;
end = adr + blksz;
while (Heap_uLT(i, end)) {
while (i < end) {
__PUT(i, 0, INT64);
__PUT(i + 8, 0, INT64);
__PUT(i + 16, 0, INT64);
@ -439,17 +397,17 @@ static void Heap_Scan (void)
while (chnk != 0) {
adr = chnk + 24;
__GET(chnk + 8, end, INT64);
while (Heap_uLT(adr, end)) {
while (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 = __LSH(freesize, -Heap_ldUnit, 64);
i = __ASHR(freesize, 5);
freesize = 0;
if (Heap_uLT(i, 9)) {
if (i < 9) {
__PUT(start + 24, Heap_freeList[i], INT64);
Heap_freeList[i] = start;
} else {
@ -468,14 +426,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 = __LSH(freesize, -Heap_ldUnit, 64);
i = __ASHR(freesize, 5);
freesize = 0;
if (Heap_uLT(i, 9)) {
if (i < 9) {
__PUT(start + 24, Heap_freeList[i], INT64);
Heap_freeList[i] = start;
} else {
@ -487,19 +445,18 @@ static void Heap_Scan (void)
}
}
static void Heap_Sift (INT32 l, INT32 r, INT64 *a, ADDRESS a__len)
static void Heap_Sift (INT64 l, INT64 r, INT64 *a, LONGINT a__len)
{
INT32 i, j;
INT64 x;
INT64 i, j, x;
j = l;
x = a[j];
for (;;) {
i = j;
j = __ASHL(j, 1) + 1;
if ((j < r && Heap_uLT(a[j], a[j + 1]))) {
if ((j < r && a[j] < a[j + 1])) {
j += 1;
}
if (j > r || Heap_uLE(a[j], x)) {
if (j > r || a[j] <= x) {
break;
}
a[i] = a[j];
@ -507,10 +464,9 @@ static void Heap_Sift (INT32 l, INT32 r, INT64 *a, ADDRESS a__len)
a[i] = x;
}
static void Heap_HeapSort (INT32 n, INT64 *a, ADDRESS a__len)
static void Heap_HeapSort (INT64 n, INT64 *a, LONGINT a__len)
{
INT32 l, r;
INT64 x;
INT64 l, r, x;
l = __ASHR(n, 1);
r = n - 1;
while (l > 0) {
@ -526,42 +482,37 @@ static void Heap_HeapSort (INT32 n, INT64 *a, ADDRESS a__len)
}
}
static void Heap_MarkCandidates (INT32 n, INT64 *cand, ADDRESS cand__len)
static void Heap_MarkCandidates (INT64 n, INT64 *cand, LONGINT cand__len)
{
INT64 chnk, end, adr, tag, next, i, ptr, size;
chnk = Heap_heap;
INT64 chnk, adr, tag, next, lim, lim1, i, ptr, size;
chnk = Heap_heap;
i = 0;
while (chnk != 0) {
__GET(chnk + 8, end, INT64);
lim = cand[n - 1];
while ((chnk != 0 && chnk < lim)) {
adr = chnk + 24;
while (Heap_uLT(adr, end)) {
__GET(chnk + 8, lim1, INT64);
if (lim < lim1) {
lim1 = lim;
}
while (adr < lim1) {
__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;
adr += size;
while (Heap_uLT(cand[i], ptr)) {
while (cand[i] < ptr) {
i += 1;
if (i == (INT64)n) {
return;
}
}
if (Heap_uLT(cand[i], adr)) {
if (i == n) {
return;
}
next = adr + size;
if (cand[i] < next) {
Heap_Mark(ptr);
}
}
if (Heap_uLE(end, cand[i])) {
adr = end;
adr = next;
}
}
__GET(chnk, chnk, INT64);
@ -620,11 +571,10 @@ void Heap_FINALL (void)
}
}
static void Heap_MarkStack (INT64 n, INT64 *cand, ADDRESS cand__len)
static void Heap_MarkStack (INT64 n, INT64 *cand, LONGINT cand__len)
{
SYSTEM_PTR frame;
INT32 nofcand;
INT64 inc, sp, p, stack0;
INT64 inc, nofcand, sp, p, stack0;
struct Heap__1 align;
if (n > 0) {
Heap_MarkStack(n - 1, cand, cand__len);
@ -635,15 +585,15 @@ static void Heap_MarkStack (INT64 n, INT64 *cand, ADDRESS cand__len)
if (n == 0) {
nofcand = 0;
sp = (ADDRESS)&frame;
stack0 = Heap_ModulesMainStackFrame();
stack0 = Heap_PlatformMainStackFrame();
inc = (ADDRESS)&align.p - (ADDRESS)&align;
if (Heap_uLT(stack0, sp)) {
if (sp > stack0) {
inc = -inc;
}
while (sp != stack0) {
__GET(sp, p, INT64);
if ((Heap_uLE(Heap_heapMin, p) && Heap_uLT(p, Heap_heapMax))) {
if (nofcand == cand__len) {
if ((p > Heap_heap && p < Heap_heapend)) {
if (nofcand == (INT64)cand__len) {
Heap_HeapSort(nofcand, (void*)cand, cand__len);
Heap_MarkCandidates(nofcand, (void*)cand, cand__len);
nofcand = 0;
@ -665,77 +615,79 @@ 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];
Heap_Lock();
m = (Heap_Module)(ADDRESS)Heap_modules;
while (m != NIL) {
if (m->enumPtrs != NIL) {
(*m->enumPtrs)(Heap_MarkP);
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;
}
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 (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;
}
}
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();
}
Heap_CheckFin();
Heap_Scan();
Heap_Finalize();
Heap_Unlock();
}
void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
@ -751,21 +703,17 @@ void Heap_RegisterFinalizer (SYSTEM_PTR obj, Heap_Finalizer finalize)
void Heap_InitHeap (void)
{
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);
__GET(Heap_heap + 8, Heap_heapend, INT64);
__PUT(Heap_heap, 0, INT64);
Heap_allocated = 0;
Heap_firstTry = 1;
Heap_freeList[9] = 1;
Heap_lockdepth = 0;
Heap_FileCount = 0;
Heap_modules = NIL;
Heap_heapsize = 0;
Heap_bigBlocks = 0;
Heap_fin = NIL;
Heap_interrupted = 0;
Heap_HeapModuleInit();

33
bootstrap/unix-88/Heap.h
View file

@ -1,26 +1,16 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. rtsSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tsSF */
#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));
@ -31,31 +21,22 @@ typedef
struct Heap_ModuleDesc *Heap_Module;
typedef
CHAR Heap_ModuleName[20];
struct Heap_ModuleDesc {
INT64 _prvt0;
char _prvt1[56];
} Heap_ModuleDesc;
typedef
struct Heap_ModuleDesc {
Heap_Module next;
Heap_ModuleName name;
INT32 refcnt;
Heap_Cmd cmds;
INT64 types;
Heap_EnumProc enumPtrs;
char _prvt0[8];
} Heap_ModuleDesc;
CHAR Heap_ModuleName[20];
import SYSTEM_PTR Heap_modules;
import INT64 Heap_allocated;
import INT64 Heap_heap;
import INT64 Heap_heapsize, Heap_heapMinExpand;
import INT64 Heap_allocated, Heap_heapsize;
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);

380
bootstrap/unix-88/Modules.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -9,303 +9,81 @@
#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 Heap_ModuleName Modules_imported, Modules_importing;
export INT64 Modules_MainStackFrame;
export INT16 Modules_ArgCount;
export INT64 Modules_ArgVector;
export CHAR Modules_BinaryDir[1024];
export Modules_ModuleName Modules_imported, Modules_importing;
export ADDRESS *Modules_ModuleDesc__typ;
export ADDRESS *Modules_CmdDesc__typ;
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);
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__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);
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_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
export void Modules_Halt (INT32 code);
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);
export Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
export Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
static void Modules_errch (CHAR c);
static void Modules_errint (INT32 l);
static void Modules_errstring (CHAR *s, ADDRESS s__len);
static void Modules_errstring (CHAR *s, LONGINT s__len);
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
#define Modules_modules() (Modules_Module)Heap_modules
#define Modules_setmodules(m) Heap_modules = m
void Modules_Init (INT32 argc, INT64 argvadr)
{
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;
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;
}
__DEL(s);
return i;
}
static void Modules_Append (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
static void Modules_Append (CHAR *a, LONGINT a__len, CHAR *b, LONGINT b__len)
{
INT16 i, j;
__DUP(s, s__len, CHAR);
__DUP(b, b__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;
}
d[__X(j, d__len)] = 0x00;
__DEL(s);
}
static void Modules_AppendPart (CHAR c, 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);
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)) {
while (a[__X(i, a__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;
while (b[__X(j, b__len)] != 0x00) {
a[__X(i, a__len)] = b[__X(j, b__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);
a[__X(i, a__len)] = 0x00;
__DEL(b);
}
static void Modules_Trim (CHAR *s, ADDRESS s__len, CHAR *d, ADDRESS d__len)
Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__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;
Modules_Module m = NIL;
CHAR bodyname[64];
Heap_Command body;
Modules_Command body;
__DUP(name, name__len, CHAR);
m = Modules_modules();
while ((m != NIL && __STRCMP(m->name, name) != 0)) {
@ -318,16 +96,16 @@ Heap_Module Modules_ThisMod (CHAR *name, ADDRESS name__len)
Modules_res = 1;
__COPY(name, Modules_importing, 20);
__MOVE(" module \"", Modules_resMsg, 10);
Modules_Append(name, name__len, (void*)Modules_resMsg, 256);
Modules_Append((CHAR*)"\" not found", 12, (void*)Modules_resMsg, 256);
Modules_Append((void*)Modules_resMsg, 256, name, name__len);
Modules_Append((void*)Modules_resMsg, 256, (CHAR*)"\" not found", 12);
}
__DEL(name);
return m;
}
Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len)
Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len)
{
Heap_Cmd c = NIL;
Modules_Cmd c = NIL;
__DUP(name, name__len, CHAR);
c = mod->cmds;
while ((c != NIL && __STRCMP(c->name, name) != 0)) {
@ -342,36 +120,43 @@ Heap_Command Modules_ThisCommand (Heap_Module mod, CHAR *name, ADDRESS name__len
Modules_res = 2;
__MOVE(" command \"", Modules_resMsg, 11);
__COPY(name, Modules_importing, 20);
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);
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);
__DEL(name);
return NIL;
}
__RETCHK;
}
void Modules_Free (CHAR *name, ADDRESS name__len, BOOLEAN all)
void Modules_Free (CHAR *name, LONGINT name__len, BOOLEAN all)
{
Heap_Module m = NIL, p = NIL;
INT32 refcount;
Modules_Module m = NIL, p = NIL;
__DUP(name, name__len, CHAR);
m = Modules_modules();
if (all) {
Modules_res = 1;
__MOVE("unloading \"all\" not yet supported", Modules_resMsg, 34);
} else {
refcount = Heap_FreeModule(name, name__len);
if (refcount == 0) {
while ((m != NIL && __STRCMP(m->name, name) != 0)) {
p = m;
m = m->next;
}
if ((m != NIL && m->refcnt == 0)) {
if (m == Modules_modules()) {
Modules_setmodules(m->next);
} else {
p->next = m->next;
}
Modules_res = 0;
} else {
if (refcount < 0) {
Modules_res = 1;
if (m == NIL) {
__MOVE("module not found", Modules_resMsg, 17);
} else {
__MOVE("clients of this module exist", Modules_resMsg, 29);
}
Modules_res = 1;
}
}
__DEL(name);
@ -383,7 +168,7 @@ static void Modules_errch (CHAR c)
e = Platform_Write(1, (ADDRESS)&c, 1);
}
static void Modules_errstring (CHAR *s, ADDRESS s__len)
static void Modules_errstring (CHAR *s, LONGINT s__len)
{
INT32 i;
__DUP(s, s__len, CHAR);
@ -404,7 +189,7 @@ static void Modules_errint (INT32 l)
if (l >= 10) {
Modules_errint(__DIV(l, 10));
}
Modules_errch(__CHR((int)__MOD(l, 10) + 48));
Modules_errch((CHAR)((int)__MOD(l, 10) + 48));
}
static void Modules_DisplayHaltCode (INT32 code)
@ -465,7 +250,6 @@ 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);
@ -478,7 +262,6 @@ 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);
@ -486,13 +269,11 @@ void Modules_AssertFail (INT32 code)
Modules_errstring((CHAR*)".", 2);
}
Modules_errstring(Platform_NL, 3);
if (code > 0) {
Platform_Exit(code);
} else {
Platform_Exit(-1);
}
Platform_Exit(code);
}
__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)
{
@ -500,7 +281,8 @@ 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;
}

51
bootstrap/unix-88/Modules.h
View file

@ -1,30 +1,53 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef Modules__h
#define Modules__h
#include "SYSTEM.h"
#include "Heap.h"
typedef
struct Modules_CmdDesc *Modules_Cmd;
typedef
void (*Modules_Command)(void);
typedef
struct Modules_CmdDesc {
Modules_Cmd next;
CHAR name[24];
Modules_Command cmd;
} Modules_CmdDesc;
typedef
struct Modules_ModuleDesc *Modules_Module;
typedef
CHAR Modules_ModuleName[20];
typedef
struct Modules_ModuleDesc {
Modules_Module next;
Modules_ModuleName name;
INT32 refcnt;
Modules_Cmd cmds;
INT32 types;
void (*enumPtrs)(void(*)(INT32));
char _prvt0[8];
} Modules_ModuleDesc;
import INT16 Modules_res;
import CHAR Modules_resMsg[256];
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 Modules_ModuleName Modules_imported, Modules_importing;
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, 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_Free (CHAR *name, LONGINT name__len, BOOLEAN all);
import void Modules_Halt (INT32 code);
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 Modules_Command Modules_ThisCommand (Modules_Module mod, CHAR *name, LONGINT name__len);
import Modules_Module Modules_ThisMod (CHAR *name, LONGINT name__len);
import void *Modules__init(void);

43
bootstrap/unix-88/OPB.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#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();
__MOVE(str, *x->conval->ext, 256);
__COPY(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 = __CHR(n->conval->intval);
ch = (CHAR)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 == (-9223372036854775807LL-1)) {
if (z->conval->intval == (-9223372036854775807-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 == (-9223372036854775807LL-1)) {
if (z->conval->intval == (-9223372036854775807-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(__CHR(z->conval->intval));
z->conval->intval = (INT16)__CAP((CHAR)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(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))) {
if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807-1))) && yv != (-9223372036854775807-1))) && -xv <= __DIV(9223372036854775807, -yv))) {
xval->intval = xv * yv;
OPB_SetIntType(x);
} else {
@ -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 <= 9223372036854775807LL - yval->intval);
if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807LL-1) - yval->intval)) {
temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807 - yval->intval);
if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807-1) - yval->intval)) {
xval->intval += yval->intval;
OPB_SetIntType(x);
} else {
@ -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 >= (-9223372036854775807LL-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807LL + yval->intval)) {
if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807 + yval->intval)) {
xval->intval -= yval->intval;
OPB_SetIntType(x);
} else {
@ -1136,7 +1136,7 @@ static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
OPB_err(203);
r = (LONGREAL)1;
}
(*x)->conval->intval = __SHORT(__ENTIER(r), 2147483648LL);
(*x)->conval->intval = (INT32)__ENTIER(r);
OPB_SetIntType(*x);
}
}
@ -1624,20 +1624,23 @@ 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) {
@ -2088,7 +2091,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(9223372036854775807LL, (INT64)__ASH(1, x->conval->intval))) {
if (__ABS(p->conval->intval) <= __DIV(9223372036854775807, (INT64)__ASH(1, x->conval->intval))) {
p->conval->intval = p->conval->intval * (INT64)__ASH(1, x->conval->intval);
} else {
OPB_err(208);
@ -2533,6 +2536,7 @@ 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);
}
@ -2558,8 +2562,13 @@ 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 = 0;
(*x)->subcl = subcl;
}
void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ)
@ -2586,7 +2595,7 @@ export void *OPB__init(void)
__MODULE_IMPORT(OPT);
__REGMOD("OPB", 0);
/* BEGIN */
OPB_maxExp = OPB_log(4611686018427387904LL);
OPB_maxExp = OPB_log(4611686018427387904);
OPB_maxExp = OPB_exp;
__ENDMOD;
}

2
bootstrap/unix-88/OPB.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPB__h
#define OPB__h

127
bootstrap/unix-88/OPC.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#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, ADDRESS name__len);
static void OPC_Include (CHAR *name, LONGINT 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, ADDRESS s__len);
static INT16 OPC_Length (CHAR *s, LONGINT s__len);
export BOOLEAN OPC_NeedsRetval (OPT_Object proc);
export INT32 OPC_NofPtrs (OPT_Struct typ);
static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len);
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len);
static INT16 OPC_PerfectHash (CHAR *s, LONGINT s__len);
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len);
static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define);
static void OPC_ProcPredefs (OPT_Object obj, 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, ADDRESS s__len, INT32 x);
static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l);
static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x);
static void OPC_StringLiteral (CHAR *s, LONGINT 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, ADDRESS s__len, INT32 x)
static void OPC_Str1 (CHAR *s, LONGINT s__len, INT32 x)
{
CHAR ch;
INT16 i;
@ -156,7 +156,7 @@ static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x)
__DEL(s);
}
static INT16 OPC_Length (CHAR *s, ADDRESS s__len)
static INT16 OPC_Length (CHAR *s, LONGINT s__len)
{
INT16 i;
i = 0;
@ -166,7 +166,7 @@ static INT16 OPC_Length (CHAR *s, ADDRESS s__len)
return i;
}
static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len)
static INT16 OPC_PerfectHash (CHAR *s, LONGINT 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*)"ADDRESS len[#]", 15, nofdims);
OPC_Str1((CHAR*)"LONGINT 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*)", ADDRESS ", 11);
OPM_WriteString((CHAR*)", LONGINT ", 11);
} else {
OPM_WriteString((CHAR*)", ", 3);
}
@ -618,33 +618,31 @@ 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))) {
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);
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);
OPM_Write(')');
OPM_WriteLn();
} 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(')');
OPM_WriteLn();
}
OPC_DefineTProcMacros(obj->right, &*empty);
}
@ -654,7 +652,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) || (((OPM_currFile == 0 && str->strobj != NIL)) && str->strobj->vis == 1)) {
if (OPM_currFile == 1 || str->ref < 255) {
obj = str->strobj;
if (obj == NIL || OPC_Undefined(obj)) {
if (obj != NIL) {
@ -683,10 +681,6 @@ 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) {
@ -721,19 +715,12 @@ 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, ADDRESS y__len)
static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, LONGINT y__len)
{
INT16 i;
__DUP(y, y__len, CHAR);
@ -981,8 +968,8 @@ static void OPC_IdentList (OPT_Object obj, INT16 vis)
if (obj->typ->comp == 3) {
OPC_EndStat();
OPC_BegStat();
base = OPT_adrtyp;
OPM_WriteString((CHAR*)"ADDRESS ", 9);
base = OPT_linttyp;
OPM_WriteString((CHAR*)"LONGINT ", 9);
OPC_LenList(obj, 0, 1);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPC_EndStat();
@ -1021,7 +1008,7 @@ static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
__COPY(name, obj->name, 256);
}
if (obj->typ->comp == 3) {
OPM_WriteString((CHAR*)", ADDRESS ", 11);
OPM_WriteString((CHAR*)", LONGINT ", 11);
OPC_LenList(obj, 1, showParamNames);
} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
OPM_WriteString((CHAR*)", ADDRESS *", 12);
@ -1075,7 +1062,7 @@ static void OPC_ProcPredefs (OPT_Object obj, INT8 vis)
}
}
static void OPC_Include (CHAR *name, ADDRESS name__len)
static void OPC_Include (CHAR *name, LONGINT name__len)
{
__DUP(name, name__len, CHAR);
OPM_WriteString((CHAR*)"#include ", 10);
@ -1151,7 +1138,7 @@ static void OPC_GenHeaderMsg (void)
OPM_WriteString((CHAR*)"/* ", 4);
OPM_WriteString((CHAR*)"voc", 4);
OPM_Write(' ');
OPM_WriteString(Configuration_versionLong, 76);
OPM_WriteString(Configuration_versionLong, 75);
OPM_Write(' ');
i = 0;
while (i <= 31) {
@ -1672,9 +1659,9 @@ void OPC_CompleteIdent (OPT_Object obj)
OPC_Ident(obj);
OPM_WriteString((CHAR*)"__", 3);
} else {
OPM_WriteString((CHAR*)"(*(", 4);
OPM_WriteString((CHAR*)"((", 3);
OPC_Ident(obj->typ->strobj);
OPM_WriteString((CHAR*)"*)&", 4);
OPM_Write(')');
OPC_Ident(obj);
OPM_Write(')');
}
@ -1752,12 +1739,12 @@ static void OPC_CharacterLiteral (INT64 c)
if ((c == 92 || c == 39) || c == 63) {
OPM_Write('\\');
}
OPM_Write(__CHR(c));
OPM_Write((CHAR)c);
OPM_Write('\'');
}
}
static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
static void OPC_StringLiteral (CHAR *s, LONGINT s__len, INT32 l)
{
INT32 i;
INT16 c;
@ -1768,16 +1755,16 @@ static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
c = (INT16)s[__X(i, s__len)];
if (c < 32 || c > 126) {
OPM_Write('\\');
OPM_Write(__CHR(48 + __ASHR(c, 6)));
OPM_Write((CHAR)(48 + __ASHR(c, 6)));
c = __MASK(c, -64);
OPM_Write(__CHR(48 + __ASHR(c, 3)));
OPM_Write((CHAR)(48 + __ASHR(c, 3)));
c = __MASK(c, -8);
OPM_Write(__CHR(48 + c));
OPM_Write((CHAR)(48 + c));
} else {
if ((c == 92 || c == 34) || c == 63) {
OPM_Write('\\');
}
OPM_Write(__CHR(c));
OPM_Write((CHAR)c);
}
i += 1;
}
@ -1843,12 +1830,6 @@ 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);
@ -1856,6 +1837,10 @@ 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);
}
}
@ -1927,9 +1912,9 @@ static struct InitKeywords__46 {
struct InitKeywords__46 *lnk;
} *InitKeywords__46_s;
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)
static void Enter__47 (CHAR *s, LONGINT s__len)
{
INT16 h;
__DUP(s, s__len, CHAR);

2
bootstrap/unix-88/OPC.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPC__h
#define OPC__h

330
bootstrap/unix-88/OPM.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -8,7 +8,6 @@
#include "SYSTEM.h"
#include "Configuration.h"
#include "Files.h"
#include "Modules.h"
#include "Out.h"
#include "Platform.h"
#include "Strings.h"
@ -19,8 +18,6 @@ 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];
@ -29,7 +26,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, OPM_SetSize;
export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize;
export INT64 OPM_MaxIndex;
export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
export BOOLEAN OPM_noerr;
@ -44,48 +41,41 @@ 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_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
export void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
export void OPM_DeleteNewSym (void);
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, ADDRESS bytes__len);
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len);
export void OPM_Get (CHAR *ch);
export void OPM_GetComment (CHAR *text, ADDRESS text__len);
export void OPM_Init (BOOLEAN *done);
export void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
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, ADDRESS vt100code__len);
export void OPM_LogVT100 (CHAR *vt100code, LONGINT 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, ADDRESS s__len);
export void OPM_LogWStr (CHAR *s, LONGINT s__len);
export INT32 OPM_Longint (INT64 n);
static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len);
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len);
export void OPM_Mark (INT16 n, INT32 pos);
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 void OPM_NewSym (CHAR *modName, LONGINT modName__len);
export void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
export void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
export BOOLEAN OPM_OpenPar (void);
export void OPM_RegisterNewSym (void);
static void OPM_ScanOptions (CHAR *s, ADDRESS s__len);
static void OPM_ScanOptions (CHAR *s, LONGINT 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);
@ -97,13 +87,14 @@ 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, ADDRESS s__len);
export void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
export void OPM_WriteString (CHAR *s, LONGINT s__len);
export void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
export BOOLEAN OPM_eofSF (void);
export void OPM_err (INT16 n);
@ -114,7 +105,7 @@ void OPM_LogW (CHAR ch)
Out_Char(ch);
}
void OPM_LogWStr (CHAR *s, ADDRESS s__len)
void OPM_LogWStr (CHAR *s, LONGINT s__len)
{
__DUP(s, s__len, CHAR);
Out_String(s, s__len);
@ -131,7 +122,7 @@ void OPM_LogWLn (void)
Out_Ln();
}
void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len)
void OPM_LogVT100 (CHAR *vt100code, LONGINT vt100code__len)
{
__DUP(vt100code, vt100code__len, CHAR);
if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) {
@ -140,57 +131,6 @@ void OPM_LogVT100 (CHAR *vt100code, ADDRESS 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;
@ -214,7 +154,7 @@ INT16 OPM_Integer (INT64 n)
return __VAL(INT16, n);
}
static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
static void OPM_ScanOptions (CHAR *s, LONGINT s__len)
{
INT16 i;
__DUP(s, s__len, CHAR);
@ -287,6 +227,29 @@ static void OPM_ScanOptions (CHAR *s, ADDRESS 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('-');
@ -303,19 +266,16 @@ static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
BOOLEAN OPM_OpenPar (void)
{
CHAR s[256];
if (Modules_ArgCount == 1) {
if (Platform_ArgCount == 1) {
OPM_LogWLn();
OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20);
OPM_LogWStr(Configuration_versionLong, 76);
OPM_LogWStr(Configuration_versionLong, 75);
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();
@ -372,7 +332,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 and SET, 64 bit LONGINT.", 95);
OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
OPM_LogWLn();
OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
OPM_LogWLn();
@ -402,38 +362,64 @@ BOOLEAN OPM_OpenPar (void)
OPM_Options = 0xa9;
OPM_S = 1;
s[0] = 0x00;
Modules_GetArg(OPM_S, (void*)s, 256);
Platform_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
Modules_GetArg(OPM_S, (void*)s, 256);
Platform_GetArg(OPM_S, (void*)s, 256);
}
OPM_GlobalAddressSize = OPM_AddressSize;
OPM_GlobalAlignment = OPM_Alignment;
__MOVE(OPM_Model, OPM_GlobalModel, 10);
__COPY(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;
__MOVE(OPM_GlobalModel, OPM_Model, 10);
__COPY(OPM_GlobalModel, OPM_Model, 10);
OPM_Alignment = OPM_GlobalAlignment;
OPM_AddressSize = OPM_GlobalAddressSize;
s[0] = 0x00;
Modules_GetArg(OPM_S, (void*)s, 256);
Platform_GetArg(OPM_S, (void*)s, 256);
while (s[0] == '-') {
OPM_ScanOptions(s, 256);
OPM_S += 1;
s[0] = 0x00;
Modules_GetArg(OPM_S, (void*)s, 256);
Platform_GetArg(OPM_S, (void*)s, 256);
}
if (__IN(15, OPM_Options, 32)) {
OPM_Options |= __SETOF(10,32);
@ -444,32 +430,29 @@ void OPM_InitOptions (void)
OPM_ShortintSize = 1;
OPM_IntegerSize = 2;
OPM_LongintSize = 4;
OPM_SetSize = 4;
break;
case 'C':
OPM_ShortintSize = 2;
OPM_IntegerSize = 4;
OPM_LongintSize = 8;
OPM_SetSize = 4;
break;
case 'V':
OPM_ShortintSize = 1;
OPM_IntegerSize = 4;
OPM_LongintSize = 8;
OPM_SetSize = 8;
break;
default:
OPM_ShortintSize = 1;
OPM_IntegerSize = 2;
OPM_LongintSize = 4;
OPM_SetSize = 4;
break;
}
__MOVE(OPM_InstallDir, OPM_ResourceDir, 1024);
if (OPM_ResourceDir[0] != 0x00) {
Strings_Append((CHAR*)"/", 2, (void*)OPM_ResourceDir, 1024);
Strings_Append(OPM_Model, 10, (void*)OPM_ResourceDir, 1024);
if (__IN(18, OPM_Options, 32)) {
OPM_VerboseListSizes();
}
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);
@ -482,22 +465,23 @@ void OPM_InitOptions (void)
Files_SetSearchPath(searchpath, 1024);
}
void OPM_Init (BOOLEAN *done)
void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len)
{
Texts_Text T = NIL;
INT32 beg, end, time;
CHAR s[256];
*done = 0;
OPM_curpos = 0;
if (OPM_S >= Modules_ArgCount) {
if (OPM_S >= Platform_ArgCount) {
return;
}
s[0] = 0x00;
Modules_GetArg(OPM_S, (void*)s, 256);
Platform_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);
@ -519,14 +503,18 @@ void OPM_Init (BOOLEAN *done)
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, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len)
static void OPM_MakeFileName (CHAR *name, LONGINT name__len, CHAR *FName, LONGINT FName__len, CHAR *ext, LONGINT ext__len)
{
INT16 i, j;
CHAR ch;
@ -644,7 +632,7 @@ static void OPM_ShowLine (INT64 pos)
if (pos >= (INT64)OPM_ErrorLineLimitPos) {
pos = OPM_ErrorLineLimitPos - 1;
}
i = __SHORTF(OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos), 32768);
i = (INT16)OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos);
while (i > 0) {
OPM_LogW(' ');
i -= 1;
@ -652,6 +640,7 @@ 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)
@ -711,7 +700,7 @@ void OPM_err (INT16 n)
OPM_Mark(n, OPM_errpos);
}
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len)
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, LONGINT bytes__len)
{
INT16 i;
INT32 l;
@ -783,13 +772,10 @@ void OPM_CloseOldSym (void)
Files_Close(Files_Base(&OPM_oldSF, Files_Rider__typ));
}
void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done)
void OPM_OldSym (CHAR *modName, LONGINT 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;
@ -797,10 +783,8 @@ void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done)
Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, 0);
Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&tag);
Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ver);
if (tag != 0xf7 || ver != 0x84) {
if (!__IN(4, OPM_Options, 32)) {
OPM_err(-306);
}
if (tag != 0xf7 || ver != 0x82) {
OPM_err(-306);
OPM_CloseOldSym();
*done = 0;
}
@ -844,23 +828,11 @@ void OPM_RegisterNewSym (void)
}
}
void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len)
void OPM_DeleteNewSym (void)
{
OPM_FileName fn;
INT16 res;
OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".sym", 5);
Files_Delete(fn, 32, &res);
}
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)
void OPM_NewSym (CHAR *modName, LONGINT modName__len)
{
OPM_FileName fileName;
OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
@ -868,7 +840,7 @@ void OPM_NewSym (CHAR *modName, ADDRESS modName__len)
if (OPM_newSFile != NIL) {
Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, 0);
Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7);
Files_Write(&OPM_newSF, Files_Rider__typ, 0x84);
Files_Write(&OPM_newSF, Files_Rider__typ, 0x82);
} else {
OPM_err(153);
}
@ -879,7 +851,7 @@ void OPM_Write (CHAR ch)
Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, ch);
}
void OPM_WriteString (CHAR *s, ADDRESS s__len)
void OPM_WriteString (CHAR *s, LONGINT s__len)
{
INT16 i;
i = 0;
@ -889,7 +861,7 @@ void OPM_WriteString (CHAR *s, ADDRESS s__len)
Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}
void OPM_WriteStringVar (CHAR *s, ADDRESS s__len)
void OPM_WriteStringVar (CHAR *s, LONGINT s__len)
{
INT16 i;
i = 0;
@ -903,17 +875,17 @@ void OPM_WriteHex (INT64 i)
{
CHAR s[3];
INT32 digit;
digit = __ASHR(__SHORT(i, 2147483648LL), 4);
digit = __ASHR((INT32)i, 4);
if (digit < 10) {
s[0] = __CHR(48 + digit);
s[0] = (CHAR)(48 + digit);
} else {
s[0] = __CHR(87 + digit);
s[0] = (CHAR)(87 + digit);
}
digit = __MASK(__SHORT(i, 2147483648LL), -16);
digit = __MASK((INT32)i, -16);
if (digit < 10) {
s[1] = __CHR(48 + digit);
s[1] = (CHAR)(48 + digit);
} else {
s[1] = __CHR(87 + digit);
s[1] = (CHAR)(87 + digit);
}
s[2] = 0x00;
OPM_WriteString(s, 3);
@ -921,7 +893,7 @@ void OPM_WriteHex (INT64 i)
void OPM_WriteInt (INT64 i)
{
CHAR s[26];
CHAR s[24];
INT64 i1, k;
if ((i == OPM_SignedMinimum(2) || i == OPM_SignedMinimum(4)) || i == OPM_SignedMinimum(8)) {
OPM_Write('(');
@ -929,27 +901,21 @@ void OPM_WriteInt (INT64 i)
OPM_WriteString((CHAR*)"-1)", 4);
} else {
i1 = __ABS(i);
if (i1 <= 2147483647) {
k = 0;
} else {
__MOVE("LL", s, 3);
k = 2;
}
s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
s[0] = (CHAR)(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k += 1;
k = 1;
while (i1 > 0) {
s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
s[__X(k, 24)] = (CHAR)(__MOD(i1, 10) + 48);
i1 = __DIV(i1, 10);
k += 1;
}
if (i < 0) {
s[__X(k, 26)] = '-';
s[__X(k, 24)] = '-';
k += 1;
}
while (k > 0) {
k -= 1;
OPM_Write(s[__X(k, 26)]);
OPM_Write(s[__X(k, 24)]);
}
}
}
@ -962,13 +928,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 == (__SHORT(__ENTIER(r), 2147483648LL)))) {
if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == ((INT32)__ENTIER(r)))) {
if (suffx == 'f') {
OPM_WriteString((CHAR*)"(REAL)", 7);
} else {
OPM_WriteString((CHAR*)"(LONGREAL)", 11);
}
OPM_WriteInt(__SHORT(__ENTIER(r), 2147483648LL));
OPM_WriteInt((INT32)__ENTIER(r));
} else {
Texts_OpenWriter(&W, Texts_Writer__typ);
if (suffx == 'f') {
@ -1020,9 +986,9 @@ static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F)
}
}
void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len)
void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len)
{
OPM_FileName FName;
CHAR FName[32];
__COPY(moduleName, OPM_modName, 32);
OPM_HFile = Files_New((CHAR*)"", 1);
if (OPM_HFile != NIL) {
@ -1048,7 +1014,7 @@ void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len)
void OPM_CloseFiles (void)
{
OPM_FileName FName;
CHAR FName[32];
INT16 res;
if (OPM_noerr) {
OPM_LogWStr((CHAR*)" ", 3);
@ -1084,59 +1050,6 @@ 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);
@ -1158,7 +1071,6 @@ export void *OPM__init(void)
__DEFMOD;
__MODULE_IMPORT(Configuration);
__MODULE_IMPORT(Files);
__MODULE_IMPORT(Modules);
__MODULE_IMPORT(Out);
__MODULE_IMPORT(Platform);
__MODULE_IMPORT(Strings);
@ -1167,6 +1079,7 @@ 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);
@ -1176,8 +1089,5 @@ 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;
}

27
bootstrap/unix-88/OPM.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#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, OPM_SetSize;
import INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize;
import INT64 OPM_MaxIndex;
import LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
import BOOLEAN OPM_noerr;
@ -17,39 +17,34 @@ 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_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
import void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
import void OPM_DeleteNewSym (void);
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_GetComment (CHAR *text, ADDRESS text__len);
import void OPM_Init (BOOLEAN *done);
import void OPM_Init (BOOLEAN *done, CHAR *mname, LONGINT mname__len);
import void OPM_InitOptions (void);
import INT16 OPM_Integer (INT64 n);
import void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len);
import void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len);
import void OPM_LogVT100 (CHAR *vt100code, LONGINT 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, ADDRESS s__len);
import void OPM_LogWStr (CHAR *s, LONGINT s__len);
import INT32 OPM_Longint (INT64 n);
import void OPM_Mark (INT16 n, INT32 pos);
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 void OPM_NewSym (CHAR *modName, LONGINT modName__len);
import void OPM_OldSym (CHAR *modName, LONGINT modName__len, BOOLEAN *done);
import void OPM_OpenFiles (CHAR *moduleName, LONGINT moduleName__len);
import BOOLEAN OPM_OpenPar (void);
import void OPM_RegisterNewSym (void);
import 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);
@ -66,8 +61,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, ADDRESS s__len);
import void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
import void OPM_WriteString (CHAR *s, LONGINT s__len);
import void OPM_WriteStringVar (CHAR *s, LONGINT s__len);
import BOOLEAN OPM_eofSF (void);
import void OPM_err (INT16 n);
import void *OPM__init(void);

43
bootstrap/unix-88/OPP.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#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) {
__MOVE(OPS_name, name, 256);
__COPY(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 = __SHORT(__SHORT((*x)->obj->adr, 32768), 128);
m = (INT8)((INT16)(*x)->obj->adr);
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;
}
__MOVE(OPS_name, name, 256);
__COPY(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] = __CHR(n);
(*ext)[0] = (CHAR)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)] = __CHR(c);
(*ext)[__X(n, 256)] = (CHAR)c;
}
if (OPP_sym == 19) {
OPS_Get(&OPP_sym);
} else if (OPP_sym == 35) {
OPP_err(19);
} else {
(*ext)[0] = __CHR(n);
(*ext)[0] = (CHAR)n;
break;
}
}
@ -1030,7 +1030,7 @@ static void TProcDecl__23 (void)
}
OPP_Receiver(&objMode, objName, &objTyp, &recTyp);
if (OPP_sym == 38) {
__MOVE(OPS_name, *ProcedureDeclaration__16_s->name, 256);
__COPY(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);
__MOVE(OPS_name, name, 256);
__COPY(OPS_name, name, 256);
OPP_CheckMark(&vis);
if ((vis != 0 && mode == 6)) {
mode = 7;
@ -1665,9 +1665,6 @@ 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) {
@ -1793,10 +1790,30 @@ 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_LogCompiling(OPS_name, 256);
OPM_LogWStr((CHAR*)"compiling ", 11);
OPM_LogWStr(OPS_name, 256);
OPM_LogW('.');
OPT_Init(OPS_name, opt);
OPS_Get(&OPP_sym);
OPP_CheckSym(39);

2
bootstrap/unix-88/OPP.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPP__h
#define OPP__h

100
bootstrap/unix-88/OPS.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -56,11 +56,11 @@ static void OPS_Str (INT8 *sym)
OPS_err(241);
break;
}
OPS_str[__X(i, 256)] = OPS_ch;
OPS_str[i] = OPS_ch;
i += 1;
}
OPM_Get(&OPS_ch);
OPS_str[__X(i, 256)] = 0x00;
OPS_str[i] = 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[__X(i, 256)] = OPS_ch;
OPS_name[i] = OPS_ch;
i += 1;
OPM_Get(&OPS_ch);
} while (!(((OPS_ch < '0' || ('9' < OPS_ch && __CAP(OPS_ch) < 'A')) || 'Z' < __CAP(OPS_ch)) || i == 256));
@ -84,7 +84,7 @@ static void OPS_Identifier (INT8 *sym)
OPS_err(240);
i -= 1;
}
OPS_name[__X(i, 256)] = 0x00;
OPS_name[i] = 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[__X(n, 24)] = OPS_ch;
dig[n] = 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[__X(i, 24)], 1);
OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 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[__X(i, 24)], 1);
OPS_intval = __ASHL(OPS_intval, 4) + (INT64)Ord__7(dig[i], 1);
i += 1;
}
} else {
@ -196,9 +196,9 @@ static void OPS_Number (void)
} else {
OPS_numtyp = 2;
while (i < n) {
d = Ord__7(dig[__X(i, 24)], 0);
d = Ord__7(dig[i], 0);
i += 1;
if (OPS_intval <= __DIV(9223372036854775807LL - (INT64)d, 10)) {
if (OPS_intval <= __DIV(9223372036854775807 - (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[__X(n, 24)], 0) + f) / (LONGREAL)(LONGREAL)10;
f = (Ord__7(dig[n], 0) + f) / (LONGREAL)(LONGREAL)10;
}
if (OPS_ch == 'E' || OPS_ch == 'D') {
expCh = OPS_ch;
@ -279,74 +279,32 @@ 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);
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) {
for (;;) {
for (;;) {
while (OPS_ch == '(') {
OPM_Get(&OPS_ch);
} else {
prevCh = 0x00;
}
} else {
if ((((isExported && nestLevel == 1)) && prevCh != 0x00)) {
if (i < 255) {
commentText[__X(i, 256)] = prevCh;
i += 1;
if (OPS_ch == '*') {
Comment__2();
}
}
prevCh = OPS_ch;
}
if (nestLevel > 0) {
if (OPS_ch == '*') {
OPM_Get(&OPS_ch);
break;
}
if (OPS_ch == 0x00) {
break;
}
OPM_Get(&OPS_ch);
}
}
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 == ')') {
OPM_Get(&OPS_ch);
break;
}
}
if (isExported) {
if (i >= 256) {
OPM_LogWStr((CHAR*)"Warning: commentText overflow", 30);
OPM_LogWLn();
i = 255;
if (OPS_ch == 0x00) {
OPS_err(5);
break;
}
commentText[__X(i, 256)] = 0x00;
OPM_StoreComment(commentText, 256);
}
}

2
bootstrap/unix-88/OPS.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. tspaSF */
#ifndef OPS__h
#define OPS__h

195
bootstrap/unix-88/OPT.c
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#define SHORTINT INT8
#define INTEGER INT16
@ -49,15 +49,6 @@ 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;
@ -83,7 +74,6 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@ -111,7 +101,6 @@ 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;
@ -119,7 +108,6 @@ 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);
@ -132,7 +120,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, ADDRESS name__len);
static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT 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);
@ -143,9 +131,8 @@ 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, ADDRESS name__len);
static void OPT_InName (CHAR *name, LONGINT 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);
@ -167,14 +154,12 @@ 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, ADDRESS name__len);
static void OPT_OutName (CHAR *name, LONGINT name__len);
static void OPT_OutObj (OPT_Object obj);
static void OPT_OutSign (OPT_Struct result, OPT_Object par);
static void OPT_OutStr (OPT_Struct typ);
static void OPT_OutTProcs (OPT_Struct typ, OPT_Object obj);
static void OPT_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);
@ -354,7 +339,7 @@ void OPT_TypSize (OPT_Struct typ)
}
typ->size = offset;
typ->align = base;
typ->sysflag = __MASK(typ->sysflag, -256) + __SHORT(__ASHL(offset - off0, 8), 32768);
typ->sysflag = __MASK(typ->sysflag, -256) + (INT16)__ASHL(offset - off0, 8);
} else if (c == 2) {
OPT_TypSize(typ->BaseTyp);
typ->size = typ->n * typ->BaseTyp->size;
@ -390,10 +375,6 @@ 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;
}
@ -453,16 +434,14 @@ void OPT_Init (OPS_Name name, UINT32 opt)
OPT_topScope = OPT_universe;
OPT_OpenScope(0, NIL);
OPT_SYSimported = 0;
__MOVE(name, OPT_SelfName, 256);
__MOVE(name, OPT_topScope->name, 256);
__COPY(name, OPT_SelfName, 256);
__COPY(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)
@ -560,8 +539,6 @@ 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;
@ -593,23 +570,13 @@ 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, ADDRESS name__len)
static void OPT_FPrintName (INT32 *fp, CHAR *name, LONGINT name__len)
{
INT16 i;
CHAR ch;
@ -990,7 +957,7 @@ void OPT_InsertImport (OPT_Object obj, OPT_Object *root, OPT_Object *old)
}
}
static void OPT_InName (CHAR *name, ADDRESS name__len)
static void OPT_InName (CHAR *name, LONGINT name__len)
{
INT16 i;
CHAR ch;
@ -1044,26 +1011,6 @@ 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;
@ -1121,13 +1068,6 @@ 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) {
@ -1246,7 +1186,7 @@ static void OPT_InStruct (OPT_Struct *typ)
}
*typ = OPT_NewStr(0, 1);
} else {
__MOVE(name, obj->name, 256);
__COPY(name, obj->name, 256);
OPT_InsertImport(obj, &OPT_GlbMod[__X(mno, 64)]->right, &old);
if (old != NIL) {
OPT_FPrintObj(old);
@ -1276,7 +1216,7 @@ static void OPT_InStruct (OPT_Struct *typ)
obj->vis = 0;
tag = OPM_SymRInt();
if (tag == 35) {
(*typ)->sysflag = __SHORTF(OPM_SymRInt(), 32768);
(*typ)->sysflag = (INT16)OPM_SymRInt();
tag = OPM_SymRInt();
}
switch (tag) {
@ -1406,37 +1346,7 @@ 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;
@ -1452,7 +1362,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 && tag <= 33)) {
} else if (tag >= 31) {
obj->conval = OPT_NewConst();
obj->conval->intval = -1;
OPT_InSign(mno, &obj->typ, &obj->link);
@ -1467,8 +1377,8 @@ static OPT_Object OPT_InObj (INT8 mno)
obj->mode = 9;
ext = OPT_NewExt();
obj->conval->ext = ext;
s = __SHORTF(OPM_SymRInt(), 32768);
(*ext)[0] = __CHR(s);
s = (INT16)OPM_SymRInt();
(*ext)[0] = (CHAR)s;
i = 1;
while (i <= s) {
OPM_SymRCh(&(*ext)[__X(i, 256)]);
@ -1479,37 +1389,20 @@ 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 if (tag == 21 || tag == 22) {
} else {
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);
@ -1565,15 +1458,9 @@ 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;
if ((OPT_impCtxt.self && __IN(17, OPM_Options, 32))) {
OPM_DeleteSym((void*)name, 256);
*done = 0;
} else {
OPM_OldSym((void*)name, 256, &*done);
}
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);
@ -1596,7 +1483,7 @@ void OPT_Import (OPS_Name aliasName, OPS_Name name, BOOLEAN *done)
}
}
static void OPT_OutName (CHAR *name, ADDRESS name__len)
static void OPT_OutName (CHAR *name, LONGINT name__len)
{
INT16 i;
CHAR ch;
@ -1620,17 +1507,6 @@ 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;
@ -1824,7 +1700,7 @@ static void OPT_OutConstant (OPT_Object obj)
OPM_SymWInt(f);
switch (f) {
case 2: case 3:
OPM_SymWCh(__CHR(obj->conval->intval));
OPM_SymWCh((CHAR)obj->conval->intval);
break;
case 4:
OPM_SymWInt(obj->conval->intval);
@ -1852,40 +1728,13 @@ 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) {
@ -1984,7 +1833,6 @@ 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;
@ -2006,7 +1854,7 @@ void OPT_Export (BOOLEAN *ext, BOOLEAN *new)
OPT_newsf = 0;
OPT_symNew = 0;
if (!OPM_noerr || OPT_findpc) {
OPM_DeleteSym((void*)OPT_SelfName, 256);
OPM_DeleteNewSym();
}
}
}
@ -2121,11 +1969,10 @@ 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, 7) = {__TDFLDS("ObjDesc", 344), {0, 8, 16, 24, 304, 312, 336, -64}};
__TDESC(OPT_ObjDesc, 1, 6) = {__TDFLDS("ObjDesc", 336), {0, 8, 16, 24, 304, 312, -56}};
__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,
@ -2161,7 +2008,6 @@ __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)
{
@ -2178,7 +2024,6 @@ 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);

14
bootstrap/unix-88/OPT.h
View file

@ -1,4 +1,4 @@
/* voc 2.1.0 [2025/06/24]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
/* voc 1.95 [2016/11/24]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */
#ifndef OPT__h
#define OPT__h
@ -21,15 +21,6 @@ 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;
@ -61,7 +52,6 @@ typedef
OPT_Const conval;
INT32 adr, linkadr;
INT16 x;
OPT_ConstExt comment;
} OPT_ObjDesc;
typedef
@ -85,13 +75,11 @@ 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);

Some files were not shown because too many files have changed in this diff Show more